3583 files changed, 126547 insertions, 0 deletions

diff --git a/gcc/testsuite/gfortran.dg/PR19754_1.f90 b/gcc/testsuite/gfortran.dg/PR19754_1.f90
new file mode 100644
index 000000000..b554d1094
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR19754_1.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! Test of fix to PR19754
+program PR19754_1
+   real x(3,3),y(2,2)
+   x = 1.
+   y = 2.
+   x = x + y ! { dg-error "Shapes for operands at" }
+end program PR19754_1
+
diff --git a/gcc/testsuite/gfortran.dg/PR19754_2.f90 b/gcc/testsuite/gfortran.dg/PR19754_2.f90
new file mode 100644
index 000000000..9b71bd02b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR19754_2.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! Test of Steve Kargl's fix to PR19754
+! This exercises bugs that the original patch caused
+!
+program PR19754_2
+   real a(2,2), b(2,2),c(2,2),d(2,2)
+   integer i(2,2),j(2,2),k(2,2)
+   a = 1. ; b = 2. ;  i = 4
+   c = b - floor( a / b )        ! this caused an ICE
+   d = b - real(floor( a / b ))
+   if (any (c/=d)) call abort ()
+   j = aint(b) - floor( a / b )  ! this caused an ICE
+   if (any(real(j)/=d)) call abort ()
+   c = i
+   if (any(real(i)/=c)) call abort ()
+   c = i + b                     ! this caused an ICE 
+   d = real(i) + b
+   if (any(c/=d)) call abort ()
+   j = i + aint (a)
+   k = i + a                     ! this caused an ICE
+   if (any(j/=k)) call abort ()
+end program PR19754_2
diff --git a/gcc/testsuite/gfortran.dg/PR19872.f b/gcc/testsuite/gfortran.dg/PR19872.f
new file mode 100644
index 000000000..edc743b2e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR19872.f
@@ -0,0 +1,20 @@
+! { dg-do run { target fd_truncate } } 
+! PR 19872 - closed and re-opened file not overwriten
+      implicit none
+      integer i(4)
+      data i / 4 * 0 /
+      open(1,form='FORMATTED',status='UNKNOWN')
+      write(1,'("1 2 3 4 5 6 7 8 9")')
+      close(1)
+      open(1,form='FORMATTED')
+      write(1,'("9 8 7 6")')
+      close(1)
+      open(1,form='FORMATTED')
+      read(1,*)i
+      if(i(1).ne.9.or.i(2).ne.8.or.i(3).ne.7.or.i(4).ne.6)call abort
+      read(1,*, end=200)i
+! should only be able to read one line from the file
+      call abort
+ 200  continue
+      close(1,STATUS='delete')
+      end
diff --git a/gcc/testsuite/gfortran.dg/PR24188.f b/gcc/testsuite/gfortran.dg/PR24188.f
new file mode 100644
index 000000000..a33141fa4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR24188.f
@@ -0,0 +1,7 @@
+C PR target/24188
+C { dg-do compile }
+C { dg-options "-O2" }
+C { dg-options "-O2 -mcmodel=medium" { target { x86_64-*-* && lp64 } } }
+C { dg-options "-O2 -mcmodel=medium" { target { i?86-*-* && lp64 } } }
+      WRITE(6,*) ''
+      END
diff --git a/gcc/testsuite/gfortran.dg/PR40660.f90 b/gcc/testsuite/gfortran.dg/PR40660.f90
new file mode 100644
index 000000000..a269ca3b2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR40660.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original-lineno" }
+!
+! PR fortran/40660
+
+PROGRAM test
+  INTEGER, DIMENSION(3) :: a1,a2
+  a1 = 1
+  PRINT*, a1
+  a2 = 2
+end program test
+
+! { dg-final { scan-tree-dump-times ": 3\] _gfortran" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/PR49268.f90 b/gcc/testsuite/gfortran.dg/PR49268.f90
new file mode 100644
index 000000000..5b274cf48
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR49268.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+! { dg-options "-fcray-pointer" }
+
+! Test the fix for a runtime error 
+! Contributed by Mike Kumbera <kumbera1@llnl.gov>
+
+        program bob
+        implicit none
+        integer*8 ipfoo
+        integer n,m,i,j
+        real*8 foo
+        
+        common /ipdata/ ipfoo
+        common /ipsize/ n,m
+        POINTER ( ipfoo, foo(3,7) )
+
+        n=3
+        m=7
+
+        ipfoo=malloc(8*n*m)
+        do i=1,n
+            do j=1,m
+                foo(i,j)=1.d0
+            end do
+        end do
+        call use_foo()
+        end  program bob
+
+
+        subroutine use_foo()
+        implicit none
+        integer n,m,i,j
+        integer*8 ipfoo
+        common /ipdata/ ipfoo
+        common /ipsize/ n,m
+        real*8 foo,boo
+
+        !fails if * is the last dimension
+        POINTER ( ipfoo, foo(n,*) )
+
+        !works if the last dimension is specified
+        !POINTER ( ipfoo, foo(n,m) )
+        boo=0.d0
+        do i=1,n
+            do j=1,m
+               boo=foo(i,j)+1.0
+               if (abs (boo - 2.0) .gt. 1e-6) call abort
+            end do
+        end do
+
+        end subroutine use_foo
diff --git a/gcc/testsuite/gfortran.dg/Wall.f90 b/gcc/testsuite/gfortran.dg/Wall.f90
new file mode 100644
index 000000000..64c95a9c0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/Wall.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-options -Wall }
+! PR 30437  Test for Wall
+program main
+  character (len=40) &
+  c
+  c = "Hello, &
+         world!" ! { dg-warning "Missing '&' in continued character constant" }
+  if (c.ne.&
+                                   "Hello, world!")&
+                               call abort();end program main
+
diff --git a/gcc/testsuite/gfortran.dg/Wno-all.f90 b/gcc/testsuite/gfortran.dg/Wno-all.f90
new file mode 100644
index 000000000..550c7e46a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/Wno-all.f90
@@ -0,0 +1,12 @@
+! PR 30437  Test for negative Wall
+! { dg-do run }
+! { dg-options "-Wall -Wno-all" }
+program main
+  character (len=40) &
+  c
+  c = "Hello, &
+         world!" ! { dg-bogus "Warning: Missing '&' in continued character constant" }
+  if (c.ne.&
+                                   "Hello, world!")&
+                               call abort();end program main
+
diff --git a/gcc/testsuite/gfortran.dg/abstract_type_1.f90 b/gcc/testsuite/gfortran.dg/abstract_type_1.f90
new file mode 100644
index 000000000..d0cd4320a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/abstract_type_1.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! Abstract Types.
+! Check that ABSTRACT is rejected for F95.
+
+MODULE m
+
+  TYPE, ABSTRACT :: t ! { dg-error "Fortran 2003" }
+    INTEGER :: x
+  END TYPE t ! { dg-error "END MODULE" }
+
+END MODULE m
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/abstract_type_2.f03 b/gcc/testsuite/gfortran.dg/abstract_type_2.f03
new file mode 100644
index 000000000..2583f1f4f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/abstract_type_2.f03
@@ -0,0 +1,14 @@
+! { dg-do compile }
+
+! Abstract Types.
+! Check for parser errors.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE, ABSTRACT, EXTENDS(abst_t), ABSTRACT :: error_t ! { dg-error "Duplicate ABSTRACT attribute" }
+    INTEGER :: y
+  END TYPE error_t ! { dg-error "END MODULE" }
+
+END MODULE m
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/abstract_type_3.f03 b/gcc/testsuite/gfortran.dg/abstract_type_3.f03
new file mode 100644
index 000000000..79bc131e0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/abstract_type_3.f03
@@ -0,0 +1,52 @@
+! { dg-do compile }
+
+! Abstract Types.
+! Check for errors when using abstract types in an inappropriate way.
+
+MODULE m
+  USE ISO_C_BINDING
+  IMPLICIT NONE
+
+  TYPE, ABSTRACT, BIND(C) :: bindc_t ! { dg-error "must not be ABSTRACT" }
+    INTEGER(C_INT) :: x
+  END TYPE bindc_t
+
+  TYPE, ABSTRACT :: sequence_t ! { dg-error "must not be ABSTRACT" }
+    SEQUENCE
+    INTEGER :: x
+  END TYPE sequence_t
+
+  TYPE, ABSTRACT :: abst_t
+    INTEGER :: x = 0
+  END TYPE abst_t
+
+  TYPE, EXTENDS(abst_t) :: concrete_t
+    INTEGER :: y = 1
+  END TYPE concrete_t
+
+  TYPE :: myt
+    TYPE(abst_t) :: comp ! { dg-error "is of the ABSTRACT type 'abst_t'" }
+  END TYPE myt
+
+  ! This should be ok.
+  TYPE, ABSTRACT, EXTENDS(concrete_t) :: again_abst_t
+    INTEGER :: z = 2
+  END TYPE again_abst_t
+
+CONTAINS
+
+  TYPE(abst_t) FUNCTION func () ! { dg-error "of the ABSTRACT type 'abst_t'" }
+  END FUNCTION func
+
+  SUBROUTINE sub (arg) ! { dg-error "is of the ABSTRACT type 'again_abst_t'" }
+    IMPLICIT NONE
+    TYPE(again_abst_t) :: arg
+    arg = again_abst_t () ! { dg-error "Can't construct ABSTRACT type 'again_abst_t'" }
+  END SUBROUTINE sub
+
+  SUBROUTINE impl ()
+    IMPLICIT TYPE(abst_t) (a-z) ! { dg-error "ABSTRACT type 'abst_t' used" }
+  END SUBROUTINE impl
+
+END MODULE m
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/abstract_type_4.f03 b/gcc/testsuite/gfortran.dg/abstract_type_4.f03
new file mode 100644
index 000000000..a6e5de208
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/abstract_type_4.f03
@@ -0,0 +1,29 @@
+! { dg-do compile }
+
+! Abstract Types.
+! Check for module file IO.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE, ABSTRACT :: abst_t
+    INTEGER :: x
+  END TYPE abst_t
+
+  TYPE, EXTENDS(abst_t) :: concrete_t
+    INTEGER :: y
+  END TYPE concrete_t
+
+END MODULE m
+
+PROGRAM main
+  USE m
+  IMPLICIT NONE
+
+  TYPE(abst_t) :: abst ! { dg-error "is of the ABSTRACT type 'abst_t'" }
+  TYPE(concrete_t) :: conc
+
+  ! See if constructing the extending type works.
+  conc = concrete_t (1, 2)
+END PROGRAM main
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/abstract_type_5.f03 b/gcc/testsuite/gfortran.dg/abstract_type_5.f03
new file mode 100644
index 000000000..42ac963fa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/abstract_type_5.f03
@@ -0,0 +1,46 @@
+! { dg-do compile }
+
+! Abstract Types.
+! Check for correct handling of abstract-typed base object references.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE, ABSTRACT :: abstract_t
+    INTEGER :: i
+  CONTAINS
+    PROCEDURE, NOPASS :: proc
+    PROCEDURE, NOPASS :: func
+  END TYPE abstract_t
+
+  TYPE, EXTENDS(abstract_t) :: concrete_t
+  END TYPE concrete_t
+
+CONTAINS
+
+  SUBROUTINE proc ()
+    IMPLICIT NONE
+    ! Do nothing
+  END SUBROUTINE proc
+
+  INTEGER FUNCTION func ()
+    IMPLICIT NONE
+    func = 1234
+  END FUNCTION func
+
+  SUBROUTINE test ()
+    IMPLICIT NONE
+    TYPE(concrete_t) :: obj
+
+    ! These are ok.
+    obj%abstract_t%i = 42
+    CALL obj%proc ()
+    PRINT *, obj%func ()
+
+    ! These are errors (even though the procedures are not DEFERRED!).
+    CALL obj%abstract_t%proc () ! { dg-error "is of ABSTRACT type" }
+    PRINT *, obj%abstract_t%func () ! { dg-error "is of ABSTRACT type" }
+  END SUBROUTINE test
+
+END MODULE m
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/abstract_type_6.f03 b/gcc/testsuite/gfortran.dg/abstract_type_6.f03
new file mode 100644
index 000000000..de1cea363
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/abstract_type_6.f03
@@ -0,0 +1,53 @@
+! { dg-do compile }
+! Test the fix for PR43266, in which an ICE followed correct error messages.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+! Reported in http://groups.google.ca/group/comp.lang.fortran/browse_thread/thread/f5ec99089ea72b79
+!
+!----------------
+! library code
+
+module m
+TYPE, ABSTRACT :: top
+CONTAINS
+   PROCEDURE(xxx), DEFERRED :: proc_a ! { dg-error "must be a module procedure" }
+   ! some useful default behaviour
+   PROCEDURE :: proc_c => top_c ! { dg-error "must be a module procedure" }
+END TYPE top
+
+! Concrete middle class with useful behaviour
+TYPE, EXTENDS(top) :: middle
+CONTAINS
+   ! do nothing, empty proc just to make middle concrete
+   PROCEDURE :: proc_a => dummy_middle_a ! { dg-error "must be a module procedure" }
+   ! some useful default behaviour
+   PROCEDURE :: proc_b => middle_b ! { dg-error "must be a module procedure" }
+END TYPE middle
+
+!----------------
+! client code
+
+TYPE, EXTENDS(middle) :: bottom
+CONTAINS
+   ! useful proc to satisfy deferred procedure in top. Because we've
+   ! extended middle we wouldn't get told off if we forgot this.
+   PROCEDURE :: proc_a => bottom_a  ! { dg-error "must be a module procedure" }
+   ! calls middle%proc_b and then provides extra behaviour
+   PROCEDURE :: proc_b => bottom_b
+   ! calls top_c and then provides extra behaviour
+   PROCEDURE :: proc_c => bottom_c
+END TYPE bottom
+contains
+SUBROUTINE bottom_b(obj)
+   CLASS(Bottom) :: obj
+   CALL obj%middle%proc_b ! { dg-error "should be a SUBROUTINE" }
+   ! other stuff
+END SUBROUTINE bottom_b
+
+SUBROUTINE bottom_c(obj)
+   CLASS(Bottom) :: obj
+   CALL top_c(obj)
+   ! other stuff
+END SUBROUTINE bottom_c 
+end module
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/abstract_type_7.f03 b/gcc/testsuite/gfortran.dg/abstract_type_7.f03
new file mode 100644
index 000000000..3ea0fdca6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/abstract_type_7.f03
@@ -0,0 +1,18 @@
+! { dg-do compile }
+!
+! PR 44213: ICE when extending abstract type
+!
+! Contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
+
+module ice_module
+  type :: a_type
+  end type a_type
+
+  type,extends(a_type),abstract :: b_type
+  end type b_type
+
+  type,extends(b_type) :: c_type
+  end type c_type
+end module ice_module
+ 
+! { dg-final { cleanup-modules "ice_module" } }
diff --git a/gcc/testsuite/gfortran.dg/abstract_type_8.f03 b/gcc/testsuite/gfortran.dg/abstract_type_8.f03
new file mode 100644
index 000000000..c924abac9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/abstract_type_8.f03
@@ -0,0 +1,29 @@
+! { dg-do compile }
+!
+! PR 44616: [OOP] ICE if CLASS(foo) is used before its definition
+!
+! Contributed by bd satish <bdsatish@gmail.com>
+
+module factory_pattern
+implicit none
+
+type First_Factory
+    character(len=20) :: factory_type
+    class(Connection), pointer :: connection_type
+    contains
+end type First_Factory
+
+type, abstract :: Connection
+    contains
+    procedure(generic_desc), deferred :: description
+end type Connection
+
+abstract interface
+    subroutine generic_desc(self)
+        import  ! Required, cf. PR 44614
+        class(Connection) :: self
+    end subroutine generic_desc
+end interface
+end module factory_pattern
+
+! { dg-final { cleanup-modules "factory_pattern" } }
diff --git a/gcc/testsuite/gfortran.dg/access_spec_1.f90 b/gcc/testsuite/gfortran.dg/access_spec_1.f90
new file mode 100644
index 000000000..2c080c9c6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/access_spec_1.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! PR fortran/31472
+! Access specifications: Valid Fortran 2003 code
+module mod
+  implicit none
+  private
+  integer, public :: i
+  integer, private :: z
+  integer :: j, x
+  private :: j
+  public  :: x
+  type, public :: bar
+    PRIVATE
+    integer, public :: y  ! Fortran 2003
+    integer, private :: z  ! Fortran 2003
+  end type
+end module
+! { dg-final { cleanup-modules "mod" } }
diff --git a/gcc/testsuite/gfortran.dg/access_spec_2.f90 b/gcc/testsuite/gfortran.dg/access_spec_2.f90
new file mode 100644
index 000000000..7b67e6c85
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/access_spec_2.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! PR fortran/31472
+! Access specifications: Invalid Fortran 95 code
+
+module test
+  implicit none
+  integer, public :: x
+  public :: x  ! { dg-error "was already specified" }
+  private :: x ! { dg-error "was already specified" }
+end module test
+
+module mod
+  implicit none
+  private
+  type, public :: bar
+    PRIVATE
+    integer, public :: y  ! { dg-error "Fortran 2003: Attribute PUBLIC" }
+    integer, public :: z  ! { dg-error "Fortran 2003: Attribute PUBLIC" }
+  end type ! { dg-error "Derived type definition at" }
+contains
+  subroutine foo
+     integer :: x
+     private :: x ! { dg-error "only allowed in the specification part of a module" }
+     type, private :: t ! { dg-error "only be PRIVATE in the specification part of a module" }
+        integer :: z
+     end type t ! { dg-error "Expecting END SUBROUTINE statement" }
+     type :: ttt
+        integer,public :: z ! { dg-error "not allowed outside of the specification part of a module" }
+     end type ttt ! { dg-error "Derived type definition at" }
+  end subroutine
+end module
+
+program x
+  implicit none
+  integer :: i
+  public  :: i ! { dg-error "only allowed in the specification part of a module" }
+  integer,public :: j ! { dg-error "not allowed outside of the specification part of a module" }
+end program x
+! { dg-final { cleanup-modules "test mod" } }
diff --git a/gcc/testsuite/gfortran.dg/access_spec_3.f90 b/gcc/testsuite/gfortran.dg/access_spec_3.f90
new file mode 100644
index 000000000..9a076b66c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/access_spec_3.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+!
+! Tests the fix for PR36454, where the PUBLIC declaration for
+! aint and bint was rejected because the access was already set.
+!
+! Contributed by Thomas Orgis <thomas.orgis@awi.de>
+
+module base
+        integer :: baseint
+end module
+
+module a
+        use base, ONLY: aint => baseint
+end module
+
+module b
+        use base, ONLY: bint => baseint
+end module
+
+module c
+        use a
+        use b
+        private
+        public :: aint, bint
+end module
+
+program user
+        use c, ONLY: aint, bint
+
+        aint = 3
+        bint = 8
+        write(*,*) aint
+end program
+! { dg-final { cleanup-modules "base a b c" } }
diff --git a/gcc/testsuite/gfortran.dg/achar_1.f90 b/gcc/testsuite/gfortran.dg/achar_1.f90
new file mode 100644
index 000000000..1fdb77472
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/achar_1.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+! achar() should work with all supported integer kinds.
+program  bug6
+  integer(1) :: i = 65
+  character a
+  a = achar(i)
+  if (a /= 'A') call abort
+end program  bug6
diff --git a/gcc/testsuite/gfortran.dg/achar_2.f90 b/gcc/testsuite/gfortran.dg/achar_2.f90
new file mode 100644
index 000000000..fa3a258b2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/achar_2.f90
@@ -0,0 +1,2026 @@
+! { dg-do run }
+! PR 30389 - we now treat ACHAR equivalent to CHAR (except for
+!            out of range-values) and IACHAR equivalent to ICHAR.
+program main
+  integer :: i
+  character(len=1) :: c
+  if (iachar(achar(1)) /= 1) call abort
+  if (iachar ("
")/= 1) call abort
+  if (achar (1) /= "
") call abort
+  if ("
" /= achar ( ichar ( "
"))) call abort
+  i = 1
+  c = "
"
+  if (achar(i) /= "
") call abort
+  if (iachar(c) /= iachar("
")) call abort
+  if (iachar(achar(2)) /= 2) call abort
+  if (iachar ("")/= 2) call abort
+  if (achar (2) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 2
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(3)) /= 3) call abort
+  if (iachar ("")/= 3) call abort
+  if (achar (3) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 3
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(4)) /= 4) call abort
+  if (iachar ("")/= 4) call abort
+  if (achar (4) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 4
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(5)) /= 5) call abort
+  if (iachar ("")/= 5) call abort
+  if (achar (5) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 5
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(6)) /= 6) call abort
+  if (iachar ("")/= 6) call abort
+  if (achar (6) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 6
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(7)) /= 7) call abort
+  if (iachar ("")/= 7) call abort
+  if (achar (7) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 7
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(8)) /= 8) call abort
+  if (iachar ("")/= 8) call abort
+  if (achar (8) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 8
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(9)) /= 9) call abort
+  if (iachar ("	")/= 9) call abort
+  if (achar (9) /= "	") call abort
+  if ("	" /= achar ( ichar ( "	"))) call abort
+  i = 9
+  c = "	"
+  if (achar(i) /= "	") call abort
+  if (iachar(c) /= iachar("	")) call abort
+  if (iachar(achar(10)) /= 10) call abort
+  if (iachar(achar(11)) /= 11) call abort
+  if (iachar ("")/= 11) call abort
+  if (achar (11) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 11
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(12)) /= 12) call abort
+  if (iachar ("")/= 12) call abort
+  if (achar (12) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 12
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(13)) /= 13) call abort
+  if (iachar(achar(14)) /= 14) call abort
+  if (iachar ("")/= 14) call abort
+  if (achar (14) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 14
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(15)) /= 15) call abort
+  if (iachar ("")/= 15) call abort
+  if (achar (15) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 15
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(16)) /= 16) call abort
+  if (iachar ("")/= 16) call abort
+  if (achar (16) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 16
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(17)) /= 17) call abort
+  if (iachar ("")/= 17) call abort
+  if (achar (17) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 17
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(18)) /= 18) call abort
+  if (iachar ("")/= 18) call abort
+  if (achar (18) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 18
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(19)) /= 19) call abort
+  if (iachar ("")/= 19) call abort
+  if (achar (19) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 19
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(20)) /= 20) call abort
+  if (iachar ("")/= 20) call abort
+  if (achar (20) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 20
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(21)) /= 21) call abort
+  if (iachar ("")/= 21) call abort
+  if (achar (21) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 21
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(22)) /= 22) call abort
+  if (iachar ("")/= 22) call abort
+  if (achar (22) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 22
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(23)) /= 23) call abort
+  if (iachar ("")/= 23) call abort
+  if (achar (23) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 23
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(24)) /= 24) call abort
+  if (iachar ("")/= 24) call abort
+  if (achar (24) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 24
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(25)) /= 25) call abort
+  if (iachar ("")/= 25) call abort
+  if (achar (25) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 25
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(26)) /= 26) call abort
+  if (iachar(achar(27)) /= 27) call abort
+  if (iachar ("")/= 27) call abort
+  if (achar (27) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 27
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(28)) /= 28) call abort
+  if (iachar ("")/= 28) call abort
+  if (achar (28) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 28
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(29)) /= 29) call abort
+  if (iachar ("")/= 29) call abort
+  if (achar (29) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 29
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(30)) /= 30) call abort
+  if (iachar ("")/= 30) call abort
+  if (achar (30) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 30
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(31)) /= 31) call abort
+  if (iachar ("")/= 31) call abort
+  if (achar (31) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 31
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(32)) /= 32) call abort
+  if (iachar (" ")/= 32) call abort
+  if (achar (32) /= " ") call abort
+  if (" " /= achar ( ichar ( " "))) call abort
+  i = 32
+  c = " "
+  if (achar(i) /= " ") call abort
+  if (iachar(c) /= iachar(" ")) call abort
+  if (iachar(achar(33)) /= 33) call abort
+  if (iachar ("!")/= 33) call abort
+  if (achar (33) /= "!") call abort
+  if ("!" /= achar ( ichar ( "!"))) call abort
+  i = 33
+  c = "!"
+  if (achar(i) /= "!") call abort
+  if (iachar(c) /= iachar("!")) call abort
+  if (iachar(achar(34)) /= 34) call abort
+  if (iachar ('"')/= 34) call abort
+  if (achar (34) /= '"') call abort
+  if ('"' /= achar ( ichar ( '"'))) call abort
+  i = 34
+  c = '"'
+  if (achar(i) /= '"') call abort
+  if (iachar(c) /= iachar('"')) call abort
+  if (iachar(achar(35)) /= 35) call abort
+  if (iachar ("#")/= 35) call abort
+  if (achar (35) /= "#") call abort
+  if ("#" /= achar ( ichar ( "#"))) call abort
+  i = 35
+  c = "#"
+  if (achar(i) /= "#") call abort
+  if (iachar(c) /= iachar("#")) call abort
+  if (iachar(achar(36)) /= 36) call abort
+  if (iachar ("$")/= 36) call abort
+  if (achar (36) /= "$") call abort
+  if ("$" /= achar ( ichar ( "$"))) call abort
+  i = 36
+  c = "$"
+  if (achar(i) /= "$") call abort
+  if (iachar(c) /= iachar("$")) call abort
+  if (iachar(achar(37)) /= 37) call abort
+  if (iachar ("%")/= 37) call abort
+  if (achar (37) /= "%") call abort
+  if ("%" /= achar ( ichar ( "%"))) call abort
+  i = 37
+  c = "%"
+  if (achar(i) /= "%") call abort
+  if (iachar(c) /= iachar("%")) call abort
+  if (iachar(achar(38)) /= 38) call abort
+  if (iachar ("&")/= 38) call abort
+  if (achar (38) /= "&") call abort
+  if ("&" /= achar ( ichar ( "&"))) call abort
+  i = 38
+  c = "&"
+  if (achar(i) /= "&") call abort
+  if (iachar(c) /= iachar("&")) call abort
+  if (iachar(achar(39)) /= 39) call abort
+  if (iachar ("'")/= 39) call abort
+  if (achar (39) /= "'") call abort
+  if ("'" /= achar ( ichar ( "'"))) call abort
+  i = 39
+  c = "'"
+  if (achar(i) /= "'") call abort
+  if (iachar(c) /= iachar("'")) call abort
+  if (iachar(achar(40)) /= 40) call abort
+  if (iachar ("(")/= 40) call abort
+  if (achar (40) /= "(") call abort
+  if ("(" /= achar ( ichar ( "("))) call abort
+  i = 40
+  c = "("
+  if (achar(i) /= "(") call abort
+  if (iachar(c) /= iachar("(")) call abort
+  if (iachar(achar(41)) /= 41) call abort
+  if (iachar (")")/= 41) call abort
+  if (achar (41) /= ")") call abort
+  if (")" /= achar ( ichar ( ")"))) call abort
+  i = 41
+  c = ")"
+  if (achar(i) /= ")") call abort
+  if (iachar(c) /= iachar(")")) call abort
+  if (iachar(achar(42)) /= 42) call abort
+  if (iachar ("*")/= 42) call abort
+  if (achar (42) /= "*") call abort
+  if ("*" /= achar ( ichar ( "*"))) call abort
+  i = 42
+  c = "*"
+  if (achar(i) /= "*") call abort
+  if (iachar(c) /= iachar("*")) call abort
+  if (iachar(achar(43)) /= 43) call abort
+  if (iachar ("+")/= 43) call abort
+  if (achar (43) /= "+") call abort
+  if ("+" /= achar ( ichar ( "+"))) call abort
+  i = 43
+  c = "+"
+  if (achar(i) /= "+") call abort
+  if (iachar(c) /= iachar("+")) call abort
+  if (iachar(achar(44)) /= 44) call abort
+  if (iachar (",")/= 44) call abort
+  if (achar (44) /= ",") call abort
+  if ("," /= achar ( ichar ( ","))) call abort
+  i = 44
+  c = ","
+  if (achar(i) /= ",") call abort
+  if (iachar(c) /= iachar(",")) call abort
+  if (iachar(achar(45)) /= 45) call abort
+  if (iachar ("-")/= 45) call abort
+  if (achar (45) /= "-") call abort
+  if ("-" /= achar ( ichar ( "-"))) call abort
+  i = 45
+  c = "-"
+  if (achar(i) /= "-") call abort
+  if (iachar(c) /= iachar("-")) call abort
+  if (iachar(achar(46)) /= 46) call abort
+  if (iachar (".")/= 46) call abort
+  if (achar (46) /= ".") call abort
+  if ("." /= achar ( ichar ( "."))) call abort
+  i = 46
+  c = "."
+  if (achar(i) /= ".") call abort
+  if (iachar(c) /= iachar(".")) call abort
+  if (iachar(achar(47)) /= 47) call abort
+  if (iachar ("/")/= 47) call abort
+  if (achar (47) /= "/") call abort
+  if ("/" /= achar ( ichar ( "/"))) call abort
+  i = 47
+  c = "/"
+  if (achar(i) /= "/") call abort
+  if (iachar(c) /= iachar("/")) call abort
+  if (iachar(achar(48)) /= 48) call abort
+  if (iachar ("0")/= 48) call abort
+  if (achar (48) /= "0") call abort
+  if ("0" /= achar ( ichar ( "0"))) call abort
+  i = 48
+  c = "0"
+  if (achar(i) /= "0") call abort
+  if (iachar(c) /= iachar("0")) call abort
+  if (iachar(achar(49)) /= 49) call abort
+  if (iachar ("1")/= 49) call abort
+  if (achar (49) /= "1") call abort
+  if ("1" /= achar ( ichar ( "1"))) call abort
+  i = 49
+  c = "1"
+  if (achar(i) /= "1") call abort
+  if (iachar(c) /= iachar("1")) call abort
+  if (iachar(achar(50)) /= 50) call abort
+  if (iachar ("2")/= 50) call abort
+  if (achar (50) /= "2") call abort
+  if ("2" /= achar ( ichar ( "2"))) call abort
+  i = 50
+  c = "2"
+  if (achar(i) /= "2") call abort
+  if (iachar(c) /= iachar("2")) call abort
+  if (iachar(achar(51)) /= 51) call abort
+  if (iachar ("3")/= 51) call abort
+  if (achar (51) /= "3") call abort
+  if ("3" /= achar ( ichar ( "3"))) call abort
+  i = 51
+  c = "3"
+  if (achar(i) /= "3") call abort
+  if (iachar(c) /= iachar("3")) call abort
+  if (iachar(achar(52)) /= 52) call abort
+  if (iachar ("4")/= 52) call abort
+  if (achar (52) /= "4") call abort
+  if ("4" /= achar ( ichar ( "4"))) call abort
+  i = 52
+  c = "4"
+  if (achar(i) /= "4") call abort
+  if (iachar(c) /= iachar("4")) call abort
+  if (iachar(achar(53)) /= 53) call abort
+  if (iachar ("5")/= 53) call abort
+  if (achar (53) /= "5") call abort
+  if ("5" /= achar ( ichar ( "5"))) call abort
+  i = 53
+  c = "5"
+  if (achar(i) /= "5") call abort
+  if (iachar(c) /= iachar("5")) call abort
+  if (iachar(achar(54)) /= 54) call abort
+  if (iachar ("6")/= 54) call abort
+  if (achar (54) /= "6") call abort
+  if ("6" /= achar ( ichar ( "6"))) call abort
+  i = 54
+  c = "6"
+  if (achar(i) /= "6") call abort
+  if (iachar(c) /= iachar("6")) call abort
+  if (iachar(achar(55)) /= 55) call abort
+  if (iachar ("7")/= 55) call abort
+  if (achar (55) /= "7") call abort
+  if ("7" /= achar ( ichar ( "7"))) call abort
+  i = 55
+  c = "7"
+  if (achar(i) /= "7") call abort
+  if (iachar(c) /= iachar("7")) call abort
+  if (iachar(achar(56)) /= 56) call abort
+  if (iachar ("8")/= 56) call abort
+  if (achar (56) /= "8") call abort
+  if ("8" /= achar ( ichar ( "8"))) call abort
+  i = 56
+  c = "8"
+  if (achar(i) /= "8") call abort
+  if (iachar(c) /= iachar("8")) call abort
+  if (iachar(achar(57)) /= 57) call abort
+  if (iachar ("9")/= 57) call abort
+  if (achar (57) /= "9") call abort
+  if ("9" /= achar ( ichar ( "9"))) call abort
+  i = 57
+  c = "9"
+  if (achar(i) /= "9") call abort
+  if (iachar(c) /= iachar("9")) call abort
+  if (iachar(achar(58)) /= 58) call abort
+  if (iachar (":")/= 58) call abort
+  if (achar (58) /= ":") call abort
+  if (":" /= achar ( ichar ( ":"))) call abort
+  i = 58
+  c = ":"
+  if (achar(i) /= ":") call abort
+  if (iachar(c) /= iachar(":")) call abort
+  if (iachar(achar(59)) /= 59) call abort
+  if (iachar (";")/= 59) call abort
+  if (achar (59) /= ";") call abort
+  if (";" /= achar ( ichar ( ";"))) call abort
+  i = 59
+  c = ";"
+  if (achar(i) /= ";") call abort
+  if (iachar(c) /= iachar(";")) call abort
+  if (iachar(achar(60)) /= 60) call abort
+  if (iachar ("<")/= 60) call abort
+  if (achar (60) /= "<") call abort
+  if ("<" /= achar ( ichar ( "<"))) call abort
+  i = 60
+  c = "<"
+  if (achar(i) /= "<") call abort
+  if (iachar(c) /= iachar("<")) call abort
+  if (iachar(achar(61)) /= 61) call abort
+  if (iachar ("=")/= 61) call abort
+  if (achar (61) /= "=") call abort
+  if ("=" /= achar ( ichar ( "="))) call abort
+  i = 61
+  c = "="
+  if (achar(i) /= "=") call abort
+  if (iachar(c) /= iachar("=")) call abort
+  if (iachar(achar(62)) /= 62) call abort
+  if (iachar (">")/= 62) call abort
+  if (achar (62) /= ">") call abort
+  if (">" /= achar ( ichar ( ">"))) call abort
+  i = 62
+  c = ">"
+  if (achar(i) /= ">") call abort
+  if (iachar(c) /= iachar(">")) call abort
+  if (iachar(achar(63)) /= 63) call abort
+  if (iachar ("?")/= 63) call abort
+  if (achar (63) /= "?") call abort
+  if ("?" /= achar ( ichar ( "?"))) call abort
+  i = 63
+  c = "?"
+  if (achar(i) /= "?") call abort
+  if (iachar(c) /= iachar("?")) call abort
+  if (iachar(achar(64)) /= 64) call abort
+  if (iachar ("@")/= 64) call abort
+  if (achar (64) /= "@") call abort
+  if ("@" /= achar ( ichar ( "@"))) call abort
+  i = 64
+  c = "@"
+  if (achar(i) /= "@") call abort
+  if (iachar(c) /= iachar("@")) call abort
+  if (iachar(achar(65)) /= 65) call abort
+  if (iachar ("A")/= 65) call abort
+  if (achar (65) /= "A") call abort
+  if ("A" /= achar ( ichar ( "A"))) call abort
+  i = 65
+  c = "A"
+  if (achar(i) /= "A") call abort
+  if (iachar(c) /= iachar("A")) call abort
+  if (iachar(achar(66)) /= 66) call abort
+  if (iachar ("B")/= 66) call abort
+  if (achar (66) /= "B") call abort
+  if ("B" /= achar ( ichar ( "B"))) call abort
+  i = 66
+  c = "B"
+  if (achar(i) /= "B") call abort
+  if (iachar(c) /= iachar("B")) call abort
+  if (iachar(achar(67)) /= 67) call abort
+  if (iachar ("C")/= 67) call abort
+  if (achar (67) /= "C") call abort
+  if ("C" /= achar ( ichar ( "C"))) call abort
+  i = 67
+  c = "C"
+  if (achar(i) /= "C") call abort
+  if (iachar(c) /= iachar("C")) call abort
+  if (iachar(achar(68)) /= 68) call abort
+  if (iachar ("D")/= 68) call abort
+  if (achar (68) /= "D") call abort
+  if ("D" /= achar ( ichar ( "D"))) call abort
+  i = 68
+  c = "D"
+  if (achar(i) /= "D") call abort
+  if (iachar(c) /= iachar("D")) call abort
+  if (iachar(achar(69)) /= 69) call abort
+  if (iachar ("E")/= 69) call abort
+  if (achar (69) /= "E") call abort
+  if ("E" /= achar ( ichar ( "E"))) call abort
+  i = 69
+  c = "E"
+  if (achar(i) /= "E") call abort
+  if (iachar(c) /= iachar("E")) call abort
+  if (iachar(achar(70)) /= 70) call abort
+  if (iachar ("F")/= 70) call abort
+  if (achar (70) /= "F") call abort
+  if ("F" /= achar ( ichar ( "F"))) call abort
+  i = 70
+  c = "F"
+  if (achar(i) /= "F") call abort
+  if (iachar(c) /= iachar("F")) call abort
+  if (iachar(achar(71)) /= 71) call abort
+  if (iachar ("G")/= 71) call abort
+  if (achar (71) /= "G") call abort
+  if ("G" /= achar ( ichar ( "G"))) call abort
+  i = 71
+  c = "G"
+  if (achar(i) /= "G") call abort
+  if (iachar(c) /= iachar("G")) call abort
+  if (iachar(achar(72)) /= 72) call abort
+  if (iachar ("H")/= 72) call abort
+  if (achar (72) /= "H") call abort
+  if ("H" /= achar ( ichar ( "H"))) call abort
+  i = 72
+  c = "H"
+  if (achar(i) /= "H") call abort
+  if (iachar(c) /= iachar("H")) call abort
+  if (iachar(achar(73)) /= 73) call abort
+  if (iachar ("I")/= 73) call abort
+  if (achar (73) /= "I") call abort
+  if ("I" /= achar ( ichar ( "I"))) call abort
+  i = 73
+  c = "I"
+  if (achar(i) /= "I") call abort
+  if (iachar(c) /= iachar("I")) call abort
+  if (iachar(achar(74)) /= 74) call abort
+  if (iachar ("J")/= 74) call abort
+  if (achar (74) /= "J") call abort
+  if ("J" /= achar ( ichar ( "J"))) call abort
+  i = 74
+  c = "J"
+  if (achar(i) /= "J") call abort
+  if (iachar(c) /= iachar("J")) call abort
+  if (iachar(achar(75)) /= 75) call abort
+  if (iachar ("K")/= 75) call abort
+  if (achar (75) /= "K") call abort
+  if ("K" /= achar ( ichar ( "K"))) call abort
+  i = 75
+  c = "K"
+  if (achar(i) /= "K") call abort
+  if (iachar(c) /= iachar("K")) call abort
+  if (iachar(achar(76)) /= 76) call abort
+  if (iachar ("L")/= 76) call abort
+  if (achar (76) /= "L") call abort
+  if ("L" /= achar ( ichar ( "L"))) call abort
+  i = 76
+  c = "L"
+  if (achar(i) /= "L") call abort
+  if (iachar(c) /= iachar("L")) call abort
+  if (iachar(achar(77)) /= 77) call abort
+  if (iachar ("M")/= 77) call abort
+  if (achar (77) /= "M") call abort
+  if ("M" /= achar ( ichar ( "M"))) call abort
+  i = 77
+  c = "M"
+  if (achar(i) /= "M") call abort
+  if (iachar(c) /= iachar("M")) call abort
+  if (iachar(achar(78)) /= 78) call abort
+  if (iachar ("N")/= 78) call abort
+  if (achar (78) /= "N") call abort
+  if ("N" /= achar ( ichar ( "N"))) call abort
+  i = 78
+  c = "N"
+  if (achar(i) /= "N") call abort
+  if (iachar(c) /= iachar("N")) call abort
+  if (iachar(achar(79)) /= 79) call abort
+  if (iachar ("O")/= 79) call abort
+  if (achar (79) /= "O") call abort
+  if ("O" /= achar ( ichar ( "O"))) call abort
+  i = 79
+  c = "O"
+  if (achar(i) /= "O") call abort
+  if (iachar(c) /= iachar("O")) call abort
+  if (iachar(achar(80)) /= 80) call abort
+  if (iachar ("P")/= 80) call abort
+  if (achar (80) /= "P") call abort
+  if ("P" /= achar ( ichar ( "P"))) call abort
+  i = 80
+  c = "P"
+  if (achar(i) /= "P") call abort
+  if (iachar(c) /= iachar("P")) call abort
+  if (iachar(achar(81)) /= 81) call abort
+  if (iachar ("Q")/= 81) call abort
+  if (achar (81) /= "Q") call abort
+  if ("Q" /= achar ( ichar ( "Q"))) call abort
+  i = 81
+  c = "Q"
+  if (achar(i) /= "Q") call abort
+  if (iachar(c) /= iachar("Q")) call abort
+  if (iachar(achar(82)) /= 82) call abort
+  if (iachar ("R")/= 82) call abort
+  if (achar (82) /= "R") call abort
+  if ("R" /= achar ( ichar ( "R"))) call abort
+  i = 82
+  c = "R"
+  if (achar(i) /= "R") call abort
+  if (iachar(c) /= iachar("R")) call abort
+  if (iachar(achar(83)) /= 83) call abort
+  if (iachar ("S")/= 83) call abort
+  if (achar (83) /= "S") call abort
+  if ("S" /= achar ( ichar ( "S"))) call abort
+  i = 83
+  c = "S"
+  if (achar(i) /= "S") call abort
+  if (iachar(c) /= iachar("S")) call abort
+  if (iachar(achar(84)) /= 84) call abort
+  if (iachar ("T")/= 84) call abort
+  if (achar (84) /= "T") call abort
+  if ("T" /= achar ( ichar ( "T"))) call abort
+  i = 84
+  c = "T"
+  if (achar(i) /= "T") call abort
+  if (iachar(c) /= iachar("T")) call abort
+  if (iachar(achar(85)) /= 85) call abort
+  if (iachar ("U")/= 85) call abort
+  if (achar (85) /= "U") call abort
+  if ("U" /= achar ( ichar ( "U"))) call abort
+  i = 85
+  c = "U"
+  if (achar(i) /= "U") call abort
+  if (iachar(c) /= iachar("U")) call abort
+  if (iachar(achar(86)) /= 86) call abort
+  if (iachar ("V")/= 86) call abort
+  if (achar (86) /= "V") call abort
+  if ("V" /= achar ( ichar ( "V"))) call abort
+  i = 86
+  c = "V"
+  if (achar(i) /= "V") call abort
+  if (iachar(c) /= iachar("V")) call abort
+  if (iachar(achar(87)) /= 87) call abort
+  if (iachar ("W")/= 87) call abort
+  if (achar (87) /= "W") call abort
+  if ("W" /= achar ( ichar ( "W"))) call abort
+  i = 87
+  c = "W"
+  if (achar(i) /= "W") call abort
+  if (iachar(c) /= iachar("W")) call abort
+  if (iachar(achar(88)) /= 88) call abort
+  if (iachar ("X")/= 88) call abort
+  if (achar (88) /= "X") call abort
+  if ("X" /= achar ( ichar ( "X"))) call abort
+  i = 88
+  c = "X"
+  if (achar(i) /= "X") call abort
+  if (iachar(c) /= iachar("X")) call abort
+  if (iachar(achar(89)) /= 89) call abort
+  if (iachar ("Y")/= 89) call abort
+  if (achar (89) /= "Y") call abort
+  if ("Y" /= achar ( ichar ( "Y"))) call abort
+  i = 89
+  c = "Y"
+  if (achar(i) /= "Y") call abort
+  if (iachar(c) /= iachar("Y")) call abort
+  if (iachar(achar(90)) /= 90) call abort
+  if (iachar ("Z")/= 90) call abort
+  if (achar (90) /= "Z") call abort
+  if ("Z" /= achar ( ichar ( "Z"))) call abort
+  i = 90
+  c = "Z"
+  if (achar(i) /= "Z") call abort
+  if (iachar(c) /= iachar("Z")) call abort
+  if (iachar(achar(91)) /= 91) call abort
+  if (iachar ("[")/= 91) call abort
+  if (achar (91) /= "[") call abort
+  if ("[" /= achar ( ichar ( "["))) call abort
+  i = 91
+  c = "["
+  if (achar(i) /= "[") call abort
+  if (iachar(c) /= iachar("[")) call abort
+  if (iachar(achar(92)) /= 92) call abort
+  if (iachar ("\")/= 92) call abort
+  if (achar (92) /= "\") call abort
+  if ("\" /= achar ( ichar ( "\"))) call abort
+  i = 92
+  c = "\"
+  if (achar(i) /= "\") call abort
+  if (iachar(c) /= iachar("\")) call abort
+  if (iachar(achar(93)) /= 93) call abort
+  if (iachar ("]")/= 93) call abort
+  if (achar (93) /= "]") call abort
+  if ("]" /= achar ( ichar ( "]"))) call abort
+  i = 93
+  c = "]"
+  if (achar(i) /= "]") call abort
+  if (iachar(c) /= iachar("]")) call abort
+  if (iachar(achar(94)) /= 94) call abort
+  if (iachar ("^")/= 94) call abort
+  if (achar (94) /= "^") call abort
+  if ("^" /= achar ( ichar ( "^"))) call abort
+  i = 94
+  c = "^"
+  if (achar(i) /= "^") call abort
+  if (iachar(c) /= iachar("^")) call abort
+  if (iachar(achar(95)) /= 95) call abort
+  if (iachar ("_")/= 95) call abort
+  if (achar (95) /= "_") call abort
+  if ("_" /= achar ( ichar ( "_"))) call abort
+  i = 95
+  c = "_"
+  if (achar(i) /= "_") call abort
+  if (iachar(c) /= iachar("_")) call abort
+  if (iachar(achar(96)) /= 96) call abort
+  if (iachar ("`")/= 96) call abort
+  if (achar (96) /= "`") call abort
+  if ("`" /= achar ( ichar ( "`"))) call abort
+  i = 96
+  c = "`"
+  if (achar(i) /= "`") call abort
+  if (iachar(c) /= iachar("`")) call abort
+  if (iachar(achar(97)) /= 97) call abort
+  if (iachar ("a")/= 97) call abort
+  if (achar (97) /= "a") call abort
+  if ("a" /= achar ( ichar ( "a"))) call abort
+  i = 97
+  c = "a"
+  if (achar(i) /= "a") call abort
+  if (iachar(c) /= iachar("a")) call abort
+  if (iachar(achar(98)) /= 98) call abort
+  if (iachar ("b")/= 98) call abort
+  if (achar (98) /= "b") call abort
+  if ("b" /= achar ( ichar ( "b"))) call abort
+  i = 98
+  c = "b"
+  if (achar(i) /= "b") call abort
+  if (iachar(c) /= iachar("b")) call abort
+  if (iachar(achar(99)) /= 99) call abort
+  if (iachar ("c")/= 99) call abort
+  if (achar (99) /= "c") call abort
+  if ("c" /= achar ( ichar ( "c"))) call abort
+  i = 99
+  c = "c"
+  if (achar(i) /= "c") call abort
+  if (iachar(c) /= iachar("c")) call abort
+  if (iachar(achar(100)) /= 100) call abort
+  if (iachar ("d")/= 100) call abort
+  if (achar (100) /= "d") call abort
+  if ("d" /= achar ( ichar ( "d"))) call abort
+  i = 100
+  c = "d"
+  if (achar(i) /= "d") call abort
+  if (iachar(c) /= iachar("d")) call abort
+  if (iachar(achar(101)) /= 101) call abort
+  if (iachar ("e")/= 101) call abort
+  if (achar (101) /= "e") call abort
+  if ("e" /= achar ( ichar ( "e"))) call abort
+  i = 101
+  c = "e"
+  if (achar(i) /= "e") call abort
+  if (iachar(c) /= iachar("e")) call abort
+  if (iachar(achar(102)) /= 102) call abort
+  if (iachar ("f")/= 102) call abort
+  if (achar (102) /= "f") call abort
+  if ("f" /= achar ( ichar ( "f"))) call abort
+  i = 102
+  c = "f"
+  if (achar(i) /= "f") call abort
+  if (iachar(c) /= iachar("f")) call abort
+  if (iachar(achar(103)) /= 103) call abort
+  if (iachar ("g")/= 103) call abort
+  if (achar (103) /= "g") call abort
+  if ("g" /= achar ( ichar ( "g"))) call abort
+  i = 103
+  c = "g"
+  if (achar(i) /= "g") call abort
+  if (iachar(c) /= iachar("g")) call abort
+  if (iachar(achar(104)) /= 104) call abort
+  if (iachar ("h")/= 104) call abort
+  if (achar (104) /= "h") call abort
+  if ("h" /= achar ( ichar ( "h"))) call abort
+  i = 104
+  c = "h"
+  if (achar(i) /= "h") call abort
+  if (iachar(c) /= iachar("h")) call abort
+  if (iachar(achar(105)) /= 105) call abort
+  if (iachar ("i")/= 105) call abort
+  if (achar (105) /= "i") call abort
+  if ("i" /= achar ( ichar ( "i"))) call abort
+  i = 105
+  c = "i"
+  if (achar(i) /= "i") call abort
+  if (iachar(c) /= iachar("i")) call abort
+  if (iachar(achar(106)) /= 106) call abort
+  if (iachar ("j")/= 106) call abort
+  if (achar (106) /= "j") call abort
+  if ("j" /= achar ( ichar ( "j"))) call abort
+  i = 106
+  c = "j"
+  if (achar(i) /= "j") call abort
+  if (iachar(c) /= iachar("j")) call abort
+  if (iachar(achar(107)) /= 107) call abort
+  if (iachar ("k")/= 107) call abort
+  if (achar (107) /= "k") call abort
+  if ("k" /= achar ( ichar ( "k"))) call abort
+  i = 107
+  c = "k"
+  if (achar(i) /= "k") call abort
+  if (iachar(c) /= iachar("k")) call abort
+  if (iachar(achar(108)) /= 108) call abort
+  if (iachar ("l")/= 108) call abort
+  if (achar (108) /= "l") call abort
+  if ("l" /= achar ( ichar ( "l"))) call abort
+  i = 108
+  c = "l"
+  if (achar(i) /= "l") call abort
+  if (iachar(c) /= iachar("l")) call abort
+  if (iachar(achar(109)) /= 109) call abort
+  if (iachar ("m")/= 109) call abort
+  if (achar (109) /= "m") call abort
+  if ("m" /= achar ( ichar ( "m"))) call abort
+  i = 109
+  c = "m"
+  if (achar(i) /= "m") call abort
+  if (iachar(c) /= iachar("m")) call abort
+  if (iachar(achar(110)) /= 110) call abort
+  if (iachar ("n")/= 110) call abort
+  if (achar (110) /= "n") call abort
+  if ("n" /= achar ( ichar ( "n"))) call abort
+  i = 110
+  c = "n"
+  if (achar(i) /= "n") call abort
+  if (iachar(c) /= iachar("n")) call abort
+  if (iachar(achar(111)) /= 111) call abort
+  if (iachar ("o")/= 111) call abort
+  if (achar (111) /= "o") call abort
+  if ("o" /= achar ( ichar ( "o"))) call abort
+  i = 111
+  c = "o"
+  if (achar(i) /= "o") call abort
+  if (iachar(c) /= iachar("o")) call abort
+  if (iachar(achar(112)) /= 112) call abort
+  if (iachar ("p")/= 112) call abort
+  if (achar (112) /= "p") call abort
+  if ("p" /= achar ( ichar ( "p"))) call abort
+  i = 112
+  c = "p"
+  if (achar(i) /= "p") call abort
+  if (iachar(c) /= iachar("p")) call abort
+  if (iachar(achar(113)) /= 113) call abort
+  if (iachar ("q")/= 113) call abort
+  if (achar (113) /= "q") call abort
+  if ("q" /= achar ( ichar ( "q"))) call abort
+  i = 113
+  c = "q"
+  if (achar(i) /= "q") call abort
+  if (iachar(c) /= iachar("q")) call abort
+  if (iachar(achar(114)) /= 114) call abort
+  if (iachar ("r")/= 114) call abort
+  if (achar (114) /= "r") call abort
+  if ("r" /= achar ( ichar ( "r"))) call abort
+  i = 114
+  c = "r"
+  if (achar(i) /= "r") call abort
+  if (iachar(c) /= iachar("r")) call abort
+  if (iachar(achar(115)) /= 115) call abort
+  if (iachar ("s")/= 115) call abort
+  if (achar (115) /= "s") call abort
+  if ("s" /= achar ( ichar ( "s"))) call abort
+  i = 115
+  c = "s"
+  if (achar(i) /= "s") call abort
+  if (iachar(c) /= iachar("s")) call abort
+  if (iachar(achar(116)) /= 116) call abort
+  if (iachar ("t")/= 116) call abort
+  if (achar (116) /= "t") call abort
+  if ("t" /= achar ( ichar ( "t"))) call abort
+  i = 116
+  c = "t"
+  if (achar(i) /= "t") call abort
+  if (iachar(c) /= iachar("t")) call abort
+  if (iachar(achar(117)) /= 117) call abort
+  if (iachar ("u")/= 117) call abort
+  if (achar (117) /= "u") call abort
+  if ("u" /= achar ( ichar ( "u"))) call abort
+  i = 117
+  c = "u"
+  if (achar(i) /= "u") call abort
+  if (iachar(c) /= iachar("u")) call abort
+  if (iachar(achar(118)) /= 118) call abort
+  if (iachar ("v")/= 118) call abort
+  if (achar (118) /= "v") call abort
+  if ("v" /= achar ( ichar ( "v"))) call abort
+  i = 118
+  c = "v"
+  if (achar(i) /= "v") call abort
+  if (iachar(c) /= iachar("v")) call abort
+  if (iachar(achar(119)) /= 119) call abort
+  if (iachar ("w")/= 119) call abort
+  if (achar (119) /= "w") call abort
+  if ("w" /= achar ( ichar ( "w"))) call abort
+  i = 119
+  c = "w"
+  if (achar(i) /= "w") call abort
+  if (iachar(c) /= iachar("w")) call abort
+  if (iachar(achar(120)) /= 120) call abort
+  if (iachar ("x")/= 120) call abort
+  if (achar (120) /= "x") call abort
+  if ("x" /= achar ( ichar ( "x"))) call abort
+  i = 120
+  c = "x"
+  if (achar(i) /= "x") call abort
+  if (iachar(c) /= iachar("x")) call abort
+  if (iachar(achar(121)) /= 121) call abort
+  if (iachar ("y")/= 121) call abort
+  if (achar (121) /= "y") call abort
+  if ("y" /= achar ( ichar ( "y"))) call abort
+  i = 121
+  c = "y"
+  if (achar(i) /= "y") call abort
+  if (iachar(c) /= iachar("y")) call abort
+  if (iachar(achar(122)) /= 122) call abort
+  if (iachar ("z")/= 122) call abort
+  if (achar (122) /= "z") call abort
+  if ("z" /= achar ( ichar ( "z"))) call abort
+  i = 122
+  c = "z"
+  if (achar(i) /= "z") call abort
+  if (iachar(c) /= iachar("z")) call abort
+  if (iachar(achar(123)) /= 123) call abort
+  if (iachar ("{")/= 123) call abort
+  if (achar (123) /= "{") call abort
+  if ("{" /= achar ( ichar ( "{"))) call abort
+  i = 123
+  c = "{"
+  if (achar(i) /= "{") call abort
+  if (iachar(c) /= iachar("{")) call abort
+  if (iachar(achar(124)) /= 124) call abort
+  if (iachar ("|")/= 124) call abort
+  if (achar (124) /= "|") call abort
+  if ("|" /= achar ( ichar ( "|"))) call abort
+  i = 124
+  c = "|"
+  if (achar(i) /= "|") call abort
+  if (iachar(c) /= iachar("|")) call abort
+  if (iachar(achar(125)) /= 125) call abort
+  if (iachar ("}")/= 125) call abort
+  if (achar (125) /= "}") call abort
+  if ("}" /= achar ( ichar ( "}"))) call abort
+  i = 125
+  c = "}"
+  if (achar(i) /= "}") call abort
+  if (iachar(c) /= iachar("}")) call abort
+  if (iachar(achar(126)) /= 126) call abort
+  if (iachar ("~")/= 126) call abort
+  if (achar (126) /= "~") call abort
+  if ("~" /= achar ( ichar ( "~"))) call abort
+  i = 126
+  c = "~"
+  if (achar(i) /= "~") call abort
+  if (iachar(c) /= iachar("~")) call abort
+  if (iachar(achar(127)) /= 127) call abort
+  if (iachar ("")/= 127) call abort
+  if (achar (127) /= "") call abort
+  if ("" /= achar ( ichar ( ""))) call abort
+  i = 127
+  c = ""
+  if (achar(i) /= "") call abort
+  if (iachar(c) /= iachar("")) call abort
+  if (iachar(achar(128)) /= 128) call abort
+  if (iachar ("€")/= 128) call abort
+  if (achar (128) /= "€") call abort
+  if ("€" /= achar ( ichar ( "€"))) call abort
+  i = 128
+  c = "€"
+  if (achar(i) /= "€") call abort
+  if (iachar(c) /= iachar("€")) call abort
+  if (iachar(achar(129)) /= 129) call abort
+  if (iachar ("�")/= 129) call abort
+  if (achar (129) /= "�") call abort
+  if ("�" /= achar ( ichar ( "�"))) call abort
+  i = 129
+  c = "�"
+  if (achar(i) /= "�") call abort
+  if (iachar(c) /= iachar("�")) call abort
+  if (iachar(achar(130)) /= 130) call abort
+  if (iachar ("‚")/= 130) call abort
+  if (achar (130) /= "‚") call abort
+  if ("‚" /= achar ( ichar ( "‚"))) call abort
+  i = 130
+  c = "‚"
+  if (achar(i) /= "‚") call abort
+  if (iachar(c) /= iachar("‚")) call abort
+  if (iachar(achar(131)) /= 131) call abort
+  if (iachar ("ƒ")/= 131) call abort
+  if (achar (131) /= "ƒ") call abort
+  if ("ƒ" /= achar ( ichar ( "ƒ"))) call abort
+  i = 131
+  c = "ƒ"
+  if (achar(i) /= "ƒ") call abort
+  if (iachar(c) /= iachar("ƒ")) call abort
+  if (iachar(achar(132)) /= 132) call abort
+  if (iachar ("„")/= 132) call abort
+  if (achar (132) /= "„") call abort
+  if ("„" /= achar ( ichar ( "„"))) call abort
+  i = 132
+  c = "„"
+  if (achar(i) /= "„") call abort
+  if (iachar(c) /= iachar("„")) call abort
+  if (iachar(achar(133)) /= 133) call abort
+  if (iachar ("…")/= 133) call abort
+  if (achar (133) /= "…") call abort
+  if ("…" /= achar ( ichar ( "…"))) call abort
+  i = 133
+  c = "…"
+  if (achar(i) /= "…") call abort
+  if (iachar(c) /= iachar("…")) call abort
+  if (iachar(achar(134)) /= 134) call abort
+  if (iachar ("†")/= 134) call abort
+  if (achar (134) /= "†") call abort
+  if ("†" /= achar ( ichar ( "†"))) call abort
+  i = 134
+  c = "†"
+  if (achar(i) /= "†") call abort
+  if (iachar(c) /= iachar("†")) call abort
+  if (iachar(achar(135)) /= 135) call abort
+  if (iachar ("‡")/= 135) call abort
+  if (achar (135) /= "‡") call abort
+  if ("‡" /= achar ( ichar ( "‡"))) call abort
+  i = 135
+  c = "‡"
+  if (achar(i) /= "‡") call abort
+  if (iachar(c) /= iachar("‡")) call abort
+  if (iachar(achar(136)) /= 136) call abort
+  if (iachar ("ˆ")/= 136) call abort
+  if (achar (136) /= "ˆ") call abort
+  if ("ˆ" /= achar ( ichar ( "ˆ"))) call abort
+  i = 136
+  c = "ˆ"
+  if (achar(i) /= "ˆ") call abort
+  if (iachar(c) /= iachar("ˆ")) call abort
+  if (iachar(achar(137)) /= 137) call abort
+  if (iachar ("‰")/= 137) call abort
+  if (achar (137) /= "‰") call abort
+  if ("‰" /= achar ( ichar ( "‰"))) call abort
+  i = 137
+  c = "‰"
+  if (achar(i) /= "‰") call abort
+  if (iachar(c) /= iachar("‰")) call abort
+  if (iachar(achar(138)) /= 138) call abort
+  if (iachar ("Š")/= 138) call abort
+  if (achar (138) /= "Š") call abort
+  if ("Š" /= achar ( ichar ( "Š"))) call abort
+  i = 138
+  c = "Š"
+  if (achar(i) /= "Š") call abort
+  if (iachar(c) /= iachar("Š")) call abort
+  if (iachar(achar(139)) /= 139) call abort
+  if (iachar ("‹")/= 139) call abort
+  if (achar (139) /= "‹") call abort
+  if ("‹" /= achar ( ichar ( "‹"))) call abort
+  i = 139
+  c = "‹"
+  if (achar(i) /= "‹") call abort
+  if (iachar(c) /= iachar("‹")) call abort
+  if (iachar(achar(140)) /= 140) call abort
+  if (iachar ("Œ")/= 140) call abort
+  if (achar (140) /= "Œ") call abort
+  if ("Œ" /= achar ( ichar ( "Œ"))) call abort
+  i = 140
+  c = "Œ"
+  if (achar(i) /= "Œ") call abort
+  if (iachar(c) /= iachar("Œ")) call abort
+  if (iachar(achar(141)) /= 141) call abort
+  if (iachar ("�")/= 141) call abort
+  if (achar (141) /= "�") call abort
+  if ("�" /= achar ( ichar ( "�"))) call abort
+  i = 141
+  c = "�"
+  if (achar(i) /= "�") call abort
+  if (iachar(c) /= iachar("�")) call abort
+  if (iachar(achar(142)) /= 142) call abort
+  if (iachar ("Ž")/= 142) call abort
+  if (achar (142) /= "Ž") call abort
+  if ("Ž" /= achar ( ichar ( "Ž"))) call abort
+  i = 142
+  c = "Ž"
+  if (achar(i) /= "Ž") call abort
+  if (iachar(c) /= iachar("Ž")) call abort
+  if (iachar(achar(143)) /= 143) call abort
+  if (iachar ("�")/= 143) call abort
+  if (achar (143) /= "�") call abort
+  if ("�" /= achar ( ichar ( "�"))) call abort
+  i = 143
+  c = "�"
+  if (achar(i) /= "�") call abort
+  if (iachar(c) /= iachar("�")) call abort
+  if (iachar(achar(144)) /= 144) call abort
+  if (iachar ("�")/= 144) call abort
+  if (achar (144) /= "�") call abort
+  if ("�" /= achar ( ichar ( "�"))) call abort
+  i = 144
+  c = "�"
+  if (achar(i) /= "�") call abort
+  if (iachar(c) /= iachar("�")) call abort
+  if (iachar(achar(145)) /= 145) call abort
+  if (iachar ("‘")/= 145) call abort
+  if (achar (145) /= "‘") call abort
+  if ("‘" /= achar ( ichar ( "‘"))) call abort
+  i = 145
+  c = "‘"
+  if (achar(i) /= "‘") call abort
+  if (iachar(c) /= iachar("‘")) call abort
+  if (iachar(achar(146)) /= 146) call abort
+  if (iachar ("’")/= 146) call abort
+  if (achar (146) /= "’") call abort
+  if ("’" /= achar ( ichar ( "’"))) call abort
+  i = 146
+  c = "’"
+  if (achar(i) /= "’") call abort
+  if (iachar(c) /= iachar("’")) call abort
+  if (iachar(achar(147)) /= 147) call abort
+  if (iachar ("“")/= 147) call abort
+  if (achar (147) /= "“") call abort
+  if ("“" /= achar ( ichar ( "“"))) call abort
+  i = 147
+  c = "“"
+  if (achar(i) /= "“") call abort
+  if (iachar(c) /= iachar("“")) call abort
+  if (iachar(achar(148)) /= 148) call abort
+  if (iachar ("”")/= 148) call abort
+  if (achar (148) /= "”") call abort
+  if ("”" /= achar ( ichar ( "”"))) call abort
+  i = 148
+  c = "”"
+  if (achar(i) /= "”") call abort
+  if (iachar(c) /= iachar("”")) call abort
+  if (iachar(achar(149)) /= 149) call abort
+  if (iachar ("•")/= 149) call abort
+  if (achar (149) /= "•") call abort
+  if ("•" /= achar ( ichar ( "•"))) call abort
+  i = 149
+  c = "•"
+  if (achar(i) /= "•") call abort
+  if (iachar(c) /= iachar("•")) call abort
+  if (iachar(achar(150)) /= 150) call abort
+  if (iachar ("–")/= 150) call abort
+  if (achar (150) /= "–") call abort
+  if ("–" /= achar ( ichar ( "–"))) call abort
+  i = 150
+  c = "–"
+  if (achar(i) /= "–") call abort
+  if (iachar(c) /= iachar("–")) call abort
+  if (iachar(achar(151)) /= 151) call abort
+  if (iachar ("—")/= 151) call abort
+  if (achar (151) /= "—") call abort
+  if ("—" /= achar ( ichar ( "—"))) call abort
+  i = 151
+  c = "—"
+  if (achar(i) /= "—") call abort
+  if (iachar(c) /= iachar("—")) call abort
+  if (iachar(achar(152)) /= 152) call abort
+  if (iachar ("˜")/= 152) call abort
+  if (achar (152) /= "˜") call abort
+  if ("˜" /= achar ( ichar ( "˜"))) call abort
+  i = 152
+  c = "˜"
+  if (achar(i) /= "˜") call abort
+  if (iachar(c) /= iachar("˜")) call abort
+  if (iachar(achar(153)) /= 153) call abort
+  if (iachar ("™")/= 153) call abort
+  if (achar (153) /= "™") call abort
+  if ("™" /= achar ( ichar ( "™"))) call abort
+  i = 153
+  c = "™"
+  if (achar(i) /= "™") call abort
+  if (iachar(c) /= iachar("™")) call abort
+  if (iachar(achar(154)) /= 154) call abort
+  if (iachar ("š")/= 154) call abort
+  if (achar (154) /= "š") call abort
+  if ("š" /= achar ( ichar ( "š"))) call abort
+  i = 154
+  c = "š"
+  if (achar(i) /= "š") call abort
+  if (iachar(c) /= iachar("š")) call abort
+  if (iachar(achar(155)) /= 155) call abort
+  if (iachar ("›")/= 155) call abort
+  if (achar (155) /= "›") call abort
+  if ("›" /= achar ( ichar ( "›"))) call abort
+  i = 155
+  c = "›"
+  if (achar(i) /= "›") call abort
+  if (iachar(c) /= iachar("›")) call abort
+  if (iachar(achar(156)) /= 156) call abort
+  if (iachar ("œ")/= 156) call abort
+  if (achar (156) /= "œ") call abort
+  if ("œ" /= achar ( ichar ( "œ"))) call abort
+  i = 156
+  c = "œ"
+  if (achar(i) /= "œ") call abort
+  if (iachar(c) /= iachar("œ")) call abort
+  if (iachar(achar(157)) /= 157) call abort
+  if (iachar ("�")/= 157) call abort
+  if (achar (157) /= "�") call abort
+  if ("�" /= achar ( ichar ( "�"))) call abort
+  i = 157
+  c = "�"
+  if (achar(i) /= "�") call abort
+  if (iachar(c) /= iachar("�")) call abort
+  if (iachar(achar(158)) /= 158) call abort
+  if (iachar ("ž")/= 158) call abort
+  if (achar (158) /= "ž") call abort
+  if ("ž" /= achar ( ichar ( "ž"))) call abort
+  i = 158
+  c = "ž"
+  if (achar(i) /= "ž") call abort
+  if (iachar(c) /= iachar("ž")) call abort
+  if (iachar(achar(159)) /= 159) call abort
+  if (iachar ("Ÿ")/= 159) call abort
+  if (achar (159) /= "Ÿ") call abort
+  if ("Ÿ" /= achar ( ichar ( "Ÿ"))) call abort
+  i = 159
+  c = "Ÿ"
+  if (achar(i) /= "Ÿ") call abort
+  if (iachar(c) /= iachar("Ÿ")) call abort
+  if (iachar(achar(160)) /= 160) call abort
+  if (iachar (" ")/= 160) call abort
+  if (achar (160) /= " ") call abort
+  if (" " /= achar ( ichar ( " "))) call abort
+  i = 160
+  c = " "
+  if (achar(i) /= " ") call abort
+  if (iachar(c) /= iachar(" ")) call abort
+  if (iachar(achar(161)) /= 161) call abort
+  if (iachar ("¡")/= 161) call abort
+  if (achar (161) /= "¡") call abort
+  if ("¡" /= achar ( ichar ( "¡"))) call abort
+  i = 161
+  c = "¡"
+  if (achar(i) /= "¡") call abort
+  if (iachar(c) /= iachar("¡")) call abort
+  if (iachar(achar(162)) /= 162) call abort
+  if (iachar ("¢")/= 162) call abort
+  if (achar (162) /= "¢") call abort
+  if ("¢" /= achar ( ichar ( "¢"))) call abort
+  i = 162
+  c = "¢"
+  if (achar(i) /= "¢") call abort
+  if (iachar(c) /= iachar("¢")) call abort
+  if (iachar(achar(163)) /= 163) call abort
+  if (iachar ("£")/= 163) call abort
+  if (achar (163) /= "£") call abort
+  if ("£" /= achar ( ichar ( "£"))) call abort
+  i = 163
+  c = "£"
+  if (achar(i) /= "£") call abort
+  if (iachar(c) /= iachar("£")) call abort
+  if (iachar(achar(164)) /= 164) call abort
+  if (iachar ("¤")/= 164) call abort
+  if (achar (164) /= "¤") call abort
+  if ("¤" /= achar ( ichar ( "¤"))) call abort
+  i = 164
+  c = "¤"
+  if (achar(i) /= "¤") call abort
+  if (iachar(c) /= iachar("¤")) call abort
+  if (iachar(achar(165)) /= 165) call abort
+  if (iachar ("¥")/= 165) call abort
+  if (achar (165) /= "¥") call abort
+  if ("¥" /= achar ( ichar ( "¥"))) call abort
+  i = 165
+  c = "¥"
+  if (achar(i) /= "¥") call abort
+  if (iachar(c) /= iachar("¥")) call abort
+  if (iachar(achar(166)) /= 166) call abort
+  if (iachar ("¦")/= 166) call abort
+  if (achar (166) /= "¦") call abort
+  if ("¦" /= achar ( ichar ( "¦"))) call abort
+  i = 166
+  c = "¦"
+  if (achar(i) /= "¦") call abort
+  if (iachar(c) /= iachar("¦")) call abort
+  if (iachar(achar(167)) /= 167) call abort
+  if (iachar ("§")/= 167) call abort
+  if (achar (167) /= "§") call abort
+  if ("§" /= achar ( ichar ( "§"))) call abort
+  i = 167
+  c = "§"
+  if (achar(i) /= "§") call abort
+  if (iachar(c) /= iachar("§")) call abort
+  if (iachar(achar(168)) /= 168) call abort
+  if (iachar ("¨")/= 168) call abort
+  if (achar (168) /= "¨") call abort
+  if ("¨" /= achar ( ichar ( "¨"))) call abort
+  i = 168
+  c = "¨"
+  if (achar(i) /= "¨") call abort
+  if (iachar(c) /= iachar("¨")) call abort
+  if (iachar(achar(169)) /= 169) call abort
+  if (iachar ("©")/= 169) call abort
+  if (achar (169) /= "©") call abort
+  if ("©" /= achar ( ichar ( "©"))) call abort
+  i = 169
+  c = "©"
+  if (achar(i) /= "©") call abort
+  if (iachar(c) /= iachar("©")) call abort
+  if (iachar(achar(170)) /= 170) call abort
+  if (iachar ("ª")/= 170) call abort
+  if (achar (170) /= "ª") call abort
+  if ("ª" /= achar ( ichar ( "ª"))) call abort
+  i = 170
+  c = "ª"
+  if (achar(i) /= "ª") call abort
+  if (iachar(c) /= iachar("ª")) call abort
+  if (iachar(achar(171)) /= 171) call abort
+  if (iachar ("«")/= 171) call abort
+  if (achar (171) /= "«") call abort
+  if ("«" /= achar ( ichar ( "«"))) call abort
+  i = 171
+  c = "«"
+  if (achar(i) /= "«") call abort
+  if (iachar(c) /= iachar("«")) call abort
+  if (iachar(achar(172)) /= 172) call abort
+  if (iachar ("¬")/= 172) call abort
+  if (achar (172) /= "¬") call abort
+  if ("¬" /= achar ( ichar ( "¬"))) call abort
+  i = 172
+  c = "¬"
+  if (achar(i) /= "¬") call abort
+  if (iachar(c) /= iachar("¬")) call abort
+  if (iachar(achar(173)) /= 173) call abort
+  if (iachar ("­")/= 173) call abort
+  if (achar (173) /= "­") call abort
+  if ("­" /= achar ( ichar ( "­"))) call abort
+  i = 173
+  c = "­"
+  if (achar(i) /= "­") call abort
+  if (iachar(c) /= iachar("­")) call abort
+  if (iachar(achar(174)) /= 174) call abort
+  if (iachar ("®")/= 174) call abort
+  if (achar (174) /= "®") call abort
+  if ("®" /= achar ( ichar ( "®"))) call abort
+  i = 174
+  c = "®"
+  if (achar(i) /= "®") call abort
+  if (iachar(c) /= iachar("®")) call abort
+  if (iachar(achar(175)) /= 175) call abort
+  if (iachar ("¯")/= 175) call abort
+  if (achar (175) /= "¯") call abort
+  if ("¯" /= achar ( ichar ( "¯"))) call abort
+  i = 175
+  c = "¯"
+  if (achar(i) /= "¯") call abort
+  if (iachar(c) /= iachar("¯")) call abort
+  if (iachar(achar(176)) /= 176) call abort
+  if (iachar ("°")/= 176) call abort
+  if (achar (176) /= "°") call abort
+  if ("°" /= achar ( ichar ( "°"))) call abort
+  i = 176
+  c = "°"
+  if (achar(i) /= "°") call abort
+  if (iachar(c) /= iachar("°")) call abort
+  if (iachar(achar(177)) /= 177) call abort
+  if (iachar ("±")/= 177) call abort
+  if (achar (177) /= "±") call abort
+  if ("±" /= achar ( ichar ( "±"))) call abort
+  i = 177
+  c = "±"
+  if (achar(i) /= "±") call abort
+  if (iachar(c) /= iachar("±")) call abort
+  if (iachar(achar(178)) /= 178) call abort
+  if (iachar ("²")/= 178) call abort
+  if (achar (178) /= "²") call abort
+  if ("²" /= achar ( ichar ( "²"))) call abort
+  i = 178
+  c = "²"
+  if (achar(i) /= "²") call abort
+  if (iachar(c) /= iachar("²")) call abort
+  if (iachar(achar(179)) /= 179) call abort
+  if (iachar ("³")/= 179) call abort
+  if (achar (179) /= "³") call abort
+  if ("³" /= achar ( ichar ( "³"))) call abort
+  i = 179
+  c = "³"
+  if (achar(i) /= "³") call abort
+  if (iachar(c) /= iachar("³")) call abort
+  if (iachar(achar(180)) /= 180) call abort
+  if (iachar ("´")/= 180) call abort
+  if (achar (180) /= "´") call abort
+  if ("´" /= achar ( ichar ( "´"))) call abort
+  i = 180
+  c = "´"
+  if (achar(i) /= "´") call abort
+  if (iachar(c) /= iachar("´")) call abort
+  if (iachar(achar(181)) /= 181) call abort
+  if (iachar ("µ")/= 181) call abort
+  if (achar (181) /= "µ") call abort
+  if ("µ" /= achar ( ichar ( "µ"))) call abort
+  i = 181
+  c = "µ"
+  if (achar(i) /= "µ") call abort
+  if (iachar(c) /= iachar("µ")) call abort
+  if (iachar(achar(182)) /= 182) call abort
+  if (iachar ("¶")/= 182) call abort
+  if (achar (182) /= "¶") call abort
+  if ("¶" /= achar ( ichar ( "¶"))) call abort
+  i = 182
+  c = "¶"
+  if (achar(i) /= "¶") call abort
+  if (iachar(c) /= iachar("¶")) call abort
+  if (iachar(achar(183)) /= 183) call abort
+  if (iachar ("·")/= 183) call abort
+  if (achar (183) /= "·") call abort
+  if ("·" /= achar ( ichar ( "·"))) call abort
+  i = 183
+  c = "·"
+  if (achar(i) /= "·") call abort
+  if (iachar(c) /= iachar("·")) call abort
+  if (iachar(achar(184)) /= 184) call abort
+  if (iachar ("¸")/= 184) call abort
+  if (achar (184) /= "¸") call abort
+  if ("¸" /= achar ( ichar ( "¸"))) call abort
+  i = 184
+  c = "¸"
+  if (achar(i) /= "¸") call abort
+  if (iachar(c) /= iachar("¸")) call abort
+  if (iachar(achar(185)) /= 185) call abort
+  if (iachar ("¹")/= 185) call abort
+  if (achar (185) /= "¹") call abort
+  if ("¹" /= achar ( ichar ( "¹"))) call abort
+  i = 185
+  c = "¹"
+  if (achar(i) /= "¹") call abort
+  if (iachar(c) /= iachar("¹")) call abort
+  if (iachar(achar(186)) /= 186) call abort
+  if (iachar ("º")/= 186) call abort
+  if (achar (186) /= "º") call abort
+  if ("º" /= achar ( ichar ( "º"))) call abort
+  i = 186
+  c = "º"
+  if (achar(i) /= "º") call abort
+  if (iachar(c) /= iachar("º")) call abort
+  if (iachar(achar(187)) /= 187) call abort
+  if (iachar ("»")/= 187) call abort
+  if (achar (187) /= "»") call abort
+  if ("»" /= achar ( ichar ( "»"))) call abort
+  i = 187
+  c = "»"
+  if (achar(i) /= "»") call abort
+  if (iachar(c) /= iachar("»")) call abort
+  if (iachar(achar(188)) /= 188) call abort
+  if (iachar ("¼")/= 188) call abort
+  if (achar (188) /= "¼") call abort
+  if ("¼" /= achar ( ichar ( "¼"))) call abort
+  i = 188
+  c = "¼"
+  if (achar(i) /= "¼") call abort
+  if (iachar(c) /= iachar("¼")) call abort
+  if (iachar(achar(189)) /= 189) call abort
+  if (iachar ("½")/= 189) call abort
+  if (achar (189) /= "½") call abort
+  if ("½" /= achar ( ichar ( "½"))) call abort
+  i = 189
+  c = "½"
+  if (achar(i) /= "½") call abort
+  if (iachar(c) /= iachar("½")) call abort
+  if (iachar(achar(190)) /= 190) call abort
+  if (iachar ("¾")/= 190) call abort
+  if (achar (190) /= "¾") call abort
+  if ("¾" /= achar ( ichar ( "¾"))) call abort
+  i = 190
+  c = "¾"
+  if (achar(i) /= "¾") call abort
+  if (iachar(c) /= iachar("¾")) call abort
+  if (iachar(achar(191)) /= 191) call abort
+  if (iachar ("¿")/= 191) call abort
+  if (achar (191) /= "¿") call abort
+  if ("¿" /= achar ( ichar ( "¿"))) call abort
+  i = 191
+  c = "¿"
+  if (achar(i) /= "¿") call abort
+  if (iachar(c) /= iachar("¿")) call abort
+  if (iachar(achar(192)) /= 192) call abort
+  if (iachar ("À")/= 192) call abort
+  if (achar (192) /= "À") call abort
+  if ("À" /= achar ( ichar ( "À"))) call abort
+  i = 192
+  c = "À"
+  if (achar(i) /= "À") call abort
+  if (iachar(c) /= iachar("À")) call abort
+  if (iachar(achar(193)) /= 193) call abort
+  if (iachar ("Á")/= 193) call abort
+  if (achar (193) /= "Á") call abort
+  if ("Á" /= achar ( ichar ( "Á"))) call abort
+  i = 193
+  c = "Á"
+  if (achar(i) /= "Á") call abort
+  if (iachar(c) /= iachar("Á")) call abort
+  if (iachar(achar(194)) /= 194) call abort
+  if (iachar ("Â")/= 194) call abort
+  if (achar (194) /= "Â") call abort
+  if ("Â" /= achar ( ichar ( "Â"))) call abort
+  i = 194
+  c = "Â"
+  if (achar(i) /= "Â") call abort
+  if (iachar(c) /= iachar("Â")) call abort
+  if (iachar(achar(195)) /= 195) call abort
+  if (iachar ("Ã")/= 195) call abort
+  if (achar (195) /= "Ã") call abort
+  if ("Ã" /= achar ( ichar ( "Ã"))) call abort
+  i = 195
+  c = "Ã"
+  if (achar(i) /= "Ã") call abort
+  if (iachar(c) /= iachar("Ã")) call abort
+  if (iachar(achar(196)) /= 196) call abort
+  if (iachar ("Ä")/= 196) call abort
+  if (achar (196) /= "Ä") call abort
+  if ("Ä" /= achar ( ichar ( "Ä"))) call abort
+  i = 196
+  c = "Ä"
+  if (achar(i) /= "Ä") call abort
+  if (iachar(c) /= iachar("Ä")) call abort
+  if (iachar(achar(197)) /= 197) call abort
+  if (iachar ("Å")/= 197) call abort
+  if (achar (197) /= "Å") call abort
+  if ("Å" /= achar ( ichar ( "Å"))) call abort
+  i = 197
+  c = "Å"
+  if (achar(i) /= "Å") call abort
+  if (iachar(c) /= iachar("Å")) call abort
+  if (iachar(achar(198)) /= 198) call abort
+  if (iachar ("Æ")/= 198) call abort
+  if (achar (198) /= "Æ") call abort
+  if ("Æ" /= achar ( ichar ( "Æ"))) call abort
+  i = 198
+  c = "Æ"
+  if (achar(i) /= "Æ") call abort
+  if (iachar(c) /= iachar("Æ")) call abort
+  if (iachar(achar(199)) /= 199) call abort
+  if (iachar ("Ç")/= 199) call abort
+  if (achar (199) /= "Ç") call abort
+  if ("Ç" /= achar ( ichar ( "Ç"))) call abort
+  i = 199
+  c = "Ç"
+  if (achar(i) /= "Ç") call abort
+  if (iachar(c) /= iachar("Ç")) call abort
+  if (iachar(achar(200)) /= 200) call abort
+  if (iachar ("È")/= 200) call abort
+  if (achar (200) /= "È") call abort
+  if ("È" /= achar ( ichar ( "È"))) call abort
+  i = 200
+  c = "È"
+  if (achar(i) /= "È") call abort
+  if (iachar(c) /= iachar("È")) call abort
+  if (iachar(achar(201)) /= 201) call abort
+  if (iachar ("É")/= 201) call abort
+  if (achar (201) /= "É") call abort
+  if ("É" /= achar ( ichar ( "É"))) call abort
+  i = 201
+  c = "É"
+  if (achar(i) /= "É") call abort
+  if (iachar(c) /= iachar("É")) call abort
+  if (iachar(achar(202)) /= 202) call abort
+  if (iachar ("Ê")/= 202) call abort
+  if (achar (202) /= "Ê") call abort
+  if ("Ê" /= achar ( ichar ( "Ê"))) call abort
+  i = 202
+  c = "Ê"
+  if (achar(i) /= "Ê") call abort
+  if (iachar(c) /= iachar("Ê")) call abort
+  if (iachar(achar(203)) /= 203) call abort
+  if (iachar ("Ë")/= 203) call abort
+  if (achar (203) /= "Ë") call abort
+  if ("Ë" /= achar ( ichar ( "Ë"))) call abort
+  i = 203
+  c = "Ë"
+  if (achar(i) /= "Ë") call abort
+  if (iachar(c) /= iachar("Ë")) call abort
+  if (iachar(achar(204)) /= 204) call abort
+  if (iachar ("Ì")/= 204) call abort
+  if (achar (204) /= "Ì") call abort
+  if ("Ì" /= achar ( ichar ( "Ì"))) call abort
+  i = 204
+  c = "Ì"
+  if (achar(i) /= "Ì") call abort
+  if (iachar(c) /= iachar("Ì")) call abort
+  if (iachar(achar(205)) /= 205) call abort
+  if (iachar ("Í")/= 205) call abort
+  if (achar (205) /= "Í") call abort
+  if ("Í" /= achar ( ichar ( "Í"))) call abort
+  i = 205
+  c = "Í"
+  if (achar(i) /= "Í") call abort
+  if (iachar(c) /= iachar("Í")) call abort
+  if (iachar(achar(206)) /= 206) call abort
+  if (iachar ("Î")/= 206) call abort
+  if (achar (206) /= "Î") call abort
+  if ("Î" /= achar ( ichar ( "Î"))) call abort
+  i = 206
+  c = "Î"
+  if (achar(i) /= "Î") call abort
+  if (iachar(c) /= iachar("Î")) call abort
+  if (iachar(achar(207)) /= 207) call abort
+  if (iachar ("Ï")/= 207) call abort
+  if (achar (207) /= "Ï") call abort
+  if ("Ï" /= achar ( ichar ( "Ï"))) call abort
+  i = 207
+  c = "Ï"
+  if (achar(i) /= "Ï") call abort
+  if (iachar(c) /= iachar("Ï")) call abort
+  if (iachar(achar(208)) /= 208) call abort
+  if (iachar ("Ð")/= 208) call abort
+  if (achar (208) /= "Ð") call abort
+  if ("Ð" /= achar ( ichar ( "Ð"))) call abort
+  i = 208
+  c = "Ð"
+  if (achar(i) /= "Ð") call abort
+  if (iachar(c) /= iachar("Ð")) call abort
+  if (iachar(achar(209)) /= 209) call abort
+  if (iachar ("Ñ")/= 209) call abort
+  if (achar (209) /= "Ñ") call abort
+  if ("Ñ" /= achar ( ichar ( "Ñ"))) call abort
+  i = 209
+  c = "Ñ"
+  if (achar(i) /= "Ñ") call abort
+  if (iachar(c) /= iachar("Ñ")) call abort
+  if (iachar(achar(210)) /= 210) call abort
+  if (iachar ("Ò")/= 210) call abort
+  if (achar (210) /= "Ò") call abort
+  if ("Ò" /= achar ( ichar ( "Ò"))) call abort
+  i = 210
+  c = "Ò"
+  if (achar(i) /= "Ò") call abort
+  if (iachar(c) /= iachar("Ò")) call abort
+  if (iachar(achar(211)) /= 211) call abort
+  if (iachar ("Ó")/= 211) call abort
+  if (achar (211) /= "Ó") call abort
+  if ("Ó" /= achar ( ichar ( "Ó"))) call abort
+  i = 211
+  c = "Ó"
+  if (achar(i) /= "Ó") call abort
+  if (iachar(c) /= iachar("Ó")) call abort
+  if (iachar(achar(212)) /= 212) call abort
+  if (iachar ("Ô")/= 212) call abort
+  if (achar (212) /= "Ô") call abort
+  if ("Ô" /= achar ( ichar ( "Ô"))) call abort
+  i = 212
+  c = "Ô"
+  if (achar(i) /= "Ô") call abort
+  if (iachar(c) /= iachar("Ô")) call abort
+  if (iachar(achar(213)) /= 213) call abort
+  if (iachar ("Õ")/= 213) call abort
+  if (achar (213) /= "Õ") call abort
+  if ("Õ" /= achar ( ichar ( "Õ"))) call abort
+  i = 213
+  c = "Õ"
+  if (achar(i) /= "Õ") call abort
+  if (iachar(c) /= iachar("Õ")) call abort
+  if (iachar(achar(214)) /= 214) call abort
+  if (iachar ("Ö")/= 214) call abort
+  if (achar (214) /= "Ö") call abort
+  if ("Ö" /= achar ( ichar ( "Ö"))) call abort
+  i = 214
+  c = "Ö"
+  if (achar(i) /= "Ö") call abort
+  if (iachar(c) /= iachar("Ö")) call abort
+  if (iachar(achar(215)) /= 215) call abort
+  if (iachar ("×")/= 215) call abort
+  if (achar (215) /= "×") call abort
+  if ("×" /= achar ( ichar ( "×"))) call abort
+  i = 215
+  c = "×"
+  if (achar(i) /= "×") call abort
+  if (iachar(c) /= iachar("×")) call abort
+  if (iachar(achar(216)) /= 216) call abort
+  if (iachar ("Ø")/= 216) call abort
+  if (achar (216) /= "Ø") call abort
+  if ("Ø" /= achar ( ichar ( "Ø"))) call abort
+  i = 216
+  c = "Ø"
+  if (achar(i) /= "Ø") call abort
+  if (iachar(c) /= iachar("Ø")) call abort
+  if (iachar(achar(217)) /= 217) call abort
+  if (iachar ("Ù")/= 217) call abort
+  if (achar (217) /= "Ù") call abort
+  if ("Ù" /= achar ( ichar ( "Ù"))) call abort
+  i = 217
+  c = "Ù"
+  if (achar(i) /= "Ù") call abort
+  if (iachar(c) /= iachar("Ù")) call abort
+  if (iachar(achar(218)) /= 218) call abort
+  if (iachar ("Ú")/= 218) call abort
+  if (achar (218) /= "Ú") call abort
+  if ("Ú" /= achar ( ichar ( "Ú"))) call abort
+  i = 218
+  c = "Ú"
+  if (achar(i) /= "Ú") call abort
+  if (iachar(c) /= iachar("Ú")) call abort
+  if (iachar(achar(219)) /= 219) call abort
+  if (iachar ("Û")/= 219) call abort
+  if (achar (219) /= "Û") call abort
+  if ("Û" /= achar ( ichar ( "Û"))) call abort
+  i = 219
+  c = "Û"
+  if (achar(i) /= "Û") call abort
+  if (iachar(c) /= iachar("Û")) call abort
+  if (iachar(achar(220)) /= 220) call abort
+  if (iachar ("Ü")/= 220) call abort
+  if (achar (220) /= "Ü") call abort
+  if ("Ü" /= achar ( ichar ( "Ü"))) call abort
+  i = 220
+  c = "Ü"
+  if (achar(i) /= "Ü") call abort
+  if (iachar(c) /= iachar("Ü")) call abort
+  if (iachar(achar(221)) /= 221) call abort
+  if (iachar ("Ý")/= 221) call abort
+  if (achar (221) /= "Ý") call abort
+  if ("Ý" /= achar ( ichar ( "Ý"))) call abort
+  i = 221
+  c = "Ý"
+  if (achar(i) /= "Ý") call abort
+  if (iachar(c) /= iachar("Ý")) call abort
+  if (iachar(achar(222)) /= 222) call abort
+  if (iachar ("Þ")/= 222) call abort
+  if (achar (222) /= "Þ") call abort
+  if ("Þ" /= achar ( ichar ( "Þ"))) call abort
+  i = 222
+  c = "Þ"
+  if (achar(i) /= "Þ") call abort
+  if (iachar(c) /= iachar("Þ")) call abort
+  if (iachar(achar(223)) /= 223) call abort
+  if (iachar ("ß")/= 223) call abort
+  if (achar (223) /= "ß") call abort
+  if ("ß" /= achar ( ichar ( "ß"))) call abort
+  i = 223
+  c = "ß"
+  if (achar(i) /= "ß") call abort
+  if (iachar(c) /= iachar("ß")) call abort
+  if (iachar(achar(224)) /= 224) call abort
+  if (iachar ("à")/= 224) call abort
+  if (achar (224) /= "à") call abort
+  if ("à" /= achar ( ichar ( "à"))) call abort
+  i = 224
+  c = "à"
+  if (achar(i) /= "à") call abort
+  if (iachar(c) /= iachar("à")) call abort
+  if (iachar(achar(225)) /= 225) call abort
+  if (iachar ("á")/= 225) call abort
+  if (achar (225) /= "á") call abort
+  if ("á" /= achar ( ichar ( "á"))) call abort
+  i = 225
+  c = "á"
+  if (achar(i) /= "á") call abort
+  if (iachar(c) /= iachar("á")) call abort
+  if (iachar(achar(226)) /= 226) call abort
+  if (iachar ("â")/= 226) call abort
+  if (achar (226) /= "â") call abort
+  if ("â" /= achar ( ichar ( "â"))) call abort
+  i = 226
+  c = "â"
+  if (achar(i) /= "â") call abort
+  if (iachar(c) /= iachar("â")) call abort
+  if (iachar(achar(227)) /= 227) call abort
+  if (iachar ("ã")/= 227) call abort
+  if (achar (227) /= "ã") call abort
+  if ("ã" /= achar ( ichar ( "ã"))) call abort
+  i = 227
+  c = "ã"
+  if (achar(i) /= "ã") call abort
+  if (iachar(c) /= iachar("ã")) call abort
+  if (iachar(achar(228)) /= 228) call abort
+  if (iachar ("ä")/= 228) call abort
+  if (achar (228) /= "ä") call abort
+  if ("ä" /= achar ( ichar ( "ä"))) call abort
+  i = 228
+  c = "ä"
+  if (achar(i) /= "ä") call abort
+  if (iachar(c) /= iachar("ä")) call abort
+  if (iachar(achar(229)) /= 229) call abort
+  if (iachar ("å")/= 229) call abort
+  if (achar (229) /= "å") call abort
+  if ("å" /= achar ( ichar ( "å"))) call abort
+  i = 229
+  c = "å"
+  if (achar(i) /= "å") call abort
+  if (iachar(c) /= iachar("å")) call abort
+  if (iachar(achar(230)) /= 230) call abort
+  if (iachar ("æ")/= 230) call abort
+  if (achar (230) /= "æ") call abort
+  if ("æ" /= achar ( ichar ( "æ"))) call abort
+  i = 230
+  c = "æ"
+  if (achar(i) /= "æ") call abort
+  if (iachar(c) /= iachar("æ")) call abort
+  if (iachar(achar(231)) /= 231) call abort
+  if (iachar ("ç")/= 231) call abort
+  if (achar (231) /= "ç") call abort
+  if ("ç" /= achar ( ichar ( "ç"))) call abort
+  i = 231
+  c = "ç"
+  if (achar(i) /= "ç") call abort
+  if (iachar(c) /= iachar("ç")) call abort
+  if (iachar(achar(232)) /= 232) call abort
+  if (iachar ("è")/= 232) call abort
+  if (achar (232) /= "è") call abort
+  if ("è" /= achar ( ichar ( "è"))) call abort
+  i = 232
+  c = "è"
+  if (achar(i) /= "è") call abort
+  if (iachar(c) /= iachar("è")) call abort
+  if (iachar(achar(233)) /= 233) call abort
+  if (iachar ("é")/= 233) call abort
+  if (achar (233) /= "é") call abort
+  if ("é" /= achar ( ichar ( "é"))) call abort
+  i = 233
+  c = "é"
+  if (achar(i) /= "é") call abort
+  if (iachar(c) /= iachar("é")) call abort
+  if (iachar(achar(234)) /= 234) call abort
+  if (iachar ("ê")/= 234) call abort
+  if (achar (234) /= "ê") call abort
+  if ("ê" /= achar ( ichar ( "ê"))) call abort
+  i = 234
+  c = "ê"
+  if (achar(i) /= "ê") call abort
+  if (iachar(c) /= iachar("ê")) call abort
+  if (iachar(achar(235)) /= 235) call abort
+  if (iachar ("ë")/= 235) call abort
+  if (achar (235) /= "ë") call abort
+  if ("ë" /= achar ( ichar ( "ë"))) call abort
+  i = 235
+  c = "ë"
+  if (achar(i) /= "ë") call abort
+  if (iachar(c) /= iachar("ë")) call abort
+  if (iachar(achar(236)) /= 236) call abort
+  if (iachar ("ì")/= 236) call abort
+  if (achar (236) /= "ì") call abort
+  if ("ì" /= achar ( ichar ( "ì"))) call abort
+  i = 236
+  c = "ì"
+  if (achar(i) /= "ì") call abort
+  if (iachar(c) /= iachar("ì")) call abort
+  if (iachar(achar(237)) /= 237) call abort
+  if (iachar ("í")/= 237) call abort
+  if (achar (237) /= "í") call abort
+  if ("í" /= achar ( ichar ( "í"))) call abort
+  i = 237
+  c = "í"
+  if (achar(i) /= "í") call abort
+  if (iachar(c) /= iachar("í")) call abort
+  if (iachar(achar(238)) /= 238) call abort
+  if (iachar ("î")/= 238) call abort
+  if (achar (238) /= "î") call abort
+  if ("î" /= achar ( ichar ( "î"))) call abort
+  i = 238
+  c = "î"
+  if (achar(i) /= "î") call abort
+  if (iachar(c) /= iachar("î")) call abort
+  if (iachar(achar(239)) /= 239) call abort
+  if (iachar ("ï")/= 239) call abort
+  if (achar (239) /= "ï") call abort
+  if ("ï" /= achar ( ichar ( "ï"))) call abort
+  i = 239
+  c = "ï"
+  if (achar(i) /= "ï") call abort
+  if (iachar(c) /= iachar("ï")) call abort
+  if (iachar(achar(240)) /= 240) call abort
+  if (iachar ("ð")/= 240) call abort
+  if (achar (240) /= "ð") call abort
+  if ("ð" /= achar ( ichar ( "ð"))) call abort
+  i = 240
+  c = "ð"
+  if (achar(i) /= "ð") call abort
+  if (iachar(c) /= iachar("ð")) call abort
+  if (iachar(achar(241)) /= 241) call abort
+  if (iachar ("ñ")/= 241) call abort
+  if (achar (241) /= "ñ") call abort
+  if ("ñ" /= achar ( ichar ( "ñ"))) call abort
+  i = 241
+  c = "ñ"
+  if (achar(i) /= "ñ") call abort
+  if (iachar(c) /= iachar("ñ")) call abort
+  if (iachar(achar(242)) /= 242) call abort
+  if (iachar ("ò")/= 242) call abort
+  if (achar (242) /= "ò") call abort
+  if ("ò" /= achar ( ichar ( "ò"))) call abort
+  i = 242
+  c = "ò"
+  if (achar(i) /= "ò") call abort
+  if (iachar(c) /= iachar("ò")) call abort
+  if (iachar(achar(243)) /= 243) call abort
+  if (iachar ("ó")/= 243) call abort
+  if (achar (243) /= "ó") call abort
+  if ("ó" /= achar ( ichar ( "ó"))) call abort
+  i = 243
+  c = "ó"
+  if (achar(i) /= "ó") call abort
+  if (iachar(c) /= iachar("ó")) call abort
+  if (iachar(achar(244)) /= 244) call abort
+  if (iachar ("ô")/= 244) call abort
+  if (achar (244) /= "ô") call abort
+  if ("ô" /= achar ( ichar ( "ô"))) call abort
+  i = 244
+  c = "ô"
+  if (achar(i) /= "ô") call abort
+  if (iachar(c) /= iachar("ô")) call abort
+  if (iachar(achar(245)) /= 245) call abort
+  if (iachar ("õ")/= 245) call abort
+  if (achar (245) /= "õ") call abort
+  if ("õ" /= achar ( ichar ( "õ"))) call abort
+  i = 245
+  c = "õ"
+  if (achar(i) /= "õ") call abort
+  if (iachar(c) /= iachar("õ")) call abort
+  if (iachar(achar(246)) /= 246) call abort
+  if (iachar ("ö")/= 246) call abort
+  if (achar (246) /= "ö") call abort
+  if ("ö" /= achar ( ichar ( "ö"))) call abort
+  i = 246
+  c = "ö"
+  if (achar(i) /= "ö") call abort
+  if (iachar(c) /= iachar("ö")) call abort
+  if (iachar(achar(247)) /= 247) call abort
+  if (iachar ("÷")/= 247) call abort
+  if (achar (247) /= "÷") call abort
+  if ("÷" /= achar ( ichar ( "÷"))) call abort
+  i = 247
+  c = "÷"
+  if (achar(i) /= "÷") call abort
+  if (iachar(c) /= iachar("÷")) call abort
+  if (iachar(achar(248)) /= 248) call abort
+  if (iachar ("ø")/= 248) call abort
+  if (achar (248) /= "ø") call abort
+  if ("ø" /= achar ( ichar ( "ø"))) call abort
+  i = 248
+  c = "ø"
+  if (achar(i) /= "ø") call abort
+  if (iachar(c) /= iachar("ø")) call abort
+  if (iachar(achar(249)) /= 249) call abort
+  if (iachar ("ù")/= 249) call abort
+  if (achar (249) /= "ù") call abort
+  if ("ù" /= achar ( ichar ( "ù"))) call abort
+  i = 249
+  c = "ù"
+  if (achar(i) /= "ù") call abort
+  if (iachar(c) /= iachar("ù")) call abort
+  if (iachar(achar(250)) /= 250) call abort
+  if (iachar ("ú")/= 250) call abort
+  if (achar (250) /= "ú") call abort
+  if ("ú" /= achar ( ichar ( "ú"))) call abort
+  i = 250
+  c = "ú"
+  if (achar(i) /= "ú") call abort
+  if (iachar(c) /= iachar("ú")) call abort
+  if (iachar(achar(251)) /= 251) call abort
+  if (iachar ("û")/= 251) call abort
+  if (achar (251) /= "û") call abort
+  if ("û" /= achar ( ichar ( "û"))) call abort
+  i = 251
+  c = "û"
+  if (achar(i) /= "û") call abort
+  if (iachar(c) /= iachar("û")) call abort
+  if (iachar(achar(252)) /= 252) call abort
+  if (iachar ("ü")/= 252) call abort
+  if (achar (252) /= "ü") call abort
+  if ("ü" /= achar ( ichar ( "ü"))) call abort
+  i = 252
+  c = "ü"
+  if (achar(i) /= "ü") call abort
+  if (iachar(c) /= iachar("ü")) call abort
+  if (iachar(achar(253)) /= 253) call abort
+  if (iachar ("ý")/= 253) call abort
+  if (achar (253) /= "ý") call abort
+  if ("ý" /= achar ( ichar ( "ý"))) call abort
+  i = 253
+  c = "ý"
+  if (achar(i) /= "ý") call abort
+  if (iachar(c) /= iachar("ý")) call abort
+  if (iachar(achar(254)) /= 254) call abort
+  if (iachar ("þ")/= 254) call abort
+  if (achar (254) /= "þ") call abort
+  if ("þ" /= achar ( ichar ( "þ"))) call abort
+  i = 254
+  c = "þ"
+  if (achar(i) /= "þ") call abort
+  if (iachar(c) /= iachar("þ")) call abort
+  if (iachar(achar(255)) /= 255) call abort
+  if (iachar ("ÿ")/= 255) call abort
+  if (achar (255) /= "ÿ") call abort
+  if ("ÿ" /= achar ( ichar ( "ÿ"))) call abort
+  i = 255
+  c = "ÿ"
+  if (achar(i) /= "ÿ") call abort
+  if (iachar(c) /= iachar("ÿ")) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/achar_3.f90 b/gcc/testsuite/gfortran.dg/achar_3.f90
new file mode 100644
index 000000000..b33bfd11d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/achar_3.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-Wall" }
+program main
+  print *,achar(-3)     ! { dg-error "negative" }
+  print *,achar(200)    ! { dg-warning "outside of range" }
+  print *,char(222+221) ! { dg-error "too large for the collating sequence" }
+  print *,char(-44)     ! { dg-error "negative" }
+  print *,iachar("ü")   ! { dg-warning "outside of range" }
+end program main
diff --git a/gcc/testsuite/gfortran.dg/achar_4.f90 b/gcc/testsuite/gfortran.dg/achar_4.f90
new file mode 100644
index 000000000..eb49db896
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/achar_4.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! Tests the fix for PR31257, in which achar caused an ICE because it had no
+! charlen.
+!
+! The code comes from http://www.star.le.ac.uk/~cgp/fortran.html (by Clive Page)
+! Reported by Thomas Koenig <tkoenig@gcc.gnu.org>
+!
+  if (any (Up ("AbCdEfGhIjKlM") .ne. (/"ABCDEFGHIJKLM"/))) call abort ()
+contains
+  Character (len=20) Function Up (string)
+    Character(len=*) string
+    Up =                                                                &
+     transfer(merge(achar(iachar(transfer(string,"x",len(string)))-     &
+     (ichar('a')-ichar('A')) ),                                         &
+     transfer(string,"x",len(string)) ,                                 &
+     transfer(string,"x",len(string)) >= "a" .and.                      &
+     transfer(string,"x",len(string)) <= "z"), repeat("x", len(string)))
+    return
+  end function Up
+end
diff --git a/gcc/testsuite/gfortran.dg/achar_5.f90 b/gcc/testsuite/gfortran.dg/achar_5.f90
new file mode 100644
index 000000000..c4f78c017
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/achar_5.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+!
+program test
+
+  print *, char(255)
+  print *, achar(255)
+  print *, char(255,kind=1)
+  print *, achar(255,kind=1)
+  print *, char(255,kind=4)
+  print *, achar(255,kind=4)
+
+  print *, char(0)
+  print *, achar(0)
+  print *, char(0,kind=1)
+  print *, achar(0,kind=1)
+  print *, char(0,kind=4)
+  print *, achar(0,kind=4)
+
+  print *, char(297) ! { dg-error "too large for the collating sequence" }
+  print *, achar(297) ! { dg-error "too large for the collating sequence" }
+  print *, char(297,kind=1) ! { dg-error "too large for the collating sequence" }
+  print *, achar(297,kind=1) ! { dg-error "too large for the collating sequence" }
+  print *, char(297,kind=4)
+  print *, achar(297,kind=4)
+
+  print *, char(-1) ! { dg-error "negative" }
+  print *, achar(-1) ! { dg-error "negative" }
+  print *, char(-1,kind=1) ! { dg-error "negative" }
+  print *, achar(-1,kind=1) ! { dg-error "negative" }
+  print *, char(-1,kind=4) ! { dg-error "negative" }
+  print *, achar(-1,kind=4) ! { dg-error "negative" }
+
+  print *, char(huge(0_8)) ! { dg-error "too large for the collating sequence" }
+  print *, achar(huge(0_8)) ! { dg-error "too large for the collating sequence" }
+  print *, char(huge(0_8),kind=1) ! { dg-error "too large for the collating sequence" }
+  print *, achar(huge(0_8),kind=1) ! { dg-error "too large for the collating sequence" }
+  print *, char(huge(0_8),kind=4) ! { dg-error "too large for the collating sequence" }
+  print *, achar(huge(0_8),kind=4) ! { dg-error "too large for the collating sequence" }
+
+  print *, char(z'FFFFFFFF', kind=4)
+  print *, achar(z'FFFFFFFF', kind=4)
+  print *, char(z'100000000', kind=4) ! { dg-error "too large for the collating sequence" }
+  print *, achar(z'100000000', kind=4) ! { dg-error "too large for the collating sequence" }
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/achar_6.F90 b/gcc/testsuite/gfortran.dg/achar_6.F90
new file mode 100644
index 000000000..dd93c2747
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/achar_6.F90
@@ -0,0 +1,70 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+#define TEST(x,y,z) \
+  call test (x, y, z, iachar(x), iachar(y), ichar(x), ichar(y))
+
+  TEST("a", 4_"a", 97)
+  TEST("\0", 4_"\0", 0)
+  TEST("\b", 4_"\b", 8)
+  TEST("\x80", 4_"\x80", int(z'80'))
+  TEST("\xFF", 4_"\xFF", int(z'FF'))
+
+#define TEST2(y,z) \
+  call test_bis (y, z, iachar(y), ichar(y))
+
+  TEST2(4_"\u0100", int(z'0100'))
+  TEST2(4_"\ufe00", int(z'fe00'))
+  TEST2(4_"\u106a", int(z'106a'))
+  TEST2(4_"\uff00", int(z'ff00'))
+  TEST2(4_"\uffff", int(z'ffff'))
+
+contains
+
+subroutine test (s1, s4, i, i1, i2, i3, i4)
+  character(kind=1,len=1) :: s1
+  character(kind=4,len=1) :: s4
+  integer :: i, i1, i2, i3, i4
+
+  if (i /= i1) call abort
+  if (i /= i2) call abort
+  if (i /= i3) call abort
+  if (i /= i4) call abort
+
+  if (iachar (s1) /= i) call abort
+  if (iachar (s4) /= i) call abort
+  
+  if (ichar (s1) /= i) call abort
+  if (ichar (s4) /= i) call abort
+  
+  if (achar(i, kind=1) /= s1) call abort
+  if (achar(i, kind=4) /= s4) call abort
+
+  if (char(i, kind=1) /= s1) call abort
+  if (char(i, kind=4) /= s4) call abort
+
+  if (iachar(achar(i, kind=1)) /= i) call abort
+  if (iachar(achar(i, kind=4)) /= i) call abort
+
+  if (ichar(char(i, kind=1)) /= i) call abort
+  if (ichar(char(i, kind=4)) /= i) call abort
+
+end subroutine test
+
+subroutine test_bis (s4, i, i2, i4)
+  character(kind=4,len=1) :: s4
+  integer :: i, i2, i4
+
+  if (i /= i2) call abort
+  if (i /= i4) call abort
+
+  if (iachar (s4) /= i) call abort
+  if (ichar (s4) /= i) call abort
+  if (achar(i, kind=4) /= s4) call abort
+  if (char(i, kind=4) /= s4) call abort
+  if (iachar(achar(i, kind=4)) /= i) call abort
+  if (ichar(char(i, kind=4)) /= i) call abort
+
+end subroutine test_bis
+
+end
diff --git a/gcc/testsuite/gfortran.dg/actual_array_constructor_1.f90 b/gcc/testsuite/gfortran.dg/actual_array_constructor_1.f90
new file mode 100644
index 000000000..69bfcd05a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/actual_array_constructor_1.f90
@@ -0,0 +1,82 @@
+! { dg-do run }
+! Test the fix by HJ Lu for PR23634 and friends. All involve the ICE
+! that arose from a character array constructor usedas an actual
+! argument.
+!
+! The various parts of this test are taken from the PRs.
+!
+! Test PR26491
+module global
+  public    p, line
+  interface p
+    module procedure p
+  end interface
+  character(128) :: line = 'abcdefghijklmnopqrstuvwxyz'
+contains
+  subroutine p()
+    character(128) :: word
+    word = line
+    call redirect_((/word/))
+  end subroutine
+  subroutine redirect_ (ch)
+    character(*) :: ch(:)
+    if (ch(1) /= line) call abort ()
+  end subroutine redirect_
+end module global
+
+! Test PR26550
+module my_module
+  implicit none
+  type point
+    real :: x
+  end type point
+  type(point), pointer, public :: stdin => NULL()
+contains
+  subroutine my_p(w)
+    character(128) :: w
+    call r(stdin,(/w/))
+  end subroutine my_p
+  subroutine r(ptr, io)
+    use global
+    type(point), pointer :: ptr
+    character(128) :: io(:)
+    if (associated (ptr)) call abort ()
+    if (io(1) .ne. line) call abort ()
+  end subroutine r
+end module my_module
+
+program main
+  use global
+  use my_module
+
+  integer :: i(6) = (/1,6,3,4,5,2/)
+  character (6) :: a = 'hello ', t
+  character(len=1) :: s(6) = (/'g','g','d','d','a','o'/)
+  equivalence (s, t)
+
+  call option_stopwatch_s (a) ! Call test of PR25619
+  call p ()                   ! Call test of PR26491
+  call my_p (line)            ! Call test of PR26550
+
+! Test Vivek Rao's bug, as reported in PR25619.
+  s = s(i)
+  call option_stopwatch_a ((/a,'hola! ', t/))
+
+contains
+
+! Test PR23634
+  subroutine option_stopwatch_s(a)
+    character (*), intent(in) :: a
+    character (len=len(a)) :: b
+
+    b = 'hola! '
+    call option_stopwatch_a((/a, b, 'goddag'/))
+  end subroutine option_stopwatch_s 
+  subroutine option_stopwatch_a (a)
+    character (*) :: a(:)
+    if (any (a .ne. (/'hello ','hola! ','goddag'/))) call abort ()
+  end subroutine option_stopwatch_a
+
+end program main
+! { dg-final { cleanup-modules "global my_module" } }
+
diff --git a/gcc/testsuite/gfortran.dg/actual_array_constructor_2.f90 b/gcc/testsuite/gfortran.dg/actual_array_constructor_2.f90
new file mode 100644
index 000000000..ba05ac698
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/actual_array_constructor_2.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! Tests the fix for pr28167, in which character array constructors

+! with an implied do loop would cause an ICE, when used as actual

+! arguments.
+!
+! Based on the testscase by Harald Anlauf  <anlauf@gmx.de>
+!
+  character(4), dimension(4) :: c1, c2
+  integer m
+  m = 4
+! Test the original problem
+  call foo ((/( 'abcd',i=1,m )/), c2)
+  if (any(c2(:) .ne. (/'abcd','abcd', &
+                            'abcd','abcd'/))) call abort ()
+
+! Now get a bit smarter
+  call foo ((/"abcd", "efgh", "ijkl", "mnop"/), c1) ! worked previously
+  call foo ((/(c1(i), i = m,1,-1)/), c2)            ! was broken
+  if (any(c2(4:1:-1) .ne. c1)) call abort ()
+
+! gfc_todo: Not Implemented: complex character array constructors
+  call foo ((/(c1(i)(i/2+1:i/2+2), i = 1,4)/), c2)  ! Ha! take that..!
+  if (any (c2 .ne. (/"ab  ","fg  ","jk  ","op  "/))) call abort ()
+
+! Check functions in the constructor
+  call foo ((/(achar(64+i)//achar(68+i)//achar(72+i)// &
+               achar(76+i),i=1,4 )/), c1)           ! was broken
+  if (any (c1 .ne. (/"AEIM","BFJN","CGKO","DHLP"/))) call abort ()
+contains
+  subroutine foo (chr1, chr2)
+    character(*), dimension(:) :: chr1, chr2
+    chr2 = chr1
+  end subroutine foo
+end
diff --git a/gcc/testsuite/gfortran.dg/actual_array_constructor_3.f90 b/gcc/testsuite/gfortran.dg/actual_array_constructor_3.f90
new file mode 100644
index 000000000..5b0d28a0d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/actual_array_constructor_3.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! Tests the fix for pr28914, in which array constructors using the loop
+! variable within a do loop for the implied do loop of the constructor
+! would result in a corrupted do loop counter.
+!
+! Based on the testscase by Ed Korkven <kornkven@arsc.edu>
+!
+program pr28914
+  implicit none
+  integer n, i
+  parameter (n = 66000) ! Problem manifests for n > 65535
+  double precision a(n), summation
+
+  summation = 0.0
+  do i = 1, 1
+    a = (/ (i, i = 1, n) /) ! This is legal and was broken
+    a = sqrt(a)
+    summation = SUM(a)
+  enddo
+  summation = abs(summation - 11303932.9138271_8)
+  
+  if (summation.gt.0.00001)   call abort()
+end program pr28914
+
+
diff --git a/gcc/testsuite/gfortran.dg/actual_array_interface_1.f90 b/gcc/testsuite/gfortran.dg/actual_array_interface_1.f90
new file mode 100644
index 000000000..bc020a346
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/actual_array_interface_1.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! Tests the fix for PR29490, in which the creation of the
+! interface expression for the first argument of the call to
+! 'john' would cause an ICE because GFC_TYPE_ARRAY_LBOUND
+! was NULL.
+!
+! Contributed by Philip Mason <pmason@ricardo.com>
+!
+  !---------------------------------
+  program fred
+  !---------------------------------
+  real              :: dezz(1:10)
+  real, allocatable :: jack(:)
+  !
+  allocate(jack(10)); jack = 9.
+  dezz = john(jack,1)
+  print*,'dezz = ',dezz
+
+  contains
+    !---------------------------------
+    function john(t,il)
+    !---------------------------------
+    real  :: t(il:)
+    real  :: john(1:10)
+    john = 10.
+    end function john
+  end
diff --git a/gcc/testsuite/gfortran.dg/actual_array_interface_2.f90 b/gcc/testsuite/gfortran.dg/actual_array_interface_2.f90
new file mode 100644
index 000000000..ae429b7d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/actual_array_interface_2.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+program gprogram
+   implicit none
+   real, dimension(-2:0) :: my_arr
+   call fill_array(my_arr)
+   contains
+      subroutine  fill_array(arr)
+         implicit none
+         real, dimension(-2:0), intent(out) :: arr
+         arr = 42
+      end subroutine fill_array
+end program gprogram
+
diff --git a/gcc/testsuite/gfortran.dg/actual_array_result_1.f90 b/gcc/testsuite/gfortran.dg/actual_array_result_1.f90
new file mode 100644
index 000000000..cf79315cb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/actual_array_result_1.f90
@@ -0,0 +1,71 @@
+! { dg-do run }
+! PR fortan/31692
+! Passing array valued results to procedures
+!
+! Test case contributed by rakuen_himawari@yahoo.co.jp
+module one
+  integer :: flag = 0
+contains
+  function foo1 (n)
+    integer :: n
+    integer :: foo1(n)
+    if (flag == 0) then
+      call bar1 (n, foo1)
+    else
+      call bar2 (n, foo1)
+    end if
+  end function
+
+  function foo2 (n)
+    implicit none
+    integer :: n
+    integer,ALLOCATABLE :: foo2(:)
+    allocate (foo2(n))
+    if (flag == 0) then
+      call bar1 (n, foo2)
+    else
+      call bar2 (n, foo2)
+    end if
+  end function
+
+  function foo3 (n)
+    implicit none
+    integer :: n
+    integer,ALLOCATABLE :: foo3(:)
+    allocate (foo3(n))
+    foo3 = 0
+    call bar2(n, foo3(2:(n-1)))  ! Check that sections are OK
+  end function
+
+  subroutine bar1 (n, array)     ! Checks assumed size formal arg.
+    integer :: n
+    integer :: array(*)
+    integer :: i
+    do i = 1, n
+      array(i) = i
+    enddo
+  end subroutine
+
+  subroutine bar2(n, array)     ! Checks assumed shape formal arg.
+    integer :: n
+    integer :: array(:)
+    integer :: i
+    do i = 1, size (array, 1)
+      array(i) = i
+    enddo
+   end subroutine
+end module
+
+program main
+  use one
+  integer :: n
+  n = 3
+  if(any (foo1(n) /= [ 1,2,3 ])) call abort()
+  if(any (foo2(n) /= [ 1,2,3 ])) call abort()
+  flag = 1
+  if(any (foo1(n) /= [ 1,2,3 ])) call abort()
+  if(any (foo2(n) /= [ 1,2,3 ])) call abort()
+  n = 5
+  if(any (foo3(n) /= [ 0,1,2,3,0 ])) call abort()
+end program
+! { dg-final { cleanup-modules "one" } }
diff --git a/gcc/testsuite/gfortran.dg/actual_array_substr_1.f90 b/gcc/testsuite/gfortran.dg/actual_array_substr_1.f90
new file mode 100644
index 000000000..90108ec35
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/actual_array_substr_1.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! Test fix of PR28118, in which a substring reference to an
+! actual argument with an array reference would cause a segfault.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+program gfcbug33

+  character(12) :: a(2)
+  a(1) = "abcdefghijkl"
+  a(2) = "mnopqrstuvwx"
+  call foo ((a(2:1:-1)(6:)))
+  call bar ((a(:)(7:11)))
+contains
+  subroutine foo (chr)
+    character(7) :: chr(:)
+    if (chr(1)//chr(2) .ne. "rstuvwxfghijkl") call abort ()
+  end subroutine foo

+  subroutine bar (chr)
+    character(*) :: chr(:)
+    if (trim(chr(1))//trim(chr(2)) .ne. "ghijkstuvw") call abort ()
+  end subroutine bar

+end program gfcbug33

diff --git a/gcc/testsuite/gfortran.dg/actual_array_substr_2.f90 b/gcc/testsuite/gfortran.dg/actual_array_substr_2.f90
new file mode 100644
index 000000000..6613751d0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/actual_array_substr_2.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+! Tests the fix for pr28174, in which the fix for pr28118 was
+! corrupting the character lengths of arrays that shared a
+! character length structure.  In addition, in developing the
+! fix, it was noted that intent(out/inout) arguments were not
+! getting written back to the calling scope.
+!
+! Based on the testscase by Harald Anlauf  <anlauf@gmx.de>
+!
+program pr28174
+  implicit none
+  character(len=12) :: teststring(2) = (/ "abc def ghij", &
+                                          "klm nop qrst" /)
+  character(len=12) :: a(2), b(2), c(2), d(2)
+  integer :: m = 7, n
+  a = teststring
+  b = a
+  c = a
+  d = a
+  n = m - 4
+
+! Make sure that variable substring references work.
+  call foo (a(:)(m:m+5), c(:)(n:m+2), d(:)(5:9))
+  if (any (a .ne. teststring)) call abort ()
+  if (any (b .ne. teststring)) call abort ()
+  if (any (c .ne. (/"ab456789#hij", &
+                    "kl7654321rst"/))) call abort ()
+  if (any (d .ne. (/"abc 23456hij", &
+                    "klm 98765rst"/))) call abort ()
+contains
+  subroutine foo (w, x, y)
+    character(len=*), intent(in) :: w(:)
+    character(len=*), intent(inOUT) :: x(:)
+    character(len=*), intent(OUT) :: y(:)
+    character(len=12) :: foostring(2) = (/"0123456789#$" , &
+                                          "$#9876543210"/)
+! This next is not required by the standard but tests the
+! functioning of the gfortran implementation.
+!   if (all (x(:)(3:7) .eq. y)) call abort ()
+    x = foostring (:)(5 : 4 + len (x))
+    y = foostring (:)(3 : 2 + len (y))
+  end subroutine foo
+end program pr28174
+
diff --git a/gcc/testsuite/gfortran.dg/actual_array_vect_1.f90 b/gcc/testsuite/gfortran.dg/actual_array_vect_1.f90
new file mode 100644
index 000000000..8b4d6f495
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/actual_array_vect_1.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! PR fortran/32323
+! Array sections with vector subscripts are not allowed
+! with dummy arguments which have VOLATILE or INTENT OUT/INOUT
+!
+! Contributed by terry@chem.gu.se
+!
+module mod
+implicit none
+contains
+subroutine aa(v)
+integer,dimension(:),volatile::v
+write(*,*)size(v)
+v=0
+end subroutine aa
+subroutine bb(v)
+integer,dimension(:),intent(out)::v
+write(*,*)size(v)
+v=0
+end subroutine bb
+end module mod
+
+program ff
+use mod
+implicit none
+integer,dimension(10)::w
+w=1
+call aa(w(2:4))
+call aa(w((/3,2,1/))) ! { dg-error "vector subscript" }
+call bb(w(2:4))
+call bb(w((/3,2,1/))) ! { dg-error "vector subscript" }
+write(*,*)w
+end
diff --git a/gcc/testsuite/gfortran.dg/actual_pointer_function_1.f90 b/gcc/testsuite/gfortran.dg/actual_pointer_function_1.f90
new file mode 100644
index 000000000..8fa882d93
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/actual_pointer_function_1.f90
@@ -0,0 +1,33 @@
+! { dg-do run }

+! Tests the fix for PR31211, in which the value of the result for

+! cp_get_default_logger was stored as a temporary, rather than the

+! pointer itself.  This caused a segfault when the result was

+! nullified.

+!

+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>

+!

+  TYPE cp_logger_type

+    INTEGER :: a

+  END TYPE cp_logger_type

+

+  if (cp_logger_log(cp_get_default_logger (0))) call abort ()

+  if (.not. cp_logger_log(cp_get_default_logger (42))) call abort ()

+

+CONTAINS

+

+  logical function cp_logger_log(logger)

+    TYPE(cp_logger_type), POINTER ::logger

+    cp_logger_log = associated (logger) .and. (logger%a .eq. 42)

+  END function

+

+  FUNCTION cp_get_default_logger(v) RESULT(res)

+    TYPE(cp_logger_type), POINTER ::res

+    integer :: v

+    if (v .eq. 0) then

+      NULLIFY(RES)

+    else

+      allocate(RES)

+      res%a = v

+    end if

+  END FUNCTION cp_get_default_logger

+END

diff --git a/gcc/testsuite/gfortran.dg/actual_procedure_1.f90 b/gcc/testsuite/gfortran.dg/actual_procedure_1.f90
new file mode 100644
index 000000000..5327cb73d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/actual_procedure_1.f90
@@ -0,0 +1,72 @@
+! { dg-do run }
+! Tests the fix for PR36433 in which a check for the array size
+! or character length of the actual arguments of foo and bar
+! would reject this legal code.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+module m
+contains
+  function proc4 (arg, chr)
+    integer, dimension(10) :: proc4
+    integer, intent(in) :: arg
+    character(8), intent(inout) :: chr
+    proc4 = arg
+    chr = "proc4"
+  end function
+  function chr_proc ()
+    character(8) :: chr_proc
+    chr_proc = "chr_proc"
+  end function
+end module
+
+program procPtrTest
+  use m
+  character(8) :: chr
+  interface
+    function proc_ext (arg, chr)
+      integer, dimension(10) :: proc_ext
+      integer, intent(in) :: arg
+      character(8), intent(inout) :: chr
+    end function
+  end interface
+! Check the passing of a module function
+  call foo (proc4, chr)
+  if (trim (chr) .ne. "proc4") call abort
+! Check the passing of an external function
+  call foo (proc_ext, chr)
+! Check the passing of a character function
+  if (trim (chr) .ne. "proc_ext") call abort
+  call bar (chr_proc)
+contains
+  subroutine foo (p, chr)
+    character(8), intent(inout) :: chr
+    integer :: i(10)
+    interface
+      function p (arg, chr)
+        integer, dimension(10) :: p
+        integer, intent(in) :: arg
+        character(8), intent(inout) :: chr
+      end function
+    end interface
+    i = p (99, chr)
+    if (any(i .ne. 99)) call abort
+  end subroutine
+  subroutine bar (p)
+    interface
+      function p ()
+        character(8):: p
+      end function
+    end interface
+    if (p () .ne. "chr_proc") call abort
+  end subroutine
+end program 
+
+function proc_ext (arg, chr)
+  integer, dimension(10) :: proc_ext
+  integer, intent(in) :: arg
+  character(8), intent(inout) :: chr
+  proc_ext = arg
+  chr = "proc_ext"
+end function
+! { dg-final { cleanup-modules "m" } }
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/actual_rank_check_1.f90 b/gcc/testsuite/gfortran.dg/actual_rank_check_1.f90
new file mode 100644
index 000000000..7167de427
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/actual_rank_check_1.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! Test the fix for PR40158, where the errro message was not clear about scalars.
+!
+! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+  implicit none
+  integer :: i(4,5),j
+  i = 0
+  call sub1(i)
+  call sub1(j)  ! { dg-error "rank-1 and scalar" }
+  call sub2(i)  ! { dg-error "scalar and rank-2" }
+  call sub2(j)
+  print '(5i0)', i
+contains
+  subroutine sub1(i1)
+    integer :: i1(*)
+    i1(1) = 2
+  end subroutine sub1
+  subroutine sub2(i2)
+    integer :: i2
+    i2 = 2
+  end subroutine sub2
+end
diff --git a/gcc/testsuite/gfortran.dg/advance_1.f90 b/gcc/testsuite/gfortran.dg/advance_1.f90
new file mode 100644
index 000000000..9002c52b5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/advance_1.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! PR25463 Check that advance='no' works correctly.
+! Derived from example given in PR by Thomas Koenig
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org> 
+program pr25463
+  character(10) :: str
+  write (10,'(A)',advance="no") 'ab'
+  write (10,'(TL2,A)') 'c'
+  rewind (10)
+  read (10, '(a)') str
+  if (str.ne.'abc') call abort()
+  close (10, status='delete')
+end
diff --git a/gcc/testsuite/gfortran.dg/advance_2.f90 b/gcc/testsuite/gfortran.dg/advance_2.f90
new file mode 100644
index 000000000..1e83aaee3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/advance_2.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+subroutine foo
+  character(len=5) :: a
+  a = "yes"
+  write(*, '(a)', advance=a) "hello world"
+end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/advance_3.f90 b/gcc/testsuite/gfortran.dg/advance_3.f90
new file mode 100644
index 000000000..7a361d27b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/advance_3.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+subroutine foo
+  real :: a
+  a = 1
+  write(*, '(a)', advance=a) "hello world" ! { dg-error "must be of type CHARACTER" }
+end subroutine foo
+subroutine bar
+  write(*, '(a)', advance=5.) "hello world" ! { dg-error "must be of type CHARACTER" }
+end subroutine bar
diff --git a/gcc/testsuite/gfortran.dg/advance_4.f90 b/gcc/testsuite/gfortran.dg/advance_4.f90
new file mode 100644
index 000000000..3676558fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/advance_4.f90
@@ -0,0 +1,10 @@
+! { dg-do run }
+! PR31207 Last record truncated for read after short write
+program main
+  character(10) :: answer
+  write (12,'(A,T2,A)',advance="no") 'XXXXXX','ABCD'
+  close (12)
+  read (12, '(6A)') answer
+  close (12, status="delete")
+  if (answer /= "XABCDX") call abort()
+end program main
diff --git a/gcc/testsuite/gfortran.dg/advance_5.f90 b/gcc/testsuite/gfortran.dg/advance_5.f90
new file mode 100644
index 000000000..3a48e5366
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/advance_5.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! PR31207 Last record truncated for read after short write.
+character(len=20) :: b
+! write something no advance
+open(10,file="fort.10",position="rewind")
+write(10, '(a,t1,a)',advance='no') 'xxxxxx', 'abc'
+close(10)
+! append some data
+open(10,file="fort.10",position="append")
+write(10, '(a)') 'def'
+close(10)
+! check what is in the first record
+open(10,file="fort.10",position="rewind")
+read(10,'(a)') b
+close(10, status="delete")
+if (b.ne."abcxxx") call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/advance_6.f90 b/gcc/testsuite/gfortran.dg/advance_6.f90
new file mode 100644
index 000000000..1a42cca92
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/advance_6.f90
@@ -0,0 +1,76 @@
+! { dg-do run { target fd_truncate } }
+! PR 34370 - file positioning after non-advancing I/O didn't add
+! a record marker.
+
+program main
+  implicit none
+  character(len=3) :: c
+  character(len=80), parameter :: fname = "advance_backspace_1.dat"
+
+  call write_file
+  close (95)
+  call check_end_record
+
+  call write_file
+  backspace 95
+  c = 'xxx'
+  read (95,'(A)') c
+  if (c /= 'ab ') call abort
+  close (95)
+  call check_end_record
+  
+  call write_file
+  backspace 95
+  close (95)
+  call check_end_record
+
+  call write_file
+  endfile 95
+  close (95)
+  call check_end_record
+
+  call write_file
+  endfile 95
+  rewind 95
+  c = 'xxx'
+  read (95,'(A)') c
+  if (c /= 'ab ') call abort
+  close (95)
+  call check_end_record
+
+  call write_file
+  rewind 95
+  c = 'xxx'
+  read (95,'(A)') c
+  if (c /= 'ab ') call abort
+  close (95)
+  call check_end_record
+
+contains
+
+  subroutine write_file
+    open(95, file=fname, status="replace", form="formatted")
+    write (95, '(A)', advance="no") 'a'
+    write (95, '(A)', advance="no") 'b'
+  end subroutine write_file
+
+! Checks for correct end record, then deletes the file.
+
+  subroutine check_end_record
+    character(len=1) :: x
+    open(2003, file=fname, status="old", access="stream", form="unformatted")
+    read(2003) x
+    if (x /= 'a') call abort
+    read(2003) x
+    if (x /= 'b') call abort
+    read(2003) x
+    if (x /= achar(10)) then
+       read(2003) x
+       if (x /= achar(13)) then
+       else
+          call abort
+       end if
+    end if
+    close(2003,status="delete")
+  end subroutine check_end_record
+end program main
diff --git a/gcc/testsuite/gfortran.dg/aint_anint_1.f90 b/gcc/testsuite/gfortran.dg/aint_anint_1.f90
new file mode 100644
index 000000000..179748c11
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/aint_anint_1.f90
@@ -0,0 +1,26 @@
+program aint_anint_1
+    
+  implicit none
+
+  real(4) :: r = 42.7, r1, r2
+  real(8) :: s = 42.7D0, s1, s2
+
+  r1 = aint(r)
+  r2 = aint(r,kind=8)
+  if (abs(r1 - r2) > 0.1) call abort()
+
+  r1 = anint(r)
+  r2 = anint(r,kind=8)
+  if (abs(r1 - r2) > 0.1) call abort()
+
+  s1 = aint(s)
+  s2 = aint(s, kind=4)
+  if (abs(s1 - s2) > 0.1) call abort()
+
+  s1 = anint(s)
+  s2 = anint(s, kind=4)
+  if (abs(s1 - s2) > 0.1) call abort()
+
+
+end program aint_anint_1
+
diff --git a/gcc/testsuite/gfortran.dg/aliasing_array_result_1.f90 b/gcc/testsuite/gfortran.dg/aliasing_array_result_1.f90
new file mode 100644
index 000000000..d8899d2ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/aliasing_array_result_1.f90
@@ -0,0 +1,164 @@
+! { dg-do run }
+! Tests the fic for PR44582, where gfortran was found to
+! produce an incorrect result when the result of a function
+! was aliased by a host or use associated variable, to which
+! the function is assigned. In these cases a temporary is
+! required in the function assignments. The check has to be
+! rather restrictive.  Whilst the cases marked below might
+! not need temporaries, the TODOs are going to be tough.
+!
+! Reported by Yin Ma <yin@absoft.com> and
+! elaborated by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module foo
+  INTEGER, PARAMETER :: ONE = 1
+  INTEGER, PARAMETER :: TEN = 10
+  INTEGER, PARAMETER :: FIVE = TEN/2
+  INTEGER, PARAMETER :: TWO = 2
+  integer :: foo_a(ONE)
+  integer :: check(ONE) = TEN
+  LOGICAL :: abort_flag = .false. 
+contains
+  function foo_f()
+     integer :: foo_f(ONE)
+     foo_f = -FIVE
+     foo_f = foo_a - foo_f
+  end function foo_f
+  subroutine bar
+    foo_a = FIVE
+! This aliases 'foo_a' by host association.
+    foo_a = foo_f ()
+    if (any (foo_a .ne. check)) call myabort (0)
+  end subroutine bar
+  subroutine myabort(fl)
+    integer :: fl
+    print *, fl
+    abort_flag = .true.
+  end subroutine myabort
+end module foo
+
+function h_ext()
+  use foo
+  integer :: h_ext(ONE)
+  h_ext = -FIVE
+  h_ext = FIVE - h_ext
+end function h_ext
+
+function i_ext() result (h)
+  use foo
+  integer :: h(ONE)
+  h = -FIVE
+  h = FIVE - h
+end function i_ext
+
+subroutine tobias
+  use foo
+  integer :: a(ONE)
+  a = FIVE
+  call sub1(a)
+  if (any (a .ne. check)) call myabort (1)
+contains
+  subroutine sub1(x)
+    integer :: x(ONE)
+! 'x' is aliased by host association in 'f'.
+    x = f()
+  end subroutine sub1
+  function f()
+    integer :: f(ONE)
+    f = ONE
+    f = a + FIVE
+  end function f
+end subroutine tobias
+
+program test
+  use foo
+  implicit none
+  common /foo_bar/ c
+  integer :: a(ONE), b(ONE), c(ONE), d(ONE)
+  interface
+    function h_ext()
+      use foo
+      integer :: h_ext(ONE)
+    end function h_ext
+  end interface
+  interface
+    function i_ext() result (h)
+      use foo
+      integer :: h(ONE)
+    end function i_ext
+  end interface
+
+  a = FIVE
+! This aliases 'a' by host association
+  a = f()
+  if (any (a .ne. check)) call myabort (2)
+  a = FIVE
+  if (any (f() .ne. check)) call myabort (3)
+  call bar
+  foo_a = FIVE
+! This aliases 'foo_a' by host association.
+  foo_a = g ()
+  if (any (foo_a .ne. check)) call myabort (4)
+  a = FIVE
+  a = h()           ! TODO: Needs no temporary
+  if (any (a .ne. check)) call myabort (5)
+  a = FIVE
+  a = i()           ! TODO: Needs no temporary
+  if (any (a .ne. check)) call myabort (6)
+  a = FIVE
+  a = h_ext()       ! Needs no temporary - was OK
+  if (any (a .ne. check)) call myabort (15)
+  a = FIVE
+  a = i_ext()       ! Needs no temporary - was OK
+  if (any (a .ne. check)) call myabort (16)
+  c = FIVE
+! This aliases 'c' through the common block.
+  c = j()
+  if (any (c .ne. check)) call myabort (7)
+  call aaa
+  call tobias
+  if (abort_flag) call abort
+contains
+  function f()
+     integer :: f(ONE)
+     f = -FIVE
+     f = a - f
+  end function f
+  function g()
+     integer :: g(ONE)
+     g = -FIVE
+     g = foo_a - g
+  end function g
+  function h()
+     integer :: h(ONE)
+     h = -FIVE
+     h = FIVE - h
+  end function h
+  function i() result (h)
+     integer :: h(ONE)
+     h = -FIVE
+     h = FIVE - h
+  end function i
+  function j()
+     common /foo_bar/ cc
+     integer :: j(ONE), cc(ONE)
+     j = -FIVE
+     j = cc - j
+  end function j
+  subroutine aaa()
+    d = TEN - TWO
+! This aliases 'd' through 'get_d'.
+    d = bbb()
+    if (any (d .ne. check)) call myabort (8)
+  end subroutine aaa
+  function bbb()
+    integer :: bbb(ONE)
+    bbb = TWO
+    bbb = bbb + get_d()
+  end function bbb
+  function get_d()
+    integer :: get_d(ONE)
+    get_d = d
+  end function get_d
+end program test
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/aliasing_dummy_1.f90 b/gcc/testsuite/gfortran.dg/aliasing_dummy_1.f90
new file mode 100644
index 000000000..686853a1c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/aliasing_dummy_1.f90
@@ -0,0 +1,67 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! This tests the fix for PR24276, which originated from the Loren P. Meissner example,
+! Array_List.  The PR concerns dummy argument aliassing of components of arrays of derived
+! types as arrays of the type of the component.  gfortran would compile and run this
+! example but the stride used did not match the actual argument.  This test case exercises
+! a procedure call (to foo2, below) that is identical to Array_List's.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+
+program test_lex
+  type :: dtype
+    integer :: n
+    character*5 :: word
+  end type dtype
+
+  type :: list
+    type(dtype), dimension(4) :: list
+    integer :: l = 4
+  end type list
+ 
+  type(list) :: table
+  type(dtype) :: elist(2,2)
+
+  table%list = (/dtype (1 , "one  "), dtype (2 , "two  "), dtype (3 , "three"), dtype (4 , "four ")/)
+
+! Test 1D with assumed shape (original bug) and assumed size.
+  call bar (table, 2, 4)
+  if (any (table%list%word.ne.(/"one  ","i=  2","three","i=  4"/))) call abort ()
+
+  elist = reshape (table%list, (/2,2/))
+
+! Check 2D is OK with assumed shape and assumed size.
+  call foo3 (elist%word, 1)
+  call foo1 (elist%word, 3)
+  if (any (elist%word.ne.reshape ((/"i=  1","i=  2","i=  3","i=  4"/), (/2,2/)))) call abort ()
+
+contains
+
+  subroutine bar (table, n, m)
+    type(list) :: table
+    integer n, m
+    call foo1 (table%list(:table%l)%word, n)
+    call foo2 (table%list(:table%l)%word, m)
+  end subroutine bar
+
+  subroutine foo1 (slist, i)
+    character(*), dimension(*) :: slist
+    integer i
+    write (slist(i), '(2hi=,i3)') i
+  end subroutine foo1
+
+  subroutine foo2 (slist, i)
+    character(5), dimension(:) :: slist
+    integer i
+    write (slist(i), '(2hi=,i3)') i
+  end subroutine foo2
+
+  subroutine foo3 (slist, i)
+    character(5), dimension(:,:) :: slist
+    integer i
+    write (slist(1,1), '(2hi=,i3)') i
+  end subroutine foo3
+
+end program test_lex
+
diff --git a/gcc/testsuite/gfortran.dg/aliasing_dummy_2.f90 b/gcc/testsuite/gfortran.dg/aliasing_dummy_2.f90
new file mode 100644
index 000000000..3a3856f68
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/aliasing_dummy_2.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! This tests the fix for PR28885, in which multiple calls to a procedure
+! with different components of an array of derived types for an INTENT(OUT)
+! argument caused an ICE internal compiler error.  This came about because
+! the compiler would lose the temporary declaration with each subsequent
+! call of the procedure.
+!
+! Reduced from the contribution by Drew McCormack  <drewmccormack@mac.com>
+!
+program test
+  type t
+    integer :: i
+    integer :: j
+  end type
+  type (t) :: a(5) 
+  call sub('one',a%j)
+  call sub('two',a%i)
+contains
+  subroutine sub(key,a)
+    integer, intent(out)    :: a(:) 
+    character(*),intent(in) :: key
+    a = 1   
+  end subroutine
+end program 
diff --git a/gcc/testsuite/gfortran.dg/aliasing_dummy_3.f90 b/gcc/testsuite/gfortran.dg/aliasing_dummy_3.f90
new file mode 100644
index 000000000..f09028062
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/aliasing_dummy_3.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! This tests the fix for PR29565, which failed in the gimplifier
+! with the third call to has_read_key because this lost the first
+! temporary array declaration from the current context.
+!
+! Contributed by William Mitchell  <william.mitchell@nist.gov>
+!
+  type element_t
+    integer :: gid
+  end type element_t
+
+  type(element_t) :: element(1)
+   call hash_read_key(element%gid)
+   call hash_read_key(element%gid)
+   call hash_read_key(element%gid)
+contains
+  subroutine hash_read_key(key)
+    integer, intent(out) :: key(1)
+  end subroutine hash_read_key
+end
diff --git a/gcc/testsuite/gfortran.dg/aliasing_dummy_4.f90 b/gcc/testsuite/gfortran.dg/aliasing_dummy_4.f90
new file mode 100644
index 000000000..826ada162
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/aliasing_dummy_4.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+! This tests the fix for PR29315, in which array components of derived type arrays were
+! not correctly passed to procedures because of a fault in the function that detects
+! these references that do not have the span of a natural type.
+!
+! Contributed by Stephen Jeffrey  <stephen.jeffrey@nrm.qld.gov.au>
+!
+program  test_f90
+
+    integer, parameter :: N = 2
+
+    type test_type
+        integer a(N, N)
+    end type
+
+    type (test_type) s(N, N)
+
+    forall (l = 1:N, m = 1:N) &
+        s(l, m)%a(:, :) = reshape ([((i*l + 10*j*m +100, i = 1, N), j = 1, N)], [N, N])
+
+    call test_sub(s%a(1, 1), 1000) ! Test the original problem.
+
+    if ( any (s(1, 1)%a(:, :) /= reshape ([1111, 112, 121, 122], [2, 2]))) call abort ()
+    if ( any (s(1, 2)%a(:, :) /= reshape ([1121, 122, 141, 142], [2, 2]))) call abort ()
+    if ( any (s(2, 1)%a(:, :) /= reshape ([1112, 114, 122, 124], [2, 2]))) call abort ()
+    if ( any (s(2, 2)%a(:, :) /= reshape ([1122, 124, 142, 144], [2, 2]))) call abort ()
+
+    call test_sub(s(1, 1)%a(:, :), 1000)  ! Check "normal" references.
+
+    if ( any (s(1, 1)%a(:, :) /= reshape ([2111,1112,1121,1122], [2, 2]))) call abort ()
+    if ( any (s(1, 2)%a(:, :) /= reshape ([1121, 122, 141, 142], [2, 2]))) call abort ()
+    if ( any (s(2, 1)%a(:, :) /= reshape ([1112, 114, 122, 124], [2, 2]))) call abort ()
+    if ( any (s(2, 2)%a(:, :) /= reshape ([1122, 124, 142, 144], [2, 2]))) call abort ()
+contains
+  subroutine test_sub(array, offset)
+    integer array(:, :), offset
+
+    forall (i = 1:N, j = 1:N) &
+        array(i, j) = array(i, j) + offset
+  end subroutine
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/aliasing_dummy_5.f90 b/gcc/testsuite/gfortran.dg/aliasing_dummy_5.f90
new file mode 100644
index 000000000..379fbd7f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/aliasing_dummy_5.f90
@@ -0,0 +1,55 @@
+! { dg-do run }
+! 
+! PR fortran/45019
+!
+! Check that the compiler knows that
+! "arg" and "arr" can alias.
+!
+MODULE m
+  IMPLICIT NONE
+  INTEGER, TARGET :: arr(3)
+CONTAINS
+  SUBROUTINE foobar (arg)
+    INTEGER, TARGET :: arg(:)
+    arr(2:3) = arg(1:2)
+  END SUBROUTINE foobar
+END MODULE m
+
+PROGRAM main
+  USE m
+  IMPLICIT NONE
+  arr = (/ 1, 2, 3 /)
+  CALL bar(arr)
+  if (any (arr /= (/ 1, 1, 2 /))) call abort()
+  CALL test()
+contains
+  subroutine bar(x)
+    INTEGER, TARGET :: x(:)
+    CALL foobar (x)
+  end subroutine bar
+END PROGRAM main
+
+MODULE m2
+  IMPLICIT NONE
+  INTEGER, TARGET :: arr(3)
+CONTAINS
+   SUBROUTINE foobar (arg)
+    INTEGER, TARGET :: arg(:)
+    arr(1) = 5
+    arg(1) = 6
+    if (arr(1) == 5) call abort()
+  END SUBROUTINE foobar
+END MODULE m2
+subroutine test
+  USE m2
+  IMPLICIT NONE
+  arr = (/ 1, 2, 3 /)
+  CALL bar(arr)
+contains
+   subroutine bar(x)
+    INTEGER, TARGET :: x(:)
+    CALL foobar (x)
+  end subroutine bar
+END subroutine test
+
+! { dg-final { cleanup-modules "m m2" } }
diff --git a/gcc/testsuite/gfortran.dg/all_bounds_1.f90 b/gcc/testsuite/gfortran.dg/all_bounds_1.f90
new file mode 100644
index 000000000..d8cb07bf0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/all_bounds_1.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect extent in return value of ALL intrinsic" }
+program main
+  logical(kind=4), allocatable :: f(:,:)
+  logical(kind=4) :: res(3)
+  character(len=80) line
+  allocate (f(2,2))
+  f = .false.
+  f(1,1) = .true.
+  f(2,1) = .true.
+  res = all(f,dim=1)
+  write(line,fmt='(80L1)') res
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return value of ALL intrinsic in dimension 1: is 3, should be 2" }
+
+
diff --git a/gcc/testsuite/gfortran.dg/alloc_alloc_expr_1.f90 b/gcc/testsuite/gfortran.dg/alloc_alloc_expr_1.f90
new file mode 100644
index 000000000..516ccd46a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_alloc_expr_1.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+program fc011
+! Tests fix for PR20779 and PR20891.
+! Submitted by Walt Brainerd, The Fortran Company
+! and by Joost VandeVondele  <jv244@cam.ac.uk> 
+
+! This program violates requirements of 6.3.1 of the F95 standard.
+
+! An allocate-object, or a subobject of an allocate-object, shall not appear
+! in a bound in the same ALLOCATE statement. The stat-variable shall not appear
+! in a bound in the same ALLOCATE statement.
+
+! The stat-variable shall not be allocated within the ALLOCATE statement in which
+! it appears; nor shall it depend on the value, bounds, allocation status, or
+! association status of any allocate-object or subobject of an allocate-object
+! allocated in the same statement.
+
+  integer, pointer :: PTR
+  integer, allocatable :: ALLOCS(:)
+
+  allocate (PTR, stat=PTR) ! { dg-error "in the same ALLOCATE statement" }
+
+  allocate (ALLOCS(10),stat=ALLOCS(1)) ! { dg-error "in the same ALLOCATE statement" }
+
+  ALLOCATE(PTR,ALLOCS(PTR)) ! { dg-error "same ALLOCATE statement" }
+
+  deallocate(ALLOCS(1)) ! { dg-error "must be ALLOCATABLE or a POINTER" }
+
+  print *, 'This program has four errors', PTR, ALLOC(1)
+
+end program fc011
diff --git a/gcc/testsuite/gfortran.dg/alloc_alloc_expr_2.f90 b/gcc/testsuite/gfortran.dg/alloc_alloc_expr_2.f90
new file mode 100644
index 000000000..16235e390
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_alloc_expr_2.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! This tests the fix for PR29343, in which the valid ALLOCATE statement
+! below triggered an error following the patch for PR20779 and PR20891.
+!
+! Contributed by Grigory Zagorodnev <grigory_zagorodnev@linux.intel.com>
+!
+        Subroutine ReadParameters (Album)
+        Implicit NONE
+
+
+        Type GalleryP
+                Integer       :: NoOfEntries
+                Character(80), Pointer :: FileName (:)
+        End Type GalleryP
+
+
+        Type(GalleryP), Intent(Out) :: Album
+        Allocate (Album%FileName   (Album%NoOfEntries))
+        end
diff --git a/gcc/testsuite/gfortran.dg/alloc_alloc_expr_3.f90 b/gcc/testsuite/gfortran.dg/alloc_alloc_expr_3.f90
new file mode 100644
index 000000000..13b2230c0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_alloc_expr_3.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+! PR fortran/34714 - ICE on invalid
+! Testcase contributed by Martin Reinecke <martin AT mpa-garching DOT mpg DOT de>
+!
+
+module foo
+  type bar
+    logical, pointer, dimension(:) :: baz
+  end type
+contains
+
+function func1()
+  type(bar) func1
+  allocate(func1%baz(1))
+end function
+
+function func2()
+  type(bar) func2
+  allocate(func1%baz(1))      ! { dg-error "is not a variable" }
+end function
+
+end module foo
+
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_1.f90
new file mode 100644
index 000000000..9d87af2f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_1.f90
@@ -0,0 +1,57 @@
+! { dg-do run }
+! Test assignments of derived type with allocatable components (PR 20541).
+!
+! Contributed by Erik Edelmann  <eedelmann@gcc.gnu.org>
+!            and Paul Thomas  <pault@gcc.gnu.org>
+!
+  type :: ivs
+    character(1), allocatable :: chars(:)
+  end type ivs
+
+  type(ivs) :: a, b
+  type(ivs) :: x(3), y(3)
+  
+  allocate(a%chars(5))
+  a%chars = (/"h","e","l","l","o"/)
+
+! An intrinsic assignment must deallocate the l-value and copy across
+! the array from the r-value.
+  b = a
+  if (any (b%chars .ne. (/"h","e","l","l","o"/))) call abort ()
+  if (allocated (a%chars) .eqv. .false.) call abort ()
+
+! Scalar to array needs to copy the derived type, to its ultimate components,
+! to each of the l-value elements.  */
+  x = b
+  x(2)%chars = (/"g","'","d","a","y"/)
+  if (any (x(1)%chars .ne. (/"h","e","l","l","o"/))) call abort ()
+  if (any (x(2)%chars .ne. (/"g","'","d","a","y"/))) call abort ()
+  if (allocated (b%chars) .eqv. .false.) call abort ()
+  deallocate (x(1)%chars, x(2)%chars, x(3)%chars)
+
+! Array intrinsic assignments are like their scalar counterpart and
+! must deallocate each element of the l-value and copy across the
+! arrays from the r-value elements.
+  allocate(x(1)%chars(5), x(2)%chars(5), x(3)%chars(5))
+  x(1)%chars = (/"h","e","l","l","o"/)
+  x(2)%chars = (/"g","'","d","a","y"/)
+  x(3)%chars = (/"g","o","d","a","g"/)
+  y(2:1:-1) = x(1:2)
+  if (any (y(1)%chars .ne. (/"g","'","d","a","y"/))) call abort ()
+  if (any (y(2)%chars .ne. (/"h","e","l","l","o"/))) call abort ()
+  if (any (x(3)%chars .ne. (/"g","o","d","a","g"/))) call abort ()
+
+! In the case of an assignment where there is a dependency, so that a
+! temporary is necessary, each element must be copied to its
+! destination after it has been deallocated.
+  y(2:3) = y(1:2)
+  if (any (y(1)%chars .ne. (/"g","'","d","a","y"/))) call abort ()
+  if (any (y(2)%chars .ne. (/"g","'","d","a","y"/))) call abort ()
+  if (any (y(3)%chars .ne. (/"h","e","l","l","o"/))) call abort ()
+
+! An identity assignment must not do any deallocation....!
+  y = y
+  if (any (y(1)%chars .ne. (/"g","'","d","a","y"/))) call abort ()
+  if (any (y(2)%chars .ne. (/"g","'","d","a","y"/))) call abort ()
+  if (any (y(3)%chars .ne. (/"h","e","l","l","o"/))) call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_10.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_10.f90
new file mode 100644
index 000000000..c85edea62
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_10.f90
@@ -0,0 +1,61 @@
+! { dg-do run }
+!
+! Test the fix for PR39879, in which gfc gagged on the double
+! defined assignment where the rhs had a default initialiser.
+!
+! Contributed by David Sagan <david.sagan@gmail.com>
+!
+module test_struct
+  interface assignment (=)
+    module procedure tao_lat_equal_tao_lat
+  end interface
+  type bunch_params_struct
+    integer n_live_particle          
+  end type
+  type tao_lattice_struct
+    type (bunch_params_struct), allocatable :: bunch_params(:)
+    type (bunch_params_struct), allocatable :: bunch_params2(:)
+  end type
+  type tao_universe_struct
+    type (tao_lattice_struct), pointer :: model, design
+    character(200), pointer :: descrip => NULL()
+  end type
+  type tao_super_universe_struct
+    type (tao_universe_struct), allocatable :: u(:)          
+  end type
+  type (tao_super_universe_struct), save, target :: s
+  contains
+    subroutine tao_lat_equal_tao_lat (lat1, lat2)
+      implicit none
+      type (tao_lattice_struct), intent(inout) :: lat1
+      type (tao_lattice_struct), intent(in) :: lat2
+      if (allocated(lat2%bunch_params)) then
+        lat1%bunch_params = lat2%bunch_params
+      end if 
+      if (allocated(lat2%bunch_params2)) then
+        lat1%bunch_params2 = lat2%bunch_params2
+      end if 
+    end subroutine
+end module
+
+program tao_program
+  use test_struct
+  implicit none
+  type (tao_universe_struct), pointer :: u
+  integer n, i
+  allocate (s%u(1))
+  u => s%u(1)
+  allocate (u%design, u%model)
+  n = 112
+  allocate (u%model%bunch_params(0:n), u%design%bunch_params(0:n))
+  u%design%bunch_params%n_live_particle = [(i, i = 0, n)]
+  u%model = u%design
+  u%model = u%design ! The double assignment was the cause of the ICE
+  if (.not. allocated (u%model%bunch_params)) call abort
+  if (any (u%model%bunch_params%n_live_particle .ne. [(i, i = 0, n)])) call abort
+  Deallocate (u%model%bunch_params, u%design%bunch_params)
+  deallocate (u%design, u%model)
+  deallocate (s%u)
+end program
+
+! { dg-final { cleanup-modules "test_struct" } }
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_11.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_11.f90
new file mode 100644
index 000000000..2d2b85b84
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_11.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+!
+! PR fortran/49324
+!
+! Check that with array constructors a deep copy is done
+!
+implicit none
+type t
+  integer, allocatable :: A(:)
+end type t
+
+type(t) :: x, y
+type(t), allocatable :: z(:), z2(:)
+
+allocate (x%A(2))
+allocate (y%A(1))
+x%A(:) = 11
+y%A(:) = 22
+
+allocate (z(2))
+
+z = [ x, y ]
+!print *, z(1)%a, z(2)%a, x%A, y%A
+if (any (z(1)%a /= 11) .or. z(2)%a(1) /= 22 .or. any (x%A /= 11)  &
+    .or. y%A(1) /= 22)  &
+  call abort()
+
+x%A(:) = 444
+y%A(:) = 555
+
+!print *, z(1)%a, z(2)%a, x%A, y%A
+if (any (z(1)%a /= 11) .or. z(2)%a(1) /= 22 .or. any (x%A /= 444)  &
+    .or. y%A(1) /= 555)  &
+  call abort()
+
+z(:) = [ x, y ]
+!print *, z(1)%a, z(2)%a, x%A, y%A
+if (any (z(1)%a /= 444) .or. z(2)%a(1) /= 555 .or. any (x%A /= 444)  &
+    .or. y%A(1) /= 555)  &
+  call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_2.f90
new file mode 100644
index 000000000..32c3c82dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_2.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+! Test FORALL and WHERE with derived types with allocatable components (PR 20541).
+!
+! Contributed by Erik Edelmann  <eedelmann@gcc.gnu.org>
+!            and Paul Thomas  <pault@gcc.gnu.org>
+!
+  type :: a
+    integer, allocatable :: i(:)
+  end type a
+
+  type :: b
+    type (a), allocatable :: at(:)
+  end type b
+
+  type(a) :: x(2)
+  type(b) :: y(2), z(2)
+  integer i, m(4)
+
+! Start with scalar and array element assignments in FORALL.
+
+  x(1) = a ((/1, 2, 3, 4/))
+  x(2) = a ((/1, 2, 3, 4/) + 10)
+  forall (j = 1:2, i = 1:4, x(j)%i(i) > 2 + (j-1)*10)  x(j)%i(i) =  j*4-i
+  if (any ((/((x(i)%i(j), j = 1,4), i = 1,2)/) .ne. &
+          (/1, 2, 1, 0, 11, 12, 5, 4/))) call abort ()
+
+  y(1) = b ((/x(1),x(2)/))
+  y(2) = b ((/x(2),x(1)/))
+  forall (k = 1:2, j=1:2, i = 1:4, y(k)%at(j)%i(i) <= 10)
+    y(k)%at(j)%i(i) =  j*4-i+k
+  end forall
+  if (any ((/(((y(k)%at(i)%i(j), j = 1,4), i = 1,2), k = 1,2)/) .ne. &
+         (/4,3,2,1,11,12,6,5,11,12,3,2,9,8,7,6/))) call abort () 
+
+! Now simple assignments in WHERE.
+
+  where (y(1)%at(1)%i > 2) y(1)%at(1)%i = 0
+  if (any( (/(((y(k)%at(i)%i(j), j = 1,4), i = 1,2), k = 1,2)/) .ne. &
+         (/0,0,2,1,11,12,6,5,11,12,3,2,9,8,7,6/))) call abort () 
+
+! Check that temporaries and full array  alloctable component assignments
+! are correctly handled in FORALL.
+
+  x = (/a ((/1,2,3,4/)),a ((/5,6,7,8/))/)
+  forall (i=1:2) y(i) = b ((/x(i)/))
+  forall (i=1:2) y(i) = y(3-i)      ! This needs a temporary.
+  forall (i=1:2) z(i) = y(i)
+  if (any ((/(((z(k)%at(i)%i(j), j = 1,4), i = 1,1), k = 1,2)/) .ne. &
+         (/(/5,6,7,8/),(/1,2,3,4/)/))) call abort ()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_3.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_3.f90
new file mode 100644
index 000000000..5be6bd990
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_3.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! Test assignments of nested derived types with allocatable components(PR 20541).
+!
+! Contributed by Erik Edelmann  <eedelmann@gcc.gnu.org>
+!            and Paul Thomas  <pault@gcc.gnu.org>
+!
+  type :: a
+    integer, allocatable :: i(:)
+  end type a
+
+  type :: b
+    type (a), allocatable :: at(:)
+  end type b
+
+  type(a) :: x(2)
+  type(b) :: y(2), z(2)
+  integer i, m(4)
+
+  x(1) = a((/1,2,3,4/))
+  x(2) = a((/1,2,3,4/)+10)
+
+  y(1) = b((/x(1),x(2)/))
+  y(2) = b((/x(2),x(1)/))
+
+  y(2) = y(1)
+  forall (j=1:2,k=1:4, y(1)%at(j)%i(k) .ne. y(2)%at(j)%i(k)) &
+                             y(1)%at(j)%i(k) = 999
+  if (any ((/((y(1)%at(j)%i(k), k=1,4),j=1,2)/) .eq. 999)) call abort ()
+
+
+  z = y
+  forall (i=1:2,j=1:2,k=1:4, z(i)%at(j)%i(k) .ne. y(i)%at(j)%i(k)) &
+                             z(i)%at(j)%i(k) = 999
+  if (any ((/(((z(i)%at(j)%i(k), k=1,4),j=1,2),i=1,2)/) .eq. 999)) call abort ()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_4.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_4.f90
new file mode 100644
index 000000000..b204106da
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_4.f90
@@ -0,0 +1,63 @@
+! { dg-do run }
+! Test assignments of nested derived types with character allocatable
+! components(PR 20541). Subroutine test_ab6 checks out a bug in a test
+! version of gfortran's allocatable arrays.
+!
+! Contributed by Erik Edelmann  <eedelmann@gcc.gnu.org>
+!            and Paul Thomas  <pault@gcc.gnu.org>
+!
+  type :: a
+    character(4), allocatable :: ch(:)
+  end type a
+
+  type :: b
+    type (a), allocatable :: at(:)
+  end type b
+
+  type(a) :: x(2)
+  type(b) :: y(2), z(2)
+
+  character(4) :: chr1(4) = (/"abcd","efgh","ijkl","mnop"/)
+  character(4) :: chr2(4) = (/"qrst","uvwx","yz12","3456"/)
+
+  x(1) = a(chr1)
+
+ ! Check constructor with character array constructors.
+  x(2) = a((/"qrst","uvwx","yz12","3456"/))
+
+  y(1) = b((/x(1),x(2)/))
+  y(2) = b((/x(2),x(1)/))
+
+  y(2) = y(1)
+
+  if (any((/((y(2)%at(i)%ch(j),j=1,4),i=1,2)/) .ne. &
+          (/chr1, chr2/))) call abort ()
+
+  call test_ab6 ()
+
+contains
+
+  subroutine test_ab6 ()
+! This subroutine tests the presence of a scalar derived type, intermediate
+! in a chain of derived types with allocatable components.
+! Contributed by Salvatore Filippone  <salvatore.filippone@uniroma2.it>
+
+    type b
+      type(a)  :: a
+    end type b
+
+    type c
+      type(b), allocatable :: b(:) 
+    end type c
+
+    type(c)    :: p
+    type(b)   :: bv
+
+    p = c((/b(a((/"Mary","Lamb"/)))/))
+    bv = p%b(1)
+
+    if (any ((bv%a%ch(:)) .ne. (/"Mary","Lamb"/))) call abort ()
+
+end subroutine test_ab6
+
+end
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_5.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_5.f90
new file mode 100644
index 000000000..3cc3695c4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_5.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! { dg-options "-O2" }
+! Tests the fix for PR29428, in which the assignment of
+! a function result would result in the function being
+! called twice, if it were not a result by reference,
+! because of a spurious nullify in gfc_trans_scalar_assign.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+program test
+implicit none
+
+  type A
+    integer, allocatable :: j(:)
+  end type A
+
+  type(A):: x
+  integer :: ctr = 0
+
+  x = f()
+
+  if (ctr /= 1) call abort ()
+
+contains
+
+  function f()
+    type(A):: f
+      ctr = ctr + 1
+      f = A ((/1,2/))
+  end function f
+
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_6.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_6.f90
new file mode 100644
index 000000000..4e8edc228
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_6.f90
@@ -0,0 +1,55 @@
+! { dg-do run }
+! Tests the fix for pr32880, in which 'res' was deallocated
+! before it could be used in the concatenation.
+! Adapted from vst28.f95, in Lawrie Schonfeld's iso_varying_string
+! testsuite, by Tobias Burnus.
+!
+module iso_varying_string
+  type varying_string
+     character(LEN=1), dimension(:), allocatable :: chars
+  end type varying_string
+  interface assignment(=)
+     module procedure op_assign_VS_CH
+  end interface assignment(=)
+  interface operator(//)
+     module procedure op_concat_VS_CH
+  end interface operator(//)
+contains
+  elemental subroutine op_assign_VS_CH (var, exp)
+    type(varying_string), intent(out) :: var
+    character(LEN=*), intent(in)      :: exp
+    integer                      :: length
+    integer                      :: i_char
+    length = len(exp)
+    allocate(var%chars(length))
+    forall(i_char = 1:length)
+       var%chars(i_char) = exp(i_char:i_char)
+    end forall
+  end subroutine op_assign_VS_CH
+  elemental function op_concat_VS_CH (string_a, string_b) result (concat_string)
+    type(varying_string), intent(in) :: string_a
+    character(LEN=*), intent(in)     :: string_b
+    type(varying_string)             :: concat_string
+    len_string_a = size(string_a%chars)
+    allocate(concat_string%chars(len_string_a+len(string_b)))
+    if (len_string_a >0) &
+       concat_string%chars(:len_string_a) = string_a%chars
+    if (len (string_b) > 0) &
+       concat_string%chars(len_string_a+1:) = string_b
+  end function op_concat_VS_CH
+end module iso_varying_string
+
+program VST28
+  use iso_varying_string
+  character(len=10) :: char_a
+  type(VARYING_STRING) :: res
+  char_a = "abcdefghij"
+  res = char_a(5:5)
+  res = res//char_a(6:6)
+  if(size(res%chars) /= 2 .or. any(res%chars /= ['e','f'])) then
+    write(*,*) 'ERROR: should be ef, got: ', res%chars, size(res%chars)
+    call abort ()
+  end if
+end program VST28
+
+! { dg-final { cleanup-modules "iso_varying_string" } }
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_7.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_7.f90
new file mode 100644
index 000000000..c0f3c76eb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_7.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+!
+! Test the fix for PR37735, in which gfc gagged in the assignement to
+! 'p'.  The array component 'r' caused an ICE.
+!
+! Contributed by Steven Winfield <saw44@cam.ac.uk>
+!
+module PrettyPix_module
+  implicit none
+  type Spline
+     real, allocatable, dimension(:) ::y2
+  end type Spline
+  type Path
+     type(Spline) :: r(3)
+  end type Path
+  type Scene
+     type(path) :: look_at_path
+  end type Scene
+contains
+  subroutine scene_set_look_at_path(this,p)
+    type(scene), intent(inout) :: this
+    type(path),  intent(in)    :: p
+    this%look_at_path = p
+  end subroutine scene_set_look_at_path
+end module PrettyPix_module
+
+  use PrettyPix_module
+  implicit none
+  integer :: i
+  real :: x(3) = [1.0, 2.0, 3.0]
+  type(scene) :: this
+  type(path)  :: p
+  p = path ([spline([x(1)]),spline([x(2)]),spline([x(3)])])
+  call scene_set_look_at_path(this,p)
+  do i = 1, 3
+    if (this%look_at_path%r(i)%y2(1) .ne. x(i)) call abort
+  end do
+end
+
+! { dg-final { cleanup-modules "PrettyPix_module" } }
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_8.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_8.f90
new file mode 100644
index 000000000..ab4868de1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_8.f90
@@ -0,0 +1,50 @@
+! { dg-do run }
+!
+! Test the fix for PR35824, in which the interface assignment and
+! negation did not work correctly.
+!
+! Contributed by Rolf Roth <everyo@gmx.net>
+!
+module typemodule
+  type alltype
+     double precision :: a
+     double precision,allocatable :: b(:)
+  end type
+  interface assignment(=)
+    module procedure at_from_at
+  end interface
+  interface operator(-)
+    module procedure  neg_at
+  end interface
+contains
+  subroutine at_from_at(b,a)
+    type(alltype), intent(in) :: a
+    type(alltype), intent(out) :: b
+    b%a=a%a
+    allocate(b%b(2))
+    b%b=a%b
+  end subroutine at_from_at
+  function neg_at(a) result(b)
+    type(alltype), intent(in) :: a
+    type(alltype) :: b
+    b%a=-a%a
+    allocate(b%b(2))
+    b%b=-a%b
+  end function neg_at
+end module
+  use typemodule
+  type(alltype) t1,t2,t3
+  allocate(t1%b(2))
+  t1%a=0.5d0
+  t1%b(1)=1d0
+  t1%b(2)=2d0
+  t2=-t1
+  if (t2%a .ne. -0.5d0) call abort
+  if (any(t2%b .ne. [-1d0, -2d0])) call abort
+
+  t1=-t1
+  if (t1%a .ne. -0.5d0) call abort
+  if (any(t1%b .ne. [-1d0, -2d0])) call abort
+end
+
+! { dg-final { cleanup-modules "typemodule" } }
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_9.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_9.f90
new file mode 100644
index 000000000..9051bafa0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_9.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! Test the fix for PR39519, where the presence of the pointer
+! as the first component was preventing the second from passing
+! the "alloc_comp" attribute to the derived type.
+!
+! Contributed by Gilbert Scott <gilbert.scott@easynet.co.uk>
+!
+PROGRAM X
+  TYPE T
+    INTEGER, POINTER :: P
+    INTEGER, ALLOCATABLE :: A(:)
+  END TYPE T
+  TYPE(T) :: T1,T2
+  ALLOCATE ( T1%A(1) )
+  ALLOCATE ( T2%A(1) )
+  T1%A = 23
+  T2 = T1
+  T1%A = 42
+  if (T2%A(1) .NE. 23) CALL ABORT
+END PROGRAM X
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_1.f90
new file mode 100644
index 000000000..915b2108f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_1.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+! Fix for PR29699 - see below for details.
+!
+! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+PROGRAM vocabulary_word_count
+
+  IMPLICIT NONE
+  TYPE VARYING_STRING
+    CHARACTER,DIMENSION(:),ALLOCATABLE :: chars
+  ENDTYPE VARYING_STRING
+
+  INTEGER :: list_size=200
+
+  call extend_lists2
+
+CONTAINS
+
+! First the original problem: vocab_swap not being referenced caused
+! an ICE because default initialization is used, which results in a
+! call to gfc_conv_variable, which calls gfc_get_symbol_decl.
+
+  SUBROUTINE extend_lists1
+    type(VARYING_STRING),DIMENSION(list_size) :: vocab_swap
+  ENDSUBROUTINE extend_lists1
+
+! Curing this then uncovered two more problems: If vocab_swap were
+! actually referenced, an ICE occurred in the gimplifier because
+! the declaration for this automatic array is presented as a
+! pointer to the array, rather than the array. Curing this allows
+! the code to compile but it bombed out at run time because the
+! malloc/free occurred in the wrong order with respect to the
+! nullify/deallocate of the allocatable components.
+
+  SUBROUTINE extend_lists2
+    type(VARYING_STRING),DIMENSION(list_size) :: vocab_swap
+    allocate (vocab_swap(1)%chars(10))
+    if (.not.allocated(vocab_swap(1)%chars)) call abort ()
+    if (allocated(vocab_swap(10)%chars)) call abort ()
+  ENDSUBROUTINE extend_lists2
+  
+ENDPROGRAM vocabulary_word_count
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_2.f90
new file mode 100644
index 000000000..c8945cfc3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_2.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+! Tests the fix for PR34820, in which the nullification of the
+! automatic array iregion occurred in the caller, rather than the
+! callee.  Since 'nproc' was not available, an ICE ensued. During
+! the bug fix, it was found that the scalar to array assignment
+! of derived types with allocatable components did not work and
+! the fix of this is tested too.
+!
+! Contributed by Toon Moene <toon@moene.indiv.nluug.nl>
+!
+module grid_io
+  type grid_index_region
+    integer, allocatable::lons(:)
+  end type grid_index_region
+contains
+  subroutine read_grid_header()
+    integer :: npiece = 1
+    type(grid_index_region),allocatable :: iregion(:)
+    allocate (iregion(npiece + 1))
+    call read_iregion(npiece,iregion)
+    if (size(iregion) .ne. npiece + 1) call abort
+    if (.not.allocated (iregion(npiece)%lons)) call abort
+    if (allocated (iregion(npiece+1)%lons)) call abort
+    if (any (iregion(npiece)%lons .ne. [(i, i = 1, npiece)])) call abort
+    deallocate (iregion)
+  end subroutine read_grid_header
+
+  subroutine read_iregion (nproc,iregion)
+    integer,intent(in)::nproc
+    type(grid_index_region), intent(OUT)::iregion(1:nproc)
+    integer :: iarg(nproc)
+    iarg = [(i, i = 1, nproc)]
+    iregion = grid_index_region (iarg) !
+  end subroutine read_iregion
+end module grid_io
+
+  use grid_io
+  call read_grid_header
+end
+! { dg-final { cleanup-tree-dump "grid_io" } }
+! { dg-final { cleanup-modules "grid_io" } }
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90
new file mode 100644
index 000000000..e53112ce4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90
@@ -0,0 +1,144 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+!
+! Check some basic functionality of allocatable components, including that they
+! are nullified when created and automatically deallocated when
+! 1. A variable goes out of scope
+! 2. INTENT(OUT) dummies
+! 3. Function results
+!
+!
+! Contributed by Erik Edelmann  <eedelmann@gcc.gnu.org>
+!            and Paul Thomas  <pault@gcc.gnu.org>
+!
+module alloc_m
+
+    implicit none
+
+    type :: alloc1
+        real, allocatable :: x(:)
+    end type alloc1
+
+end module alloc_m
+
+
+program alloc
+
+    use alloc_m
+
+    implicit none
+
+    type :: alloc2
+        type(alloc1), allocatable :: a1(:)
+        integer, allocatable :: a2(:)
+    end type alloc2
+
+    type(alloc2) :: b
+    integer :: i
+    type(alloc2), allocatable :: c(:)
+
+    if (allocated(b%a2) .OR. allocated(b%a1)) then
+        write (0, *) 'main - 1'
+        call abort()
+    end if
+
+    ! 3 calls to _gfortran_deallocate (INTENT(OUT) dummy)
+    call allocate_alloc2(b)
+    call check_alloc2(b)
+
+    do i = 1, size(b%a1)
+        ! 1 call to _gfortran_deallocate
+        deallocate(b%a1(i)%x)
+    end do
+
+    ! 3 calls to _gfortran_deallocate (INTENT(OUT) dummy)
+    call allocate_alloc2(b)
+
+    call check_alloc2(return_alloc2())
+    ! 3 calls to _gfortran_deallocate (function result)
+
+    allocate(c(1))
+    ! 3 calls to _gfortran_deallocate (INTENT(OUT) dummy)
+    call allocate_alloc2(c(1))
+    ! 4 calls to _gfortran_deallocate
+    deallocate(c)
+
+    ! 7 calls to _gfortran_deallocate (b (3) and c(4) goes aout of scope)
+
+contains
+
+    subroutine allocate_alloc2(b)
+        type(alloc2), intent(out) :: b
+        integer :: i
+
+        if (allocated(b%a2) .OR. allocated(b%a1)) then
+            write (0, *) 'allocate_alloc2 - 1'
+            call abort()
+        end if
+
+        allocate (b%a2(3))
+        b%a2 = [ 1, 2, 3 ]
+
+        allocate (b%a1(3))
+
+        do i = 1, 3
+            if (allocated(b%a1(i)%x)) then
+                write (0, *) 'allocate_alloc2 - 2', i
+                call abort()
+            end if
+            allocate (b%a1(i)%x(3))
+            b%a1(i)%x = i + [ 1.0, 2.0, 3.0 ]
+        end do
+
+    end subroutine allocate_alloc2
+
+
+    type(alloc2) function return_alloc2() result(b)
+        if (allocated(b%a2) .OR. allocated(b%a1)) then
+            write (0, *) 'return_alloc2 - 1'
+            call abort()
+        end if
+
+        allocate (b%a2(3))
+        b%a2 = [ 1, 2, 3 ]
+
+        allocate (b%a1(3))
+
+        do i = 1, 3
+            if (allocated(b%a1(i)%x)) then
+                write (0, *) 'return_alloc2 - 2', i
+                call abort()
+            end if
+            allocate (b%a1(i)%x(3))
+            b%a1(i)%x = i + [ 1.0, 2.0, 3.0 ]
+        end do
+    end function return_alloc2
+
+
+    subroutine check_alloc2(b)
+        type(alloc2), intent(in) :: b
+
+        if (.NOT.(allocated(b%a2) .AND. allocated(b%a1))) then
+            write (0, *) 'check_alloc2 - 1'
+            call abort()
+        end if
+        if (any(b%a2 /= [ 1, 2, 3 ])) then
+            write (0, *) 'check_alloc2 - 2'
+            call abort()
+        end if
+        do i = 1, 3
+            if (.NOT.allocated(b%a1(i)%x)) then
+                write (0, *) 'check_alloc2 - 3', i
+                call abort()
+            end if
+            if (any(b%a1(i)%x /= i + [ 1.0, 2.0, 3.0 ])) then
+                write (0, *) 'check_alloc2 - 4', i
+                call abort()
+            end if
+        end do
+    end subroutine check_alloc2
+
+end program alloc
+! { dg-final { scan-tree-dump-times "builtin_free" 18 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-modules "alloc_m" } }
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_basics_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_basics_2.f90
new file mode 100644
index 000000000..170a8871f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_basics_2.f90
@@ -0,0 +1,39 @@
+! { dg-do run }

+! Check "double" allocations of allocatable components (PR 20541).

+!

+! Contributed by Erik Edelmann  <eedelmann@gcc.gnu.org>

+!            and Paul Thomas  <pault@gcc.gnu.org>

+!

+program main

+

+  implicit none

+

+  type foo

+     integer, dimension(:), allocatable :: array

+  end type foo

+

+  type(foo),allocatable,dimension(:) :: mol

+  type(foo),pointer,dimension(:) :: molp

+  integer :: i

+

+  allocate (mol(1))

+  allocate (mol(1), stat=i)

+  !print *, i  ! /= 0

+  if (i == 0) call abort()

+

+  allocate (mol(1)%array(5))

+  allocate (mol(1)%array(5),stat=i)

+  !print *, i  ! /= 0

+  if (i == 0) call abort()

+

+  allocate (molp(1))

+  allocate (molp(1), stat=i)

+  !print *, i  ! == 0

+  if (i /= 0) call abort()

+

+  allocate (molp(1)%array(5))

+  allocate (molp(1)%array(5),stat=i)

+  !print *, i  ! /= 0

+  if (i == 0) call abort()

+

+end program main

diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_basics_3.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_basics_3.f90
new file mode 100644
index 000000000..9140cd2ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_basics_3.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! Test the patch for PR30202 in which the INTENT(OUT)
+! caused an ICE.
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+!
+program class_scal_p
+  implicit none
+  type scal_p
+    real, allocatable :: b(:)
+  end type scal_p
+  type(scal_p) :: pd
+  call psb_geallv(pd%b)
+contains
+  subroutine psb_geallv(x)
+    real, allocatable, intent(out) :: x(:)
+  end subroutine psb_geallv
+end program class_scal_p
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_basics_4.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_basics_4.f90
new file mode 100644
index 000000000..508d56706
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_basics_4.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! Tests the fix for PR30660 in which gfortran insisted that g_dest
+! should have the SAVE attribute because the hidden default
+! initializer for the allocatable component was being detected.
+!
+! Contributed by Toon Moene <toon@moene.indiv.nluug.nl>
+!
+MODULE types_m
+  TYPE coord_t
+    INTEGER ncord
+    REAL,ALLOCATABLE,DIMENSION(:) :: x, y
+  END TYPE
+
+  TYPE grib_t
+    REAL,DIMENSION(:),ALLOCATABLE :: vdata
+   TYPE(coord_t) coords
+  END TYPE
+END MODULE
+
+MODULE globals_m
+  USE types_m
+  TYPE(grib_t) g_dest           ! output field
+END MODULE
+! { dg-final { cleanup-modules "types_m globals_m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_basics_5.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_basics_5.f90
new file mode 100644
index 000000000..99cd9e08c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_basics_5.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! This checks the correct functioning of derived types with the SAVE
+! attribute and allocatable components - PR31163
+!
+! Contributed by Salvatore Filippone  <salvatore.filippone@uniroma2.it>
+!
+Module bar_mod
+
+  type foo_type
+     integer, allocatable :: mv(:)
+  end type foo_type
+
+
+contains
+
+
+  subroutine bar_foo_ab(info)
+
+    integer, intent(out)               :: info
+    Type(foo_type), save :: f_a
+    
+    if (allocated(f_a%mv)) then 
+      info = size(f_a%mv)
+    else
+      allocate(f_a%mv(10),stat=info)
+      if (info /= 0) then 
+        info = -1 
+      endif
+    end if
+  end subroutine bar_foo_ab
+
+
+end module bar_mod
+
+program tsave
+  use bar_mod
+
+  integer :: info
+  
+  call bar_foo_ab(info) 
+  if (info .ne. 0) call abort ()
+  call bar_foo_ab(info) 
+  if (info .ne. 10) call abort ()
+  
+end program tsave
+
+! { dg-final { cleanup-modules "bar_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_bounds_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_bounds_1.f90
new file mode 100644
index 000000000..28ad177e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_bounds_1.f90
@@ -0,0 +1,50 @@
+! { dg-do run }
+! Test the fix for PR38324, in which the bounds were not set correctly for
+! constructor assignments with allocatable components.
+!
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+!
+  integer, parameter :: ik4 = 4
+  integer, parameter :: ik8 = 8
+  integer, parameter :: from = -1, to = 2
+  call foo
+  call bar
+contains
+  subroutine foo
+    type :: struct
+      integer(4), allocatable :: ib(:)
+    end type struct
+    integer(ik4), allocatable :: ia(:)
+    type(struct) :: x
+    allocate(ia(from:to))
+    if (any(lbound(ia) .ne. -1) .or. any(ubound(ia) .ne. 2)) call abort
+    if (any(lbound(ia(:)) .ne. 1) .or. any(ubound(ia(:)) .ne. 4)) call abort
+    if (any(lbound(ia(from:to)) .ne. 1) .or. any(ubound(ia(from:to)) .ne. 4)) call abort
+    x=struct(ia)
+    if (any(lbound(x%ib) .ne. -1) .or. any(ubound(x%ib) .ne. 2)) call abort
+    x=struct(ia(:))
+    if (any(lbound(x%ib) .ne. 1) .or. any(ubound(x%ib) .ne. 4)) call abort
+    x=struct(ia(from:to))
+    if (any(lbound(x%ib) .ne. 1) .or. any(ubound(x%ib) .ne. 4)) call abort
+    deallocate(ia)
+  end subroutine
+  subroutine bar
+    type :: struct
+      integer(4), allocatable :: ib(:)
+    end type struct
+    integer(ik8), allocatable :: ia(:)
+    type(struct) :: x
+    allocate(ia(from:to))
+    if (any(lbound(ia) .ne. -1) .or. any(ubound(ia) .ne. 2)) call abort
+    if (any(lbound(ia(:)) .ne. 1) .or. any(ubound(ia(:)) .ne. 4)) call abort
+    if (any(lbound(ia(from:to)) .ne. 1) .or. any(ubound(ia(from:to)) .ne. 4)) call abort
+    x=struct(ia)
+    if (any(lbound(x%ib) .ne. -1) .or. any(ubound(x%ib) .ne. 2)) call abort
+    x=struct(ia(:))
+    if (any(lbound(x%ib) .ne. 1) .or. any(ubound(x%ib) .ne. 4)) call abort
+    x=struct(ia(from:to))
+    if (any(lbound(x%ib) .ne. 1) .or. any(ubound(x%ib) .ne. 4)) call abort
+    deallocate(ia)
+  end subroutine
+end
+
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_class_1.f90
new file mode 100644
index 000000000..c783f49ff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_1.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! Test the fix for PR43895, in which the dummy 'a' was not
+! dereferenced for the deallocation of component 'a', as required
+! for INTENT(OUT).
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+!
+module d_mat_mod
+  type  :: base_sparse_mat
+  end type base_sparse_mat
+
+  type, extends(base_sparse_mat) :: d_base_sparse_mat
+    integer :: i
+  end type d_base_sparse_mat
+
+  type :: d_sparse_mat
+    class(d_base_sparse_mat), allocatable  :: a 
+  end type d_sparse_mat
+end module d_mat_mod
+
+  use d_mat_mod
+  type(d_sparse_mat) :: b
+  allocate (b%a)
+  b%a%i = 42
+  call bug14 (b)
+  if (allocated (b%a)) call abort
+contains
+  subroutine bug14(a)
+    implicit none
+    type(d_sparse_mat), intent(out) :: a
+  end subroutine bug14
+end
+! { dg-final { cleanup-modules "d_mat_mod " } }
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_class_2.f90
new file mode 100644
index 000000000..718628189
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_2.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+!
+! PR 46838: [OOP] Initialization of polymorphic allocatable components
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+program bug28
+
+  implicit none
+
+  type indx_map
+  end type
+
+  type desc_type
+    integer, allocatable         :: matrix_data
+    class(indx_map), allocatable :: indxmap
+  end type
+
+  type(desc_type) :: desc_a
+  call cdall(desc_a)
+
+contains
+
+  subroutine cdall(desc)
+    type(desc_type), intent(out)  :: desc
+    if (allocated(desc%indxmap)) call abort()
+  end subroutine cdall
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constraint_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constraint_1.f90
new file mode 100644
index 000000000..eb1b10587
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_constraint_1.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! Check that we don't allow IO or NAMELISTs with types with allocatable
+! components (PR 20541)
+program main
+
+    type :: foo
+        integer, allocatable :: x(:)
+    end type foo
+
+    type :: bar
+        type(foo) :: x
+    end type bar
+
+    type(foo) :: a
+    type(bar) :: b
+    namelist /blah/ a ! { dg-error "has ALLOCATABLE or POINTER components and thus requires a defined input/output" }
+
+    write (*, *) a  ! { dg-error "cannot have ALLOCATABLE components" }
+
+    read (*, *) b  ! { dg-error "cannot have ALLOCATABLE components" }
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constraint_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constraint_2.f90
new file mode 100644
index 000000000..c37edb6bc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_constraint_2.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! Check that equivalence with allocatable components isn't allowed (PR 20541)
+program main
+
+    type :: foo
+        sequence
+        integer, allocatable :: x(:)
+    end type foo
+
+    type(foo) :: a
+    integer :: b
+
+    equivalence (a, b) ! { dg-error "cannot have ALLOCATABLE components" }
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constraint_3.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constraint_3.f90
new file mode 100644
index 000000000..58a0e7463
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_constraint_3.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! Check that default initializer for allocatable components isn't accepted (PR
+! 20541)
+program main
+
+    type :: foo
+        integer, allocatable :: a(:) = [ 1 ] ! { dg-error "Initialization of allocatable" }
+
+        integer :: x ! Just to avoid "extra" error messages about empty type.
+    end type foo
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constraint_4.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constraint_4.f90
new file mode 100644
index 000000000..e24bfe0a2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_constraint_4.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! Tests the fix for PR29422, in which function results
+! were not tested for suitability in IO statements.
+!
+! Contributed by Dominique d'Humieres  <dominiq@lps.ens.fr>
+!
+Type drv
+ Integer :: i
+ Integer, allocatable :: arr(:)
+End type drv
+
+  print *, fun1 () ! { dg-error "cannot have ALLOCATABLE" }
+
+contains
+  Function fun1 ()
+
+    Type(drv) :: fun1
+    fun1%i = 10
+  end function fun1
+end
+
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constraint_5.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constraint_5.f90
new file mode 100644
index 000000000..d0e57aea5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_constraint_5.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! Check that ALLOCATABLE components aren't allowed to the right of a non-zero
+! rank part reference.
+program test
+
+    implicit none
+    type :: foo
+        real, allocatable :: bar(:)
+    end type foo
+    type(foo), target :: x(3)
+    integer :: i
+    real, pointer :: p(:)
+
+    allocate(x(:)%bar(5))! { dg-error "must not have the ALLOCATABLE attribute" }
+    x(:)%bar(1) = 1.0    ! { dg-error "must not have the ALLOCATABLE attribute" }
+    p => x(:)%bar(1)     ! { dg-error "must not have the ALLOCATABLE attribute" }
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constraint_6.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constraint_6.f90
new file mode 100644
index 000000000..e2b609aee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_constraint_6.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! PR45889 Regression with I/O of element of allocatable array in derived type 
+module cell
+  implicit none
+  private 
+  type, public:: unit_cell
+     integer                                             ::num_species
+     character(len=8), dimension(:),          allocatable::species_symbol
+  end type unit_cell
+  type(unit_cell),                            public, save::current_cell 
+  contains
+  subroutine cell_output
+    implicit none
+    integer::i
+    do i=1,current_cell%num_species
+       write(*,*)(current_cell%species_symbol(i))
+    end do
+    return
+  end subroutine cell_output
+end module cell
+! { dg-final { cleanup-modules "cell" } }
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constructor_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_1.f90
new file mode 100644
index 000000000..969e70309
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_1.f90
@@ -0,0 +1,108 @@
+! { dg-do run }

+! { dg-options "-fdump-tree-original" }

+! Test constructors of derived type with allocatable components (PR 20541).

+!

+! Contributed by Erik Edelmann  <eedelmann@gcc.gnu.org>

+!            and Paul Thomas  <pault@gcc.gnu.org>

+!

+

+Program test_constructor

+

+    implicit none

+

+    type :: thytype

+        integer(4) :: a(2,2)

+    end type thytype

+

+    type :: mytype

+        integer(4), allocatable :: a(:, :)

+        type(thytype), allocatable :: q(:)

+    end type mytype

+

+    type (mytype) :: x

+    type (thytype) :: foo = thytype(reshape ([43, 100, 54, 76], [2,2]))

+    integer :: y(0:1, -1:0) = reshape ([42, 99, 55, 77], [2,2])

+    integer, allocatable :: yy(:,:)

+    type (thytype), allocatable :: bar(:)

+    integer :: i

+

+    ! Check that null() works

+    x = mytype(null(), null())

+    if (allocated(x%a) .or. allocated(x%q)) call abort()

+

+    ! Check that unallocated allocatables work

+    x = mytype(yy, bar)

+    if (allocated(x%a) .or. allocated(x%q)) call abort()

+

+    ! Check that non-allocatables work

+    x = mytype(y, [foo, foo])

+    if (.not.allocated(x%a) .or. .not.allocated(x%q)) call abort()

+    if (any(lbound(x%a) /= lbound(y))) call abort()

+    if (any(ubound(x%a) /= ubound(y))) call abort()

+    if (any(x%a /= y)) call abort()

+    if (size(x%q) /= 2) call abort()

+    do i = 1, 2

+        if (any(x%q(i)%a /= foo%a)) call abort()

+    end do

+

+    ! Check that allocated allocatables work

+    allocate(yy(size(y,1), size(y,2)))

+    yy = y

+    allocate(bar(2))

+    bar = [foo, foo]

+    x = mytype(yy, bar)

+    if (.not.allocated(x%a) .or. .not.allocated(x%q)) call abort()

+    if (any(x%a /= y)) call abort()

+    if (size(x%q) /= 2) call abort()

+    do i = 1, 2

+        if (any(x%q(i)%a /= foo%a)) call abort()

+    end do

+

+    ! Functions returning arrays

+    x = mytype(bluhu(), null())

+    if (.not.allocated(x%a) .or. allocated(x%q)) call abort()

+    if (any(x%a /= reshape ([41, 98, 54, 76], [2,2]))) call abort()

+

+    ! Functions returning allocatable arrays

+    x = mytype(blaha(), null())

+    if (.not.allocated(x%a) .or. allocated(x%q)) call abort()

+    if (any(x%a /= reshape ([40, 97, 53, 75], [2,2]))) call abort()

+

+    ! Check that passing the constructor to a procedure works

+    call check_mytype (mytype(y, [foo, foo]))

+

+contains

+

+    subroutine check_mytype(x)

+        type(mytype), intent(in) :: x

+        integer :: i

+

+        if (.not.allocated(x%a) .or. .not.allocated(x%q)) call abort()

+        if (any(lbound(x%a) /= lbound(y))) call abort()

+        if (any(ubound(x%a) /= ubound(y))) call abort()

+        if (any(x%a /= y)) call abort()

+        if (size(x%q) /= 2) call abort()

+        do i = 1, 2

+            if (any(x%q(i)%a /= foo%a)) call abort()

+        end do

+

+    end subroutine check_mytype

+

+

+    function bluhu()

+        integer :: bluhu(2,2)

+

+        bluhu = reshape ([41, 98, 54, 76], [2,2])

+    end function bluhu

+

+

+    function blaha()

+        integer, allocatable :: blaha(:,:)

+

+        allocate(blaha(2,2))

+        blaha = reshape ([40, 97, 53, 75], [2,2])

+    end function blaha

+

+end program test_constructor

+! { dg-final { scan-tree-dump-times "builtin_free" 19 "original" } }

+! { dg-final { cleanup-tree-dump "original" } }

diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constructor_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_2.f90
new file mode 100644
index 000000000..08c3bdf69
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_2.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! Test constructors of nested derived types with allocatable components(PR 20541).
+!
+! Contributed by Erik Edelmann  <eedelmann@gcc.gnu.org>
+!            and Paul Thomas  <pault@gcc.gnu.org>
+!
+  type :: thytype
+    integer(4), allocatable :: h(:)
+  end type thytype
+
+  type :: mytype
+    type(thytype), allocatable :: q(:)
+  end type mytype
+
+  type (mytype) :: x
+  type (thytype) :: w(2)
+  integer :: y(2) =(/1,2/)
+
+  w = (/thytype(y), thytype (2*y)/)
+  x = mytype (w)
+  if (any ((/((x%q(j)%h(i),j=1,2),i=1,2)/) .ne. (/1,2,2,4/))) call abort ()
+
+  x = mytype ((/thytype(3*y), thytype (4*y)/))
+  if (any ((/((x%q(j)%h(i),j=1,2),i=1,2)/) .ne. (/3,4,6,8/))) call abort ()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constructor_3.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_3.f90
new file mode 100644
index 000000000..53fa79c00
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_3.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! Tests the fix for PR32665 in which the structure initializer at line
+! 13 was getting the array length wrong by one and in which the automatic
+! deallocation of a in 14 was occurring before the evaluation of the rhs.
+!
+! Contributed by Daniel Franke <dfranke@gcc.gnu.org>
+!
+  TYPE :: x
+    INTEGER, ALLOCATABLE :: a(:)
+  END TYPE
+  TYPE(x) :: a
+
+  a = x ((/ 1, 2, 3 /))                             ! This is also pr31320.
+  a = x ((/ a%a, 4 /))
+  if (any (a%a .ne. (/1,2,3,4/))) call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constructor_4.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_4.f90
new file mode 100644
index 000000000..4b047daf3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_4.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! Tests the fix for PR32795, which was primarily about memory leakage is
+! certain combinations of alloctable components and constructors. This test
+! which appears in comment #2 of the PR has the advantage of a wrong
+! numeric result which is symptomatic.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+  type :: a
+    integer, allocatable :: i(:)
+  end type a
+  type(a) :: x, y
+  x = a ([1, 2, 3])
+  y = a (x%i(:))  ! used to cause a memory leak and wrong result
+  if (any (x%i .ne. [1, 2, 3])) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constructor_5.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_5.f90
new file mode 100644
index 000000000..9526112c9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_5.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-options "-fdefault-integer-8" }
+! Tests the fix for PR34143, in which the implicit conversion of yy, with
+! fdefault-integer-8, would cause a segfault at runtime.
+!
+! Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>
+!
+Program test_constructor
+    implicit none
+    type :: thytype
+        integer(4) :: a(2,2)
+    end type thytype
+    type :: mytype
+        integer(4), allocatable :: a(:, :)
+        type(thytype), allocatable :: q(:)
+    end type mytype
+    integer, allocatable :: yy(:,:)
+    type (thytype), allocatable :: bar(:)
+    type (mytype) :: x, y
+    x = mytype(yy, bar)
+    if (allocated (x%a) .or. allocated (x%q)) call abort
+    allocate (yy(2,2))
+    allocate (bar(2))
+    yy = reshape ([10,20,30,40],[2,2])
+    bar = thytype (reshape ([1,2,3,4],[2,2]))
+    ! Check that unallocated allocatables work
+    y = mytype(yy, bar)
+    if (.not.allocated (y%a) .or. .not.allocated (y%q)) call abort
+end program test_constructor
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constructor_6.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_6.f90
new file mode 100644
index 000000000..b2ac4f723
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_6.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! { dg-options "-fdefault-integer-8 -O2" }
+! Tests the fix for PR34143, where the implicit type
+! conversion in the derived type constructor would fail,
+! when 'yy' was not allocated.  The testscase is an
+! extract from alloc_comp_constructor.f90.
+!
+! Reported by Thomas Koenig <tkoenig@gcc.gnu.org>
+!
+Program test_constructor
+    implicit none
+    type :: thytype
+        integer(4) :: a(2,2)
+    end type thytype
+    type :: mytype
+        integer(4), allocatable :: a(:, :)
+        type(thytype), allocatable :: q(:)
+    end type mytype
+    integer, allocatable :: yy(:,:)
+    type (thytype), allocatable :: bar(:)
+    call non_alloc
+    call alloc
+contains
+    subroutine non_alloc
+      type (mytype) :: x
+      x = mytype(yy, bar)
+      if (allocated (x%a) .or. allocated (x%q)) call abort
+    end subroutine non_alloc
+    subroutine alloc
+      type (mytype) :: x
+      allocate (yy(2,2))
+      allocate (bar(2))
+      yy = reshape ([10,20,30,40],[2,2])
+      bar = thytype (reshape ([1,2,3,4],[2,2]))
+      x = mytype(yy, bar)
+      if (.not.allocated (x%a) .or. .not.allocated (x%q)) call abort
+    end subroutine alloc
+end program test_constructor
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_default_init_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_default_init_1.f90
new file mode 100644
index 000000000..48947cd2e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_default_init_1.f90
@@ -0,0 +1,84 @@
+! { dg-do run }
+! Checks the fixes for PR34681 and PR34704, in which various mixtures

+! of default initializer and allocatable array were not being handled

+! correctly for derived types with allocatable components.
+!
+! Contributed by Paolo Giannozzi <p.giannozzi@fisica.uniud.it>
+!
+program boh
+  integer :: c1, c2, c3, c4, c5

+  !

+  call mah (0, c1) ! These calls deal with PR34681

+  call mah (1, c2)

+  call mah (2, c3)

+  !
+  if (c1 /= c2) call abort
+  if (c1 /= c3) call abort

+  !

+  call mah0 (c4) ! These calls deal with PR34704

+  call mah1 (c5)

+  !
+  if (c4 /= c5) call abort
+  !

+end program boh

+!

+subroutine mah (i, c)

+  !

+  integer, intent(in) :: i

+  integer, intent(OUT) :: c

+  !

+  type mix_type

+     real(8), allocatable :: a(:)

+     complex(8), allocatable :: b(:)

+  end type mix_type

+  type(mix_type), allocatable, save :: t(:)

+  integer :: j, n=1024

+  !

+  if (i==0) then

+     allocate (t(1))

+     allocate (t(1)%a(n))

+     allocate (t(1)%b(n))

+     do j=1,n

+        t(1)%a(j) = j

+        t(1)%b(j) = n-j

+     end do

+  end if

+  c = sum( t(1)%a(:) ) + sum( t(1)%b(:) )

+  if ( i==2) then

+     deallocate (t(1)%b)

+     deallocate (t(1)%a)

+     deallocate (t)

+  end if

+end subroutine mah
+
+subroutine mah0 (c)

+  !

+  integer, intent(OUT) :: c

+  type mix_type

+     real(8), allocatable :: a(:)

+     integer :: n=1023

+  end type mix_type

+  type(mix_type) :: t

+  !

+  allocate(t%a(1))

+  t%a=3.1415926

+  c = t%n

+  deallocate(t%a)

+  !

+end subroutine mah0

+!

+subroutine mah1 (c)

+  !

+  integer, intent(OUT) :: c

+  type mix_type

+     real(8), allocatable :: a(:)

+     integer :: n=1023

+  end type mix_type

+  type(mix_type), save :: t

+  !

+  allocate(t%a(1))

+  t%a=3.1415926

+  c = t%n

+  deallocate(t%a)

+  !

+end subroutine mah1

diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_default_init_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_default_init_2.f90
new file mode 100644
index 000000000..db106ccee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_default_init_2.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! Tests the fix for PR35959, in which the structure subpattern was declared static
+! so that this test faied on the second recursive call.
+!
+! Contributed by Michaël Baudin <michael.baudin@gmail.com>
+!
+program testprog
+  type :: t_type
+    integer, dimension(:), allocatable :: chars
+  end type t_type
+  integer, save :: callnb = 0
+  type(t_type) :: this
+  allocate ( this % chars ( 4))
+  if (.not.recursivefunc (this) .or. (callnb .ne. 10)) call abort ()
+contains
+  recursive function recursivefunc ( this ) result ( match )
+    type(t_type), intent(in) :: this
+    type(t_type) :: subpattern
+    logical :: match
+    callnb = callnb + 1
+    match = (callnb == 10)
+    if ((.NOT. allocated (this % chars)) .OR. match) return
+    allocate ( subpattern % chars ( 4 ) )
+    match = recursivefunc ( subpattern )
+  end function recursivefunc
+end program testprog
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_init_expr.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_init_expr.f03
new file mode 100644
index 000000000..02ca7fc4e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_init_expr.f03
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! PR fortran/34402 - allocatable components shall not be
+! data-initialized in init expr
+
+  type t
+    real, allocatable :: x(:)
+  end type
+
+  ! The following is illegal!
+  type (t) :: bad = t ( (/ 1., 3., 5., 7., 9. /) )     ! { dg-error "Invalid initialization expression" }
+
+  ! This is ok
+  type (t) :: ok = t ( NULL() )
+end
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_initializer_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_initializer_1.f90
new file mode 100644
index 000000000..1976509aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_initializer_1.f90
@@ -0,0 +1,71 @@
+! { dg-do run }
+! This checks the correct functioning of derived types with default initializers
+! and allocatable components.
+!
+! Contributed by Salvatore Filippone  <salvatore.filippone@uniroma2.it>
+!
+module p_type_mod
+
+  type m_type
+    integer, allocatable :: p(:)
+  end type m_type
+
+  type basep_type
+    type(m_type), allocatable :: av(:)
+    type(m_type), pointer :: ap => null ()
+    integer :: i = 101
+  end type basep_type
+
+  type p_type
+    type(basep_type), allocatable :: basepv(:)
+    integer :: p1 , p2 = 1
+  end type p_type
+end module p_type_mod
+
+program foo
+ 
+ use p_type_mod
+  implicit none
+
+  type(m_type), target :: a
+  type(p_type) :: pre
+  type(basep_type) :: wee
+
+  call test_ab8 ()
+
+  a = m_type ((/101,102/))  
+
+  call p_bld (a, pre)
+
+  if (associated (wee%ap) .or. wee%i /= 101) call abort ()
+  wee%ap => a
+  if (.not.associated (wee%ap) .or. allocated (wee%av)) call abort ()
+  wee = basep_type ((/m_type ((/201, 202, 203/))/), null (), 99)
+  if (.not.allocated (wee%av) .or. associated (wee%ap) .or. (wee%i .ne. 99)) call abort () 
+
+contains
+
+! Check that allocatable components are nullified after allocation.
+  subroutine test_ab8 ()
+    type(p_type)    :: p
+    integer :: ierr
+  
+    if (.not.allocated(p%basepv)) then 
+      allocate(p%basepv(1),stat=ierr)
+    endif
+    if (allocated (p%basepv) .neqv. .true.) call abort ()
+    if (allocated (p%basepv(1)%av) .neqv. .false.) call abort
+    if (p%basepv(1)%i .ne. 101) call abort ()
+
+  end subroutine test_ab8
+
+    subroutine p_bld (a, p)
+      use p_type_mod
+      type (m_type) :: a
+      type(p_type) :: p
+      if (any (a%p .ne. (/101,102/))) call abort ()
+      if (allocated (p%basepv) .or. (p%p2 .ne. 1)) call abort ()
+    end subroutine p_bld
+
+end program foo
+! { dg-final { cleanup-modules "p_type_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_initializer_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_initializer_2.f90
new file mode 100644
index 000000000..58a0e7463
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_initializer_2.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! Check that default initializer for allocatable components isn't accepted (PR
+! 20541)
+program main
+
+    type :: foo
+        integer, allocatable :: a(:) = [ 1 ] ! { dg-error "Initialization of allocatable" }
+
+        integer :: x ! Just to avoid "extra" error messages about empty type.
+    end type foo
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_initializer_3.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_initializer_3.f90
new file mode 100644
index 000000000..014b069e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_initializer_3.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+! PR fortran/50050
+! Out of bound whilst releasing initialization of allocate object
+!
+! Contributed by someone <sigurdkn@gmail.com>
+
+program bug
+  implicit none
+  type foo
+    integer, pointer :: a => null()
+  end type
+  type(foo), dimension(:,:), allocatable :: data
+  allocate(data(1:1,1)) ! This used to lead to an ICE
+end program
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_misc_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_misc_1.f90
new file mode 100644
index 000000000..e118b0328
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_misc_1.f90
@@ -0,0 +1,28 @@
+! PR 29804
+! This used to fail, it was magically fixed; keep in the testsuite so
+! that we keep an eye on it.
+!
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+program dt_bnd
+  implicit none
+
+  type dbprc_type
+    integer, allocatable          :: ipv(:)
+  end type dbprc_type
+
+  type(dbprc_type), allocatable :: pre(:)
+  call ppset(pre)
+
+contains
+  subroutine ppset(p)
+    type(dbprc_type),allocatable, intent(inout) :: p(:)
+    integer                       :: nl
+    nl = 1
+
+    allocate(p(1))
+    if (.not.allocated(p(nl)%ipv)) then
+      allocate(p(1)%ipv(1))
+    end if
+  end subroutine ppset
+end program dt_bnd
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_optional_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_optional_1.f90
new file mode 100644
index 000000000..be1fa42fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_optional_1.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! Tests the fix for PR38602, a regression caused by a modification
+! to the nulling of INTENT_OUT dummies with allocatable components
+! that caused a segfault with optional arguments.
+!
+! Contributed by David Kinniburgh <davidkinniburgh@yahoo.co.uk>
+!
+program test_iso
+  type ivs
+     character(LEN=1), dimension(:), allocatable :: chars
+  end type ivs
+  type(ivs) :: v_str
+  integer :: i
+  call foo(v_str, i)
+  if (v_str%chars(1) .ne. "a") call abort
+  if (i .ne. 0) call abort
+  call foo(flag = i)
+  if (i .ne. 1) call abort
+contains
+  subroutine foo (arg, flag)
+    type(ivs), optional, intent(out) :: arg
+    integer :: flag
+    if (present(arg)) then
+      arg = ivs([(char(i+96), i = 1,10)])
+      flag = 0
+    else
+      flag = 1
+    end if
+  end subroutine
+end
+
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_result_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_result_1.f90
new file mode 100644
index 000000000..90f6d97fd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_result_1.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! Test the fix for PR38802, in which the nulling of the result 'p'
+! in 'a_fun' would cause a segfault.
+!
+! Posted on the gfortran list by Marco Restelli http://gcc.gnu.org/ml/fortran/2009-01/
+
+!
+module mod_a
+  implicit none
+  public :: a_fun, t_1, t_2
+  private
+  type t_1
+    real :: coeff
+  end type t_1
+  type t_2
+    type(t_1), allocatable :: mons(:)
+  end type t_2
+contains
+  function a_fun(r) result(p)
+    integer, intent(in) :: r
+    type(t_2) :: p(r+1)
+    p = t_2 ([t_1 (99)])
+  end function a_fun
+end module mod_a
+
+program test
+  use mod_a, only: a_fun, t_1, t_2
+  implicit none
+  type(t_2) x(1)
+  x = a_fun(0)
+  if (any (x(1)%mons%coeff .ne. 99)) call abort
+end program test
+! { dg-final { cleanup-modules "mod_a" } }
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90
new file mode 100644
index 000000000..be61f2afb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! Tests the fix for PR40440, in which gfortran tried to deallocate
+! the allocatable components of the actual argument of CALL SUB
+!
+! Contributed by Juergen Reuter <juergen.reuter@desy.de>
+! Reduced testcase from Tobias Burnus  <burnus@gcc.gnu.org> 
+!
+  implicit none
+  type t
+    integer, allocatable :: A(:)
+  end type t
+  type (t) :: arg
+  arg = t ([1,2,3])
+  call sub (func (arg))
+contains
+  function func (a)
+    type(t), pointer :: func
+    type(t), target :: a
+    integer, save :: i = 0
+    if (i /= 0) call abort ! multiple calls would cause this abort
+    i = i + 1
+    func => a
+  end function func
+  subroutine sub (a)
+    type(t), intent(IN), target :: a
+    if (any (a%A .ne. [1,2,3])) call abort
+  end subroutine sub
+end
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_scalar_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_scalar_1.f90
new file mode 100644
index 000000000..82cf71fc4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_scalar_1.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! Test the fix for comment #8 of PR41478, in which copying
+! allocatable scalar components caused a segfault.
+! 
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+program main
+  type :: container_t
+    integer, allocatable :: entry
+  end type container_t
+  type(container_t), dimension(1) :: a1, a2
+  allocate (a1(1)%entry, a2(1)%entry)
+  a2(1)%entry = 1
+  a1(1:1) = pack (a2(1:1), mask = [.true.])
+  deallocate (a2(1)%entry)
+  if (a1(1)%entry .ne. 1) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_std.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_std.f90
new file mode 100644
index 000000000..2ca7f0ac3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_std.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! Check that we don't accept allocatable components for -std=f95 (PR 20541)
+!
+program main
+
+    type :: foo
+        integer, allocatable :: bar(:) ! { dg-error "ALLOCATABLE attribute" }
+
+        integer :: x ! Just to avoid "extra" error messages about empty type.
+    end type foo
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_transformational_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_transformational_1.f90
new file mode 100644
index 000000000..13ee8a88b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_transformational_1.f90
@@ -0,0 +1,80 @@
+! { dg-do run }
+! Tests the fix for PR41478, in which double frees would occur because
+! transformational intrinsics did not copy the allocatable components
+! so that they were (sometimes) freed twice on exit.  In addition,
+! The original allocatable components of a1 were not freed, so that
+! memory leakage occurred.
+!
+! Contributed by Juergen Reuter <reuter@physik.uni-freiburg.de>
+!
+  type :: container_t
+    integer, dimension(:), allocatable :: entry
+    integer index
+  end type container_t
+  call foo
+  call bar
+contains
+!
+! This is the reported problem.
+!
+  subroutine foo
+    type(container_t), dimension(4) :: a1, a2, a3
+    integer :: i
+    do i = 1, 4
+      allocate (a1(i)%entry (2), a2(i)%entry (2), a3(i)%entry (2))
+      a1(i)%entry = [1,2]
+      a2(i)%entry = [3,4]
+      a3(i)%entry = [4,5]
+      a1(i)%index = i
+      a2(i)%index = i
+      a3(i)%index = i
+    end do
+    a1(1:2) = pack (a2, [.true., .false., .true., .false.])
+    do i = 1, 4
+      if (.not.allocated (a1(i)%entry)) call abort
+      if (i .gt. 2) then
+        if (any (a1(i)%entry .ne. [1,2])) call abort
+      else
+        if (any (a1(i)%entry .ne. [3,4])) call abort
+      end if
+    end do
+!
+! Now check unpack
+!
+    a1 = unpack (a1, [.true., .true., .false., .false.], a3)
+    if (any (a1%index .ne. [1,3,3,4])) call abort
+    do i = 1, 4
+      if (.not.allocated (a1(i)%entry)) call abort
+      if (i .gt. 2) then
+        if (any (a1(i)%entry .ne. [4,5])) call abort
+      else
+        if (any (a1(i)%entry .ne. [3,4])) call abort
+      end if
+    end do
+  end subroutine
+!
+! Other all transformational intrinsics display it. Having done
+! PACK and UNPACK, just use TRANSPOSE as a demonstrator.
+!
+  subroutine bar
+    type(container_t), dimension(2,2) :: a1, a2
+    integer :: i, j
+    do i = 1, 2
+      do j = 1, 2
+        allocate (a1(i, j)%entry (2), a2(i, j)%entry (2))
+        a1(i, j)%entry = [i,j]
+        a2(i, j)%entry = [i,j]
+        a1(i,j)%index = j + (i - 1)*2
+        a2(i,j)%index = j + (i - 1)*2
+      end do
+    end do
+    a1 = transpose (a2)
+    do i = 1, 2
+      do j = 1, 2
+        if (a1(i,j)%index .ne. i + (j - 1)*2) call abort
+        if (any (a1(i,j)%entry .ne. [j,i])) call abort
+      end do
+    end do
+  end subroutine
+end
+
diff --git a/gcc/testsuite/gfortran.dg/allocatable_dummy_1.f90 b/gcc/testsuite/gfortran.dg/allocatable_dummy_1.f90
new file mode 100644
index 000000000..9aba8b8fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_dummy_1.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+! Test procedures with allocatable dummy arguments
+program alloc_dummy
+
+    implicit none
+    integer, allocatable :: a(:)
+    integer, allocatable :: b(:)
+
+    call init(a)
+    if (.NOT.allocated(a)) call abort()
+    if (.NOT.all(a == [ 1, 2, 3 ])) call abort()
+
+    call useit(a, b)
+    if (.NOT.all(b == [ 1, 2, 3 ])) call abort()
+
+    if (.NOT.all(whatever(a) == [ 1, 2, 3 ])) call abort()
+
+    call kill(a)
+    if (allocated(a)) call abort()
+
+    call kill(b)
+    if (allocated(b)) call abort()
+
+contains
+
+    subroutine init(x)
+        integer, allocatable, intent(out) :: x(:)
+        allocate(x(3))
+        x = [ 1, 2, 3 ]
+    end subroutine init
+
+    subroutine useit(x, y)
+        integer, allocatable, intent(in)  :: x(:)
+        integer, allocatable, intent(out) :: y(:)
+        if (allocated(y)) call abort()
+        call init(y)
+        y = x
+    end subroutine useit
+
+    function whatever(x)
+        integer, allocatable :: x(:)
+        integer :: whatever(size(x))
+        
+        whatever = x
+    end function whatever
+
+    subroutine kill(x)
+        integer, allocatable, intent(out) :: x(:)
+    end subroutine kill
+
+end program alloc_dummy
diff --git a/gcc/testsuite/gfortran.dg/allocatable_dummy_2.f90 b/gcc/testsuite/gfortran.dg/allocatable_dummy_2.f90
new file mode 100644
index 000000000..1f0864ba3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_dummy_2.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! Check a few constraints for ALLOCATABLE dummy arguments.
+program alloc_dummy
+
+    implicit none
+    integer :: a(5)
+
+    call init(a) ! { dg-error "must be ALLOCATABLE" }
+
+contains
+
+    subroutine init(x)
+        integer, allocatable, intent(out) :: x(:)
+    end subroutine init
+
+    subroutine init2(x)
+        integer, allocatable, intent(in) :: x(:)
+
+        allocate(x(3)) ! { dg-error "variable definition context" }
+    end subroutine init2
+
+    subroutine kill(x)
+        integer, allocatable, intent(in) :: x(:)
+        
+        deallocate(x) ! { dg-error "variable definition context" }
+    end subroutine kill
+
+end program alloc_dummy
diff --git a/gcc/testsuite/gfortran.dg/allocatable_dummy_3.f90 b/gcc/testsuite/gfortran.dg/allocatable_dummy_3.f90
new file mode 100644
index 000000000..d2b4e1eba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_dummy_3.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! PR 28416: Check that allocatable dummies can be passed onwards as non-assumed
+! shape arg.
+program main
+
+    implicit none
+    integer, allocatable :: a(:)
+
+    interface
+        subroutine foo(v_out)
+            integer, allocatable :: v_out(:)
+        end subroutine foo
+    end interface
+
+    call foo(a)
+    if (any(a /= [ 1, 2, 3 ])) call abort()
+
+end program
+
+
+subroutine foo(v_out)
+    implicit none
+    integer, allocatable :: v_out(:)
+
+    allocate(v_out(3))
+    call bar(v_out, size(v_out))
+end subroutine foo
+
+
+subroutine bar(v, N)
+    implicit none
+    integer :: N
+    integer :: v(N)
+    integer :: i
+
+    do i = 1, N
+        v(i) = i
+    end do
+end subroutine bar
diff --git a/gcc/testsuite/gfortran.dg/allocatable_function_1.f90 b/gcc/testsuite/gfortran.dg/allocatable_function_1.f90
new file mode 100644
index 000000000..fc3b983ad
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_function_1.f90
@@ -0,0 +1,112 @@
+! { dg-do run }
+! { dg-options "-O2 -fdump-tree-original" }
+! Test ALLOCATABLE functions; the primary purpose here is to check that
+! each of the various types of reference result in the function result
+! being deallocated, using _gfortran_internal_free.
+! The companion, allocatable_function_1r.f90, executes this program.
+!
+subroutine moobar (a)
+    integer, intent(in) :: a(:)
+
+    if (.not.all(a == [ 1, 2, 3 ])) call abort()
+end subroutine moobar
+
+function foo2 (n)
+    integer, intent(in) :: n
+    integer, allocatable :: foo2(:)
+    integer :: i
+    allocate (foo2(n))
+    do i = 1, n
+        foo2(i) = i
+    end do
+end function foo2
+
+module m
+contains
+    function foo3 (n)
+        integer, intent(in) :: n
+        integer, allocatable :: foo3(:)
+        integer :: i
+        allocate (foo3(n))
+        do i = 1, n
+            foo3(i) = i
+        end do
+    end function foo3
+end module m
+
+program alloc_fun
+
+    use m
+    implicit none
+
+    integer :: a(3)
+
+    interface
+      subroutine moobar (a)
+          integer, intent(in) :: a(:)
+      end subroutine moobar
+    end interface
+
+    interface
+        function foo2 (n)
+            integer, intent(in) :: n
+            integer, allocatable :: foo2(:)
+        end function foo2
+    end interface
+
+! 2 _gfortran_internal_free's
+    if (.not.all(foo1(3) == [ 1, 2, 3 ])) call abort()
+    a = foo1(size(a))
+
+! 1 _gfortran_internal_free
+    if (.not.all(a == [ 1, 2, 3 ])) call abort()
+    call foobar(foo1(3))
+
+! 1 _gfortran_internal_free
+    if (.not.all(2*bar(size(a)) + 5 == [ 7, 9, 11 ])) call abort()
+
+! Although the rhs determines the loop size, the lhs reference is
+! evaluated, in case it has side-effects or is needed for bounds checking.
+! 3 _gfortran_internal_free's
+    a(1:size (bar (3))) = 2*bar(size(a)) + 2 + a(size (bar (3)))
+    if (.not.all(a == [ 7, 9, 11 ])) call abort()
+
+! 3 _gfortran_internal_free's
+    call moobar(foo1(3))   ! internal function
+    call moobar(foo2(3))   ! module function
+    call moobar(foo3(3))   ! explicit interface
+
+! 9 _gfortran_internal_free's in total
+contains
+
+    subroutine foobar (a)
+        integer, intent(in) :: a(:)
+
+        if (.not.all(a == [ 1, 2, 3 ])) call abort()
+    end subroutine foobar
+
+    function foo1 (n)
+        integer, intent(in) :: n
+        integer, allocatable :: foo1(:)
+        integer :: i
+        allocate (foo1(n))
+        do i = 1, n
+            foo1(i) = i
+        end do
+    end function foo1
+
+    function bar (n) result(b)
+        integer, intent(in) :: n
+        integer, target, allocatable :: b(:)
+        integer :: i
+
+        allocate (b(n))
+        do i = 1, n
+            b(i) = i
+        end do
+    end function bar
+
+end program alloc_fun
+! { dg-final { scan-tree-dump-times "free" 10 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/allocatable_function_2.f90 b/gcc/testsuite/gfortran.dg/allocatable_function_2.f90
new file mode 100644
index 000000000..ab26c2a04
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_function_2.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! Test constraints on ALLOCATABLE functions
+program alloc_fun
+
+contains
+
+    elemental function foo (n)
+        integer, intent(in) :: n
+        integer, allocatable :: foo(:) ! { dg-error "ALLOCATABLE .* ELEMENTAL" }
+    end function foo
+
+end program alloc_fun
diff --git a/gcc/testsuite/gfortran.dg/allocatable_function_3.f90 b/gcc/testsuite/gfortran.dg/allocatable_function_3.f90
new file mode 100644
index 000000000..538924f67
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_function_3.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! Tests the fix for PR33986, in which the call to scram would call
+! an ICE because allocatable result actuals had not been catered for.
+!
+!  Contributed by Damian Rouson <damian@rouson.net>
+!
+function transform_to_spectral_from() result(spectral)
+  integer, allocatable :: spectral(:)
+  allocate(spectral(2))
+  call scram(spectral)
+end function transform_to_spectral_from
+
+subroutine scram (x)
+  integer x(2)
+  x = (/1,2/)
+end subroutine
+
+  interface
+    function transform_to_spectral_from() result(spectral)
+      integer, allocatable :: spectral(:)
+    end function transform_to_spectral_from
+  end interface
+  if (any (transform_to_spectral_from () .ne. (/1,2/))) call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/allocatable_function_4.f90 b/gcc/testsuite/gfortran.dg/allocatable_function_4.f90
new file mode 100644
index 000000000..9aff3a85a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_function_4.f90
@@ -0,0 +1,56 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/37626
+! Contributed by Rich Townsend
+!
+! The problem was an ICE when trying to deallocate the
+! result variable "x_unique".
+!
+function unique_A (x, sorted) result (x_unique)
+  implicit none
+  character(*), dimension(:), intent(in)       :: x
+  logical, intent(in), optional                :: sorted
+  character(LEN(x)), dimension(:), allocatable :: x_unique
+
+  logical                                      :: sorted_
+  character(LEN(x)), dimension(SIZE(x))        :: x_sorted
+  integer                                      :: n_x
+  logical, dimension(SIZE(x))                  :: mask
+
+  integer, external                            :: b3ss_index
+
+! Set up sorted_
+
+  if(PRESENT(sorted)) then
+     sorted_ = sorted
+  else
+     sorted_ = .FALSE.
+  endif
+
+! If necessary, sort x
+
+  if(sorted_) then
+     x_sorted = x
+  else
+     x_sorted = x(b3ss_index(x))
+  endif
+
+! Set up the unique array
+
+  n_x = SIZE(x)
+
+  mask = (/.TRUE.,x_sorted(2:n_x) /= x_sorted(1:n_x-1)/)
+
+  allocate(x_unique(COUNT(mask)))
+
+  x_unique = PACK(x_sorted, MASK=mask)
+
+! Finish
+
+  return
+end function unique_A
+
+! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/allocatable_function_5.f90 b/gcc/testsuite/gfortran.dg/allocatable_function_5.f90
new file mode 100644
index 000000000..8e7d49b0f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_function_5.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+! Tests function return of deferred length scalars.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module m
+contains
+  function mfoo (carg) result(res)
+    character (:), allocatable :: res
+    character (*) :: carg
+    res = carg(2:4)
+  end function
+  function mbar (carg)
+    character (:), allocatable :: mbar
+    character (*) :: carg
+    mbar = carg(2:13)
+  end function
+end module
+
+  use m
+  character (:), allocatable :: lhs
+  lhs = foo ("foo calling ")
+  if (lhs .ne. "foo") call abort
+  if (len (lhs) .ne. 3) call abort
+  deallocate (lhs)
+  lhs = bar ("bar calling - baaaa!")
+  if (lhs .ne. "bar calling") call abort
+  if (len (lhs) .ne. 12) call abort
+  deallocate (lhs)
+  lhs = mfoo ("mfoo calling ")
+  if (lhs .ne. "foo") call abort
+  if (len (lhs) .ne. 3) call abort
+  deallocate (lhs)
+  lhs = mbar ("mbar calling - baaaa!")
+  if (lhs .ne. "bar calling") call abort
+  if (len (lhs) .ne. 12) call abort
+contains
+  function foo (carg) result(res)
+    character (:), allocatable :: res
+    character (*) :: carg
+    res = carg(1:3)
+  end function
+  function bar (carg)
+    character (:), allocatable :: bar
+    character (*) :: carg
+    bar = carg(1:12)
+  end function
+end
diff --git a/gcc/testsuite/gfortran.dg/allocatable_module_1.f90 b/gcc/testsuite/gfortran.dg/allocatable_module_1.f90
new file mode 100644
index 000000000..47f10008e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_module_1.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! PR 36934 - this used to give a spurious error and segfault with a
+! patch that wasn't complete
+! Test case contributed by Philip Mason
+
+module fred1
+real, allocatable :: default_clocks(:)
+end module fred1
+
+module fred2
+real, allocatable :: locks(:)
+end module fred2
+
+program fred
+use fred1
+use fred2
+end program fred
+! { dg-final { cleanup-modules "fred1 fred2" } }
diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_1.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_1.f90
new file mode 100644
index 000000000..d83d2f7f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+!
+! PR 40996: [F03] ALLOCATABLE scalars
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+implicit none
+real, allocatable :: scalar
+
+allocate(scalar)
+scalar = exp(1.)
+print *,scalar
+if (.not. allocated(scalar)) call abort()
+deallocate(scalar)
+if (allocated(scalar)) call abort()
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_10.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_10.f90
new file mode 100644
index 000000000..0d3be8845
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_10.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+!
+! PR 42647: Missed initialization/dealloc of allocatable scalar DT with allocatable component
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+type t
+ integer, allocatable :: p
+end type t
+type(t), allocatable :: a
+
+deallocate(a,stat=istat)
+if (istat == 0) call abort()
+end 
diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_11.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_11.f90
new file mode 100644
index 000000000..b9fb10857
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_11.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR fortran/46484
+!
+
+function g()
+  implicit none
+  integer, allocatable :: g
+  call int()
+    print *, loc(g) ! OK
+contains
+  subroutine int()
+    print *, loc(g) ! OK
+    print *, allocated(g) ! OK
+  end subroutine int
+end function
+
+implicit none
+integer, allocatable :: x
+print *, allocated(f) ! { dg-error "must be a variable" }
+print *, loc(f) ! OK
+contains
+function f()
+  integer, allocatable :: f
+  print *, loc(f) ! OK
+  print *, allocated(f) ! OK
+end function
+end
diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_12.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_12.f90
new file mode 100644
index 000000000..eade363ea
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_12.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+!
+! PR fortran/47421
+!
+! Don't auto-deallocatable scalar character allocatables.
+!
+implicit none
+character(len=5), allocatable :: str
+allocate(str)
+str = '1bcde'
+if(str /= '1bcde') call abort()
+call sub(str,len(str))
+if(str /= '1bcde') call abort()
+call subOUT(str,len(str))
+if (len(str) /= 5) call abort()
+if(allocated(str)) call abort()
+contains
+  subroutine sub(x,n)
+     integer :: n
+     character(len=n), allocatable :: x
+     if(len(x) /= 5) call abort()
+     if(x /= '1bcde') call abort()
+  end subroutine sub
+  subroutine subOUT(x,n)
+     integer :: n
+     character(len=n), allocatable,intent(out) :: x
+     if(allocated(x)) call abort()
+     if(len(x) /= 5) call abort()
+  end subroutine subOUT
+end
diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_2.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_2.f90
new file mode 100644
index 000000000..5ad58ca38
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_2.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! Parsing of finalizer procedure definitions.
+! While ALLOCATABLE scalars are not implemented, this even used to ICE.
+! Thanks Tobias Burnus for the test!
+
+integer, allocatable :: x ! { dg-error "may not be ALLOCATABLE" }
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_3.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_3.f90
new file mode 100644
index 000000000..c624de22d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_3.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+!
+! PR 40996: [F03] ALLOCATABLE scalars
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+implicit none
+
+type :: t
+  integer, allocatable :: i
+end type
+
+type(t)::x
+
+allocate(x%i)
+
+x%i = 13
+print *,x%i
+if (.not. allocated(x%i)) call abort()
+
+deallocate(x%i)
+
+if (allocated(x%i)) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_4.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_4.f90
new file mode 100644
index 000000000..9f7a7a07d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_4.f90
@@ -0,0 +1,95 @@
+! { dg-do run }
+!
+! PR fortran/41872
+!
+!
+program test
+  implicit none
+  integer, allocatable :: a
+  integer, allocatable :: b
+  allocate(a)
+  call foo(a)
+  if(.not. allocated(a)) call abort()
+  if (a /= 5) call abort()
+
+  call bar(a)
+  if (a /= 7) call abort()
+
+  deallocate(a)
+  if(allocated(a)) call abort()
+  call check3(a)
+  if(.not. allocated(a)) call abort()
+  if(a /= 6874) call abort()
+  call check4(a)
+  if(.not. allocated(a)) call abort()
+  if(a /= -478) call abort()
+
+  allocate(b)
+  b = 7482
+  call checkOptional(.false.,.true., 7482)
+  if (b /= 7482) call abort()
+  call checkOptional(.true., .true., 7482, b)
+  if (b /= 46) call abort()
+contains
+  subroutine foo(a)
+    integer, allocatable, intent(out)  :: a
+    if(allocated(a)) call abort()
+    allocate(a)
+    a = 5
+  end subroutine foo
+
+  subroutine bar(a)
+    integer, allocatable, intent(inout)  :: a
+    if(.not. allocated(a)) call abort()
+    if (a /= 5) call abort()
+    a = 7
+  end subroutine bar
+
+  subroutine check3(a)
+    integer, allocatable, intent(inout)  :: a
+    if(allocated(a)) call abort()
+    allocate(a)
+    a = 6874
+  end subroutine check3
+
+  subroutine check4(a)
+    integer, allocatable, intent(inout)  :: a
+    if(.not.allocated(a)) call abort()
+    if (a /= 6874) call abort
+    deallocate(a)
+    if(allocated(a)) call abort()
+    allocate(a)
+    if(.not.allocated(a)) call abort()
+    a = -478
+  end subroutine check4
+
+  subroutine checkOptional(prsnt, alloc, val, x)
+    logical, intent(in) :: prsnt, alloc
+    integer, allocatable, optional :: x
+    integer, intent(in) :: val
+    if (present(x) .neqv. prsnt) call abort()
+    if (present(x)) then
+      if (allocated(x) .neqv. alloc) call abort()
+    end if
+    if (present(x)) then
+      if (allocated(x)) then
+        if (x /= val) call abort()
+      end if
+    end if
+    call checkOptional2(x)
+    if (present(x)) then
+      if (.not. allocated(x)) call abort()
+      if (x /= -6784) call abort()
+      x = 46
+    end if
+    call checkOptional2()
+  end subroutine checkOptional
+  subroutine checkOptional2(x)
+    integer, allocatable, optional, intent(out) :: x
+    if (present(x)) then
+      if (allocated(x)) call abort()
+      allocate(x)
+      x = -6784
+    end if
+  end subroutine checkOptional2
+end program test
diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_5.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_5.f90
new file mode 100644
index 000000000..efa40e925
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_5.f90
@@ -0,0 +1,55 @@
+! { dg-do run }
+! { dg-options "-Wall -pedantic" }
+!
+! PR fortran/41872; updated due to PR fortran/46484
+!
+!  More tests for allocatable scalars
+!
+program test
+  implicit none
+  integer, allocatable :: a
+  integer :: b
+
+  if (allocated (a)) call abort ()
+  b = 7
+  b = func(.true.)
+  if (b /= 5332) call abort () 
+  b = 7
+  b = func(.true.) + 1
+  if (b /= 5333) call abort () 
+   
+  call intout (a, .false.)
+  if (allocated (a)) call abort ()
+  call intout (a, .true.)
+  if (.not.allocated (a)) call abort ()
+  if (a /= 764) call abort ()
+  call intout2 (a)
+  if (allocated (a)) call abort ()
+
+contains
+
+  function func (alloc)
+    integer, allocatable ::  func
+    logical :: alloc
+    if (allocated (func)) call abort ()
+    if (alloc) then
+      allocate(func)
+      func = 5332
+    end if
+  end function func
+
+  subroutine intout (dum, alloc)
+    implicit none
+    integer, allocatable,intent(out) :: dum
+    logical :: alloc
+    if (allocated (dum)) call abort()
+    if (alloc) then
+      allocate (dum)
+      dum = 764
+    end if
+  end subroutine intout
+
+  subroutine intout2 (dum) ! { dg-warning "declared INTENT.OUT. but was not set" }
+    integer, allocatable,intent(out) :: dum
+  end subroutine intout2
+end program test
diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_6.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_6.f90
new file mode 100644
index 000000000..33daee4b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_6.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! { dg-options "-Wall -pedantic" }
+!
+! PR fortran/41872
+!
+!  (De)allocate tests
+!
+program test
+  implicit none
+  integer, allocatable :: a, b, c
+  integer :: stat
+  stat=99
+  allocate(a, stat=stat)
+  if (stat /= 0) call abort ()
+  allocate(a, stat=stat)
+  if (stat == 0) call abort ()
+
+  allocate (b)
+  deallocate (b, stat=stat)
+  if (stat /= 0) call abort ()
+  deallocate (b, stat=stat)
+  if (stat == 0) call abort ()
+
+  deallocate (c, stat=stat)
+  if (stat == 0) call abort ()
+end program test
diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_7.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_7.f90
new file mode 100644
index 000000000..001dd241b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_7.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+!
+! PR fortran/41872
+!
+! Allocatable scalars with SAVE
+!
+program test
+  implicit none
+  call sub (0)
+  call sub (1)
+  call sub (2)
+contains
+  subroutine sub (no)
+    integer, intent(in) :: no
+    integer, allocatable, save :: a
+    if (no == 0) then
+      if (allocated (a)) call abort ()
+      allocate (a)
+    else if (no == 1) then
+      if (.not. allocated (a)) call abort ()
+      deallocate (a)
+    else
+      if (allocated (a)) call abort ()
+    end if
+  end subroutine sub
+end program test
diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_8.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_8.f90
new file mode 100644
index 000000000..f7940ede5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_8.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+!
+! PR fortran/41872
+!
+! Character functions returning allocatable scalars
+!
+program test
+  implicit none
+  if (func () /= 'abc') call abort ()
+contains
+  function func() result (str)
+    character(len=3), allocatable :: str
+    if (allocated (str)) call abort ()
+    allocate (str)
+    str = 'abc'
+  end function func
+end program test
diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_9.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_9.f90
new file mode 100644
index 000000000..fef9b0532
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_9.f90
@@ -0,0 +1,55 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+!
+! PR 42647: Missed initialization/dealloc of allocatable scalar DT with allocatable component
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+module m                                                                        
+type st                                                                         
+  integer , allocatable :: a1                                                   
+end type st                                                                     
+type at                                                                         
+  integer , allocatable :: a2(:)                                                
+end type at                                                                     
+
+type t1
+  type(st), allocatable :: b1
+end type t1
+type t2
+  type(st), allocatable :: b2(:)
+end type t2
+type t3
+  type(at), allocatable :: b3
+end type t3
+type t4
+  type(at), allocatable :: b4(:)
+end type t4
+end module m
+
+use m
+type(t1) :: na1, a1, aa1(:)
+type(t2) :: na2, a2, aa2(:)
+type(t3) :: na3, a3, aa3(:)
+type(t4) :: na4, a4, aa4(:)
+allocatable :: a1, a2, a3, a4, aa1, aa2, aa3,aa4
+
+if(allocated(a1)) call abort()
+if(allocated(a2)) call abort()
+if(allocated(a3)) call abort()
+if(allocated(a4)) call abort()
+if(allocated(aa1)) call abort()
+if(allocated(aa2)) call abort()
+if(allocated(aa3)) call abort()
+if(allocated(aa4)) call abort()
+
+if(allocated(na1%b1)) call abort()
+if(allocated(na2%b2)) call abort()
+if(allocated(na3%b3)) call abort()
+if(allocated(na4%b4)) call abort()
+end
+
+! { dg-final { scan-tree-dump-times "__builtin_free" 38 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90
new file mode 100644
index 000000000..52e0262f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_1.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+program a
+
+  implicit none
+
+  real x
+  integer j, k, n(4)
+  character(len=70) err
+  character(len=70), allocatable :: error(:)
+
+  integer, allocatable :: i(:)
+
+  type b
+    integer, allocatable :: c(:), d(:)
+  end type b
+
+  type(b) e, f(3)
+
+  allocate(i(2), stat=x) ! { dg-error "must be a scalar INTEGER" }
+  allocate(i(2), stat=j, stat=k) ! { dg-error "Redundant STAT" }
+  allocate(i(2))
+  allocate(i(2))) ! { dg-error "Syntax error in ALLOCATE" }
+  allocate(i(2), errmsg=err, errmsg=err) ! { dg-error "Redundant ERRMSG" }
+  allocate(i(2), errmsg=err) ! { dg-warning "useless without a STAT" }
+  allocate(i(2), stat=j, errmsg=x) ! { dg-error "must be a scalar CHARACTER" }
+
+  allocate(err) ! { dg-error "nonprocedure pointer or an allocatable" }
+
+  allocate(error(2),stat=j,errmsg=error(1)) ! { dg-error "shall not be ALLOCATEd within" }
+  allocate(i(2), stat = i(1))  ! { dg-error "shall not be ALLOCATEd within" }
+
+  allocate(n) ! { dg-error "must be ALLOCATABLE or a POINTER" }
+
+  allocate(i(2), i(2)) ! { dg-error "Allocate-object at" }
+
+  ! These should not fail the check for duplicate alloc-objects.
+  allocate(f(1)%c(2), f(2)%d(2))
+  allocate(e%c(2), e%d(2))
+
+end program a
diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_10.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_10.f90
new file mode 100644
index 000000000..f5dae1ac6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_10.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+!
+! PR 43388: [F2008][OOP] ALLOCATE with MOLD=
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+type :: t1
+  integer :: i
+end type
+
+type,extends(t1) :: t2
+  integer :: j = 4
+end type
+
+class(t1),allocatable :: x,y
+type(t2) :: z
+
+
+!!! first example (static)
+
+z%j = 5
+allocate(x,MOLD=z)
+
+select type (x)
+type is (t2)
+  print *,x%j
+  if (x%j/=4) call abort
+  x%j = 5
+class default
+  call abort()
+end select
+
+
+!!! second example (dynamic, PR 44541)
+
+allocate(y,MOLD=x)
+
+select type (y)
+type is (t2)
+  print *,y%j
+  if (y%j/=4) call abort
+class default
+  call abort()
+end select
+
+end
diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_11.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_11.f90
new file mode 100644
index 000000000..c8c7ac633
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_11.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+!
+! PR fortran/44556
+!
+! Contributed by Jonathan Hogg and Steve Kargl.
+!
+program oh_my
+   implicit none
+   type a
+      integer, allocatable :: b(:), d(:)
+      character(len=80) :: err
+      character(len=80), allocatable :: str(:)
+      integer :: src
+   end type a
+
+   integer j
+   type(a) :: c
+   c%err = 'ok'
+   allocate(c%d(1)) 
+   allocate(c%b(2), errmsg=c%err, stat=c%d(1)) ! OK
+   deallocate(c%b, errmsg=c%err, stat=c%d(1))  ! OK
+   allocate(c%b(2), errmsg=c%err, stat=c%b(1)) ! { dg-error "the same ALLOCATE statement" }
+   deallocate(c%b, errmsg=c%err, stat=c%b(1))  ! { dg-error "the same DEALLOCATE statement" }
+   allocate(c%str(2), errmsg=c%str(1), stat=j) ! { dg-error "the same ALLOCATE statement" }
+   deallocate(c%str, errmsg=c%str(1), stat=j)  ! { dg-error "the same DEALLOCATE statement" }
+end program oh_my
diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_12.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_12.f90
new file mode 100644
index 000000000..2af069293
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_12.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! PR 45507: [4.6 Regression] Bogus Error: Can't convert TYPE(c_ptr) to INTEGER(4)
+!
+! Contributed by Andrew Benson <abenson@its.caltech.edu>
+
+ use, intrinsic :: iso_c_binding
+
+ type :: cType
+   type(c_ptr) :: accelPtr = c_null_ptr
+ end type cType
+
+ type(cType), allocatable, dimension(:) :: filters
+ class(cType), allocatable :: f
+
+ allocate(filters(1))
+ allocate(f,MOLD=filters(1))
+
+end
diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_2.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_2.f90
new file mode 100644
index 000000000..a52b71e49
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_2.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+subroutine sub(i, j, err)
+   implicit none
+   character(len=*), intent(in) :: err
+   integer, intent(in) :: j
+   integer, intent(in), allocatable :: i(:)
+   integer, allocatable :: m(:)
+   integer n
+   allocate(i(2)) ! { dg-error "variable definition context" }
+   allocate(m(2), stat=j) ! { dg-error "variable definition context" }
+   allocate(m(2),stat=n,errmsg=err) ! { dg-error "variable definition context" }
+end subroutine sub
diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_3.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_3.f90
new file mode 100644
index 000000000..d8c177f11
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_3.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+program a
+
+  implicit none
+
+  integer n
+  character(len=70) e1
+  character(len=30) e2
+  integer, allocatable :: i(:)
+
+  e1 = 'No error'
+  allocate(i(4), stat=n, errmsg=e1)
+  if (trim(e1) /= 'No error') call abort
+  deallocate(i)
+
+  e2 = 'No error'
+  allocate(i(4),stat=n, errmsg=e2)
+  if (trim(e2) /= 'No error') call abort
+  deallocate(i)
+
+
+  e1 = 'No error'
+  allocate(i(4), stat=n, errmsg=e1)
+  allocate(i(4), stat=n, errmsg=e1)
+  if (trim(e1) /= 'Attempt to allocate an allocated object') call abort
+  deallocate(i)
+
+  e2 = 'No error'
+  allocate(i(4), stat=n, errmsg=e2)
+  allocate(i(4), stat=n, errmsg=e2)
+  if (trim(e2) /= 'Attempt to allocate an allocat') call abort
+
+end program a
diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_4.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_4.f90
new file mode 100644
index 000000000..89052ef16
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_4.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+program a
+
+  implicit none
+
+  integer n, m(3,3)
+  integer(kind=8) k
+  integer, allocatable :: i(:), j(:)
+  real, allocatable :: x(:)
+
+  n = 42
+  m = n
+  k = 1_8
+
+  allocate(i(4), source=42, source=n) ! { dg-error "Redundant SOURCE tag found" }
+
+  allocate(integer(4) :: i(4), source=n) ! { dg-error "conflicts with the typespec" }
+
+  allocate(i(4), j(n), source=n) ! { dg-error "requires only a single entity" }
+
+  allocate(x(4), source=n) ! { dg-error "type incompatible with" }
+
+  allocate(i(4), source=m) ! { dg-error "must be scalar or have the same rank" }
+
+  allocate(i(4), source=k) ! { dg-error "shall have the same kind type" }
+
+end program a
diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_5.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_5.f90
new file mode 100644
index 000000000..d7e3ea93f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_5.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+program a
+
+  implicit none
+
+  integer n
+  character(len=70) str
+  integer, allocatable :: i(:)
+
+  n = 42
+  allocate(i(4), source=n) ! { dg-error "Fortran 2003: SOURCE tag" }
+  allocate(i(4), stat=n, errmsg=str) ! { dg-error "Fortran 2003: ERRMSG tag" }
+
+end program a
diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_6.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_6.f90
new file mode 100644
index 000000000..d470b424a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_6.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+program a
+
+  implicit none
+
+  type :: mytype
+    real ::  r
+    integer :: i
+  end type mytype
+  
+  integer n
+  integer, allocatable :: i(:)
+  real z
+  real, allocatable :: x(:)
+  type(mytype), pointer :: t
+
+  n = 42
+  z = 99.
+
+  allocate(i(4), source=n)
+  if (any(i /= 42)) call abort
+
+  allocate(x(4), source=z)
+  if (any(x /= 99.)) call abort
+
+  allocate(t, source=mytype(1.0,2))
+  if (t%r /= 1. .or. t%i /= 2) call abort
+
+  deallocate(i)
+  allocate(i(3), source=(/1, 2, 3/))
+  if (i(1) /= 1 .or. i(2) /= 2 .or. i(3) /= 3) call abort
+
+  call sub1(i)
+
+end program a
+
+subroutine sub1(j)
+   integer, intent(in) :: j(*)
+   integer, allocatable :: k(:)
+   allocate(k(2), source=j(1:2))
+   if (k(1) /= 1 .or. k(2) /= 2) call abort
+end subroutine sub1
diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_7.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_7.f90
new file mode 100644
index 000000000..e77f6b7c6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_7.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+!
+! PR 44207: ICE with ALLOCATABLE components and SOURCE
+!
+! Contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
+
+program ice_prog
+
+type::ice_type
+  integer,dimension(:),allocatable::list
+end type ice_type
+
+type(ice_type)::this
+integer::dim=10,i
+
+allocate(this%list(dim),source=[(i,i=1,dim)])
+
+end program ice_prog
diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_8.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_8.f90
new file mode 100644
index 000000000..39aa3638b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_8.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR 43388: [F2008][OOP] ALLOCATE with MOLD=
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+type :: t
+end type
+
+class(t),allocatable :: x
+type(t) :: z
+
+allocate(x,MOLD=z)  ! { dg-error "MOLD tag at" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_9.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_9.f90
new file mode 100644
index 000000000..e51a7ec86
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_9.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+! PR 43388: [F2008][OOP] ALLOCATE with MOLD=
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+type :: t
+end type
+
+type :: u
+end type
+
+class(t),allocatable :: x
+type(t) :: z1,z2
+type(u) :: z3
+
+allocate(x,MOLD=z1,MOLD=z2)    ! { dg-error "Redundant MOLD tag" }
+allocate(x,SOURCE=z1,MOLD=z2)  ! { dg-error "conflicts with SOURCE tag" }
+allocate(t::x,MOLD=z1)         ! { dg-error "conflicts with the typespec" }
+
+allocate(x,MOLD=z3)            ! { dg-error "is type incompatible" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/allocate_char_star_scalar_1.f90 b/gcc/testsuite/gfortran.dg/allocate_char_star_scalar_1.f90
new file mode 100644
index 000000000..7e6d7d1f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_char_star_scalar_1.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! Tests the patch for PR26038 that used to ICE in gfc_trans_allocate
+! for the want of a string_length to pass to the library.
+! Contributed by hjl@lucon.org && Erik Edelmann  <eedelmanncc.gnu.org>
+module moo
+
+contains
+
+    subroutine foo(self)
+        character(*) :: self
+        pointer :: self
+
+        nullify(self)
+        allocate(self)          ! Used to ICE here
+        print *, len(self)
+    end subroutine
+
+end module moo
+
+
+program hum
+
+    use moo
+
+    character(5), pointer :: p
+    character(10), pointer :: q
+
+    call foo(p)
+    call foo(q)
+
+end program hum
+
+! { dg-final { cleanup-modules "moo" } }
diff --git a/gcc/testsuite/gfortran.dg/allocate_class_1.f90 b/gcc/testsuite/gfortran.dg/allocate_class_1.f90
new file mode 100644
index 000000000..1dea056b7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_class_1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! PR 47085: [OOP] Problem in allocate( SOURCE=) for polymorphic component
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+ type :: t0
+ end type
+ class(t0) :: x  ! { dg-error "must be dummy, allocatable or pointer" }
+ allocate(x)     ! { dg-error "is not a nonprocedure pointer or an allocatable variable" }
+ end
diff --git a/gcc/testsuite/gfortran.dg/allocate_deferred_char_scalar_1.f03 b/gcc/testsuite/gfortran.dg/allocate_deferred_char_scalar_1.f03
new file mode 100644
index 000000000..b9b704014
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_deferred_char_scalar_1.f03
@@ -0,0 +1,267 @@
+! { dg-do run }
+!
+! Automatic reallocate on assignment, deferred length parameter for char
+!
+! PR fortran/45170
+! PR fortran/35810
+! PR fortran/47350
+!
+! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+program test
+  implicit none
+  call mold_check()
+  call mold_check4()
+  call source_check()
+  call source_check4()
+  call ftn_test()
+  call ftn_test4()
+  call source3()
+contains
+  subroutine source_check()
+    character(len=:), allocatable :: str, str2
+    target :: str
+    character(len=8) :: str3
+    character(len=:), pointer :: str4, str5
+    nullify(str4)
+    str3 = 'AbCdEfGhIj'
+    if(allocated(str)) call abort()
+    allocate(str, source=str3)
+    if(.not.allocated(str)) call abort()
+    if(len(str) /= 8) call abort()
+    if(str /= 'AbCdEfGh') call abort()
+    if(associated(str4)) call abort()
+    str4 => str
+    if(str4 /= str .or. len(str4)/=8) call abort()
+    if(.not.associated(str4, str)) call abort()
+    str4 => null()
+    str = '12a56b78'
+    if(str4 == '12a56b78') call abort()
+    str4 = 'ABCDEFGH'
+    if(str == 'ABCDEFGH') call abort()
+    allocate(str5, source=str)
+    if(associated(str5, str)) call abort()
+    if(str5 /= '12a56b78' .or. len(str5)/=8) call abort()
+    str = 'abcdef'
+    if(str5 == 'abcdef') call abort()
+    str5 = 'ABCDEF'
+    if(str == 'ABCDEF') call abort()
+  end subroutine source_check
+  subroutine source_check4()
+    character(kind=4,len=:), allocatable :: str, str2
+    target :: str
+    character(kind=4,len=8) :: str3
+    character(kind=4,len=:), pointer :: str4, str5
+    nullify(str4)
+    str3 = 4_'AbCdEfGhIj'
+    if(allocated(str)) call abort()
+    allocate(str, source=str3)
+    if(.not.allocated(str)) call abort()
+    if(len(str) /= 8) call abort()
+    if(str /= 4_'AbCdEfGh') call abort()
+    if(associated(str4)) call abort()
+    str4 => str
+    if(str4 /= str .or. len(str4)/=8) call abort()
+    if(.not.associated(str4, str)) call abort()
+    str4 => null()
+    str = 4_'12a56b78'
+    if(str4 == 4_'12a56b78') call abort()
+    str4 = 4_'ABCDEFGH'
+    if(str == 4_'ABCDEFGH') call abort()
+    allocate(str5, source=str)
+    if(associated(str5, str)) call abort()
+    if(str5 /= 4_'12a56b78' .or. len(str5)/=8) call abort()
+    str = 4_'abcdef'
+    if(str5 == 4_'abcdef') call abort()
+    str5 = 4_'ABCDEF'
+    if(str == 4_'ABCDEF') call abort()
+  end subroutine source_check4
+  subroutine mold_check()
+    character(len=:), allocatable :: str, str2
+    character(len=8) :: str3
+    character(len=:), pointer :: str4, str5
+    nullify(str4)
+    str2 = "ABCE"
+    ALLOCATE( str, MOLD=str3)
+    if (len(str) /= 8) call abort()
+    DEALLOCATE(str)
+    ALLOCATE( str, MOLD=str2)
+    if (len(str) /= 4) call abort()
+
+    IF (associated(str4)) call abort()
+    ALLOCATE( str4, MOLD=str3)
+    IF (.not.associated(str4)) call abort()
+    str4 = '12345678'
+    if (len(str4) /= 8) call abort()
+    if(str4 /= '12345678') call abort()
+    DEALLOCATE(str4)
+    ALLOCATE( str4, MOLD=str2)
+    str4 = 'ABCD'
+    if (len(str4) /= 4) call abort()
+    if (str4 /= 'ABCD') call abort()
+    str5 => str4
+    if(.not.associated(str4,str5)) call abort()
+    if(len(str5) /= 4 .or. len(str4) /= len(str5)) call abort()
+    if(str5 /= str4) call abort()
+    deallocate(str4) 
+  end subroutine mold_check
+  subroutine mold_check4()
+    character(len=:,kind=4), allocatable :: str, str2
+    character(len=8,kind=4) :: str3
+    character(len=:,kind=4), pointer :: str4, str5
+    nullify(str4)
+    str2 = 4_"ABCE"
+    ALLOCATE( str, MOLD=str3)
+    if (len(str) /= 8) call abort()
+    DEALLOCATE(str)
+    ALLOCATE( str, MOLD=str2)
+    if (len(str) /= 4) call abort()
+
+    IF (associated(str4)) call abort()
+    ALLOCATE( str4, MOLD=str3)
+    IF (.not.associated(str4)) call abort()
+    str4 = 4_'12345678'
+    if (len(str4) /= 8) call abort()
+    if(str4 /= 4_'12345678') call abort()
+    DEALLOCATE(str4)
+    ALLOCATE( str4, MOLD=str2)
+    str4 = 4_'ABCD'
+    if (len(str4) /= 4) call abort()
+    if (str4 /= 4_'ABCD') call abort()
+    str5 => str4
+    if(.not.associated(str4,str5)) call abort()
+    if(len(str5) /= 4 .or. len(str4) /= len(str5)) call abort()
+    if(str5 /= str4) call abort()
+    deallocate(str4) 
+  end subroutine mold_check4
+  subroutine ftn_test()
+    character(len=:), allocatable :: str_a
+    character(len=:), pointer     :: str_p
+    nullify(str_p) 
+    call proc_test(str_a, str_p, .false.)
+    if (str_p /= '123457890abcdef') call abort()
+    if (len(str_p) /= 50) call abort()
+    if (str_a(1:5) /= 'ABCDE ') call abort()
+    if (len(str_a) /= 50) call abort()
+    deallocate(str_p)
+    str_a = '1245'
+    if(len(str_a) /= 4) call abort()
+    if(str_a /= '1245') call abort()
+    allocate(character(len=6) :: str_p)
+    if(len(str_p) /= 6) call abort()
+    str_p = 'AbCdEf'
+    call proc_test(str_a, str_p, .true.)
+    if (str_p /= '123457890abcdef') call abort()
+    if (len(str_p) /= 50) call abort()
+    if (str_a(1:5) /= 'ABCDE ') call abort()
+    if (len(str_a) /= 50) call abort()
+    deallocate(str_p)
+  end subroutine ftn_test
+  subroutine proc_test(a, p, alloc)
+    character(len=:), allocatable :: a
+    character(len=:), pointer     :: p
+    character(len=5), target :: loc
+    logical :: alloc
+    if (.not.  alloc) then
+      if(associated(p)) call abort()
+      if(allocated(a)) call abort()
+    else
+      if(len(a) /= 4) call abort()
+      if(a /= '1245') call abort()
+      if(len(p) /= 6) call abort()
+      if(p /= 'AbCdEf') call abort()
+      deallocate(a)
+      nullify(p)
+    end if
+    allocate(character(len=50) :: a)
+    a(1:5) = 'ABCDE'
+    if(len(a) /= 50) call abort()
+    if(a(1:5) /= "ABCDE") call abort()
+    loc = '12345'
+    p => loc
+    if (len(p) /= 5) call abort()
+    if (p /= '12345') call abort()
+    p = '12345679'
+    if (len(p) /= 5) call abort()
+    if (p /= '12345') call abort()
+    p = 'ABC'
+    if (loc /= 'ABC  ') call abort()
+    allocate(p, mold=a)
+    if (.not.associated(p)) call abort()
+    p = '123457890abcdef'
+    if (p /= '123457890abcdef') call abort()
+    if (len(p) /= 50) call abort()
+  end subroutine proc_test
+  subroutine ftn_test4()
+    character(len=:,kind=4), allocatable :: str_a
+    character(len=:,kind=4), pointer     :: str_p
+    nullify(str_p) 
+    call proc_test4(str_a, str_p, .false.)
+    if (str_p /= 4_'123457890abcdef') call abort()
+    if (len(str_p) /= 50) call abort()
+    if (str_a(1:5) /= 4_'ABCDE ') call abort()
+    if (len(str_a) /= 50) call abort()
+    deallocate(str_p)
+    str_a = 4_'1245'
+    if(len(str_a) /= 4) call abort()
+    if(str_a /= 4_'1245') call abort()
+    allocate(character(len=6, kind = 4) :: str_p)
+    if(len(str_p) /= 6) call abort()
+    str_p = 4_'AbCdEf'
+    call proc_test4(str_a, str_p, .true.)
+    if (str_p /= 4_'123457890abcdef') call abort()
+    if (len(str_p) /= 50) call abort()
+    if (str_a(1:5) /= 4_'ABCDE ') call abort()
+    if (len(str_a) /= 50) call abort()
+    deallocate(str_p)
+  end subroutine ftn_test4
+  subroutine proc_test4(a, p, alloc)
+    character(len=:,kind=4), allocatable :: a
+    character(len=:,kind=4), pointer     :: p
+    character(len=5,kind=4), target :: loc
+    logical :: alloc
+    if (.not.  alloc) then
+      if(associated(p)) call abort()
+      if(allocated(a)) call abort()
+    else
+      if(len(a) /= 4) call abort()
+      if(a /= 4_'1245') call abort()
+      if(len(p) /= 6) call abort()
+      if(p /= 4_'AbCdEf') call abort()
+      deallocate(a)
+      nullify(p)
+    end if
+    allocate(character(len=50,kind=4) :: a)
+    a(1:5) = 4_'ABCDE'
+    if(len(a) /= 50) call abort()
+    if(a(1:5) /= 4_"ABCDE") call abort()
+    loc = '12345'
+    p => loc
+    if (len(p) /= 5) call abort()
+    if (p /= 4_'12345') call abort()
+    p = 4_'12345679'
+    if (len(p) /= 5) call abort()
+    if (p /= 4_'12345') call abort()
+    p = 4_'ABC'
+    if (loc /= 4_'ABC  ') call abort()
+    allocate(p, mold=a)
+    if (.not.associated(p)) call abort()
+    p = 4_'123457890abcdef'
+    if (p /= 4_'123457890abcdef') call abort()
+    if (len(p) /= 50) call abort()
+  end subroutine proc_test4
+  subroutine source3()
+     character(len=:, kind=1), allocatable :: a1
+     character(len=:, kind=4), allocatable :: a4
+     character(len=:, kind=1), pointer     :: p1
+     character(len=:, kind=4), pointer     :: p4
+     allocate(a1, source='ABC') ! << ICE
+     if(len(a1) /= 3 .or. a1 /= 'ABC') call abort()
+     allocate(a4, source=4_'12345') ! << ICE
+     if(len(a4) /= 5 .or. a4 /= 4_'12345') call abort()
+     allocate(p1, mold='AB') ! << ICE
+     if(len(p1) /= 2) call abort()
+     allocate(p4, mold=4_'145') ! << ICE
+     if(len(p4) /= 3) call abort()
+  end subroutine source3
+end program test
diff --git a/gcc/testsuite/gfortran.dg/allocate_deferred_char_scalar_2.f03 b/gcc/testsuite/gfortran.dg/allocate_deferred_char_scalar_2.f03
new file mode 100644
index 000000000..1f0f43301
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_deferred_char_scalar_2.f03
@@ -0,0 +1,21 @@
+! { dg-do run }
+! Test the fix for PR47519, in which the character length was not
+! calculated for the SOURCE expressions below and an ICE resulted. 
+!
+! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+program note7_35
+   implicit none
+   character(:), allocatable :: name
+   character(:), allocatable :: src
+   integer n
+   n = 10
+   allocate(name, SOURCE=repeat('x',n))
+   if (name .ne. 'xxxxxxxxxx') call abort
+   if (len (name) .ne. 10 ) call abort
+   deallocate(name)
+   src = 'xyxy'
+   allocate(name, SOURCE=repeat(src,n))
+   if (name(37:40) .ne. 'xyxy') call abort
+   if (len (name) .ne. 40 ) call abort
+end program note7_35
diff --git a/gcc/testsuite/gfortran.dg/allocate_derived_1.f90 b/gcc/testsuite/gfortran.dg/allocate_derived_1.f90
new file mode 100644
index 000000000..648012431
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_derived_1.f90
@@ -0,0 +1,51 @@
+! { dg-do compile }
+!
+! ALLOCATE statements with derived type specification
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+ type :: t1
+  integer :: i
+ end type
+
+ type, extends(t1) :: t2
+  real :: r
+ end type
+
+ type, extends(t2) :: t3
+  real :: q
+ end type
+
+ type, abstract :: u0
+  logical :: nothing
+ end type
+
+ type :: v1
+  real :: r
+ end type
+
+! FIXME: uncomment and dejagnuify the lines below once class arrays are enabled
+!  class(t1),dimension(:),allocatable :: x
+ type(t2),dimension(:),allocatable :: y
+!  class(t3),dimension(:),allocatable :: z
+
+!  allocate(      x(1))
+!  allocate(t1 :: x(2))
+!  allocate(t2 :: x(3))
+!  allocate(t3 :: x(4))
+!  allocate(tx :: x(5))  ! { "Error in type-spec at" }
+!  allocate(u0 :: x(6))  ! { "may not be ABSTRACT" }
+!  allocate(v1 :: x(7))  ! { "is type incompatible with typespec" }
+
+ allocate(      y(1))
+ allocate(t1 :: y(2))  ! { dg-error "is type incompatible with typespec" }
+ allocate(t2 :: y(3))
+ allocate(t3 :: y(3))  ! { dg-error "is type incompatible with typespec" }
+
+!  allocate(      z(1))
+!  allocate(t1 :: z(2))  ! { "is type incompatible with typespec" }
+!  allocate(t2 :: z(3))  ! { "is type incompatible with typespec" }
+!  allocate(t3 :: z(4))
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/allocate_derived_2.f90 b/gcc/testsuite/gfortran.dg/allocate_derived_2.f90
new file mode 100644
index 000000000..8d01224f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_derived_2.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+!
+! PR 42888: [4.5 Regression] ICE in fold_convert_loc, at fold-const.c:2670
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+
+  implicit none
+
+  type t
+     integer :: X = -999.0   ! Real initializer!
+  end type t
+
+  type(t), allocatable :: x
+  class(t), allocatable :: y,z
+
+  allocate (x)
+  allocate (y)
+  allocate (t::z)
+
+end
diff --git a/gcc/testsuite/gfortran.dg/allocate_derived_3.f90 b/gcc/testsuite/gfortran.dg/allocate_derived_3.f90
new file mode 100644
index 000000000..0cd15118e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_derived_3.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+!
+! PR 44929: [OOP] Parsing error of derived type name starting with 'REAL'
+!
+! Contributed by Satish.BD <bdsatish@gmail.com>
+
+ type :: real_type
+ end type
+ class(real_type), allocatable :: obj
+ real(8), allocatable :: r8
+
+ allocate(real_type :: obj)
+
+ allocate( real(kind=8) :: r8)
+ allocate(real(8)  :: r8 )
+
+end 
diff --git a/gcc/testsuite/gfortran.dg/allocate_derived_4.f90 b/gcc/testsuite/gfortran.dg/allocate_derived_4.f90
new file mode 100644
index 000000000..06d127004
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_derived_4.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! PR 45577: [4.6 Regression] Bogus(?) "... type incompatible with source-expr ..." error
+!
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+
+program main
+
+type b_obj
+  integer,allocatable :: c(:)
+  real :: r = 5.
+end type b_obj
+
+type (b_obj),allocatable :: b(:)
+integer,allocatable :: c(:)
+
+allocate(b(3),c(3))
+
+end program main 
diff --git a/gcc/testsuite/gfortran.dg/allocate_derived_5.f90 b/gcc/testsuite/gfortran.dg/allocate_derived_5.f90
new file mode 100644
index 000000000..70d63aa1a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_derived_5.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+!
+! PR 45828: [4.6 Regression] No default initialization of derived type members?
+!
+! Contributed by Juha <jpr@csc.fi>
+
+program fail1
+   type a
+      integer :: i
+   end type a
+
+   type b
+     type(a) :: acomp = a(5)
+   end type b
+
+   type(b), allocatable :: c(:)
+
+   allocate(c(1))
+   if (c(1) % acomp % i /= 5) call abort()
+end program fail1
diff --git a/gcc/testsuite/gfortran.dg/allocate_error_1.f90 b/gcc/testsuite/gfortran.dg/allocate_error_1.f90
new file mode 100644
index 000000000..42a12159e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_error_1.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! { dg-shouldfail "runtime error" }
+! { dg-output "At line 13.*Attempting to allocate .* 'arr'" }
+
+! PR fortran/37507
+! Check that locus is printed for ALLOCATE errors.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER, ALLOCATABLE :: arr(:)
+
+  ALLOCATE (arr(5))
+  ALLOCATE (arr(6))
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/allocate_error_2.f90 b/gcc/testsuite/gfortran.dg/allocate_error_2.f90
new file mode 100644
index 000000000..1a301de8f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_error_2.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+program main
+  type t1
+     integer, allocatable :: x(:)
+     integer, allocatable :: y(:)
+  end type t1
+  type(t1), allocatable :: v(:)
+  allocate (v(3), v(4))  ! { dg-error "Allocate-object at \\(1\\) also appears at \\(2\\)" }
+  allocate (v(1), v(1)%x(2)) ! { dg-error "Allocate-object at \\(1\\) is subobject of object at \\(2\\)" }
+  allocate (v(1)%x(2), v(1)) ! { dg-error "Allocate-object at \\(1\\) is subobject of object at \\(2\\)" }
+  allocate (v(1)%y(2), v(1)%x(1))
+  allocate (v(2)%x(3), v(2)%x(3)) ! { dg-error "Allocate-object at \\(1\\) also appears at \\(2\\)" }
+  allocate (v(1)%x(3), v(2)%x(3))
+  deallocate (v, v)  ! { dg-error "Allocate-object at \\(1\\) also appears at \\(2\\)" }
+  deallocate (v, v(1)%x) ! { dg-error "Allocate-object at \\(1\\) is subobject of object at \\(2\\)" }
+  deallocate (v(1)%x, v) ! { dg-error "Allocate-object at \\(1\\) is subobject of object at \\(2\\)" }
+  deallocate (v(1)%y, v(1)%x)
+  deallocate (v(2)%x, v(2)%x) ! { dg-error "Allocate-object at \\(1\\) also appears at \\(2\\)" }
+  deallocate (v(1)%x, v(2)%x)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/allocate_error_3.f90 b/gcc/testsuite/gfortran.dg/allocate_error_3.f90
new file mode 100644
index 000000000..7616caad3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_error_3.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+!
+! PR 49708: [4.5/4.6/4.7 Regression] ICE with allocate and no dimensions
+!
+! Contributed by <fnordxyz@yahoo.com>
+
+  real, pointer :: x(:)
+  allocate(x)            ! { dg-error "Array specification required" }
+end 
diff --git a/gcc/testsuite/gfortran.dg/allocate_error_4.f90 b/gcc/testsuite/gfortran.dg/allocate_error_4.f90
new file mode 100644
index 000000000..6652b472f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_error_4.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! PR fortran/55314 - the second allocate statement was rejected.
+
+program main
+  implicit none
+  integer :: max_nb
+  type comm_mask
+    integer(4), pointer :: mask(:)
+  end type comm_mask
+  type (comm_mask), allocatable, save :: encode(:,:)
+  max_nb=2
+  allocate( encode(1:1,1:max_nb))
+  allocate( encode(1,1)%mask(1),encode(1,2)%mask(1))
+  deallocate( encode(1,1)%mask,encode(1,2)%mask)
+  allocate( encode(1,1)%mask(1),encode(1,1)%mask(1))  ! { dg-error "also appears at" }
+end program main
diff --git a/gcc/testsuite/gfortran.dg/allocate_scalar_with_shape.f90 b/gcc/testsuite/gfortran.dg/allocate_scalar_with_shape.f90
new file mode 100644
index 000000000..0fa9ce1fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_scalar_with_shape.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! PR fortran/41940
+
+integer, allocatable :: a
+TYPE :: x
+  integer, allocatable :: a
+END TYPE
+TYPE (x) :: y
+
+allocate(a(4))     ! { dg-error "Shape specification for allocatable scalar" }
+allocate(y%a(4))   ! { dg-error "Shape specification for allocatable scalar" }
+end
+
diff --git a/gcc/testsuite/gfortran.dg/allocate_stat.f90 b/gcc/testsuite/gfortran.dg/allocate_stat.f90
new file mode 100644
index 000000000..7f9eaf58d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_stat.f90
@@ -0,0 +1,76 @@
+! { dg-do compile }
+! PR fortran/32936
+!
+!
+function all_res()
+  implicit none
+  real, pointer :: gain 
+  integer :: all_res
+  allocate (gain,STAT=all_res)
+  deallocate(gain)
+  call bar()
+contains
+  subroutine bar()
+    real, pointer :: gain2
+    allocate (gain2,STAT=all_res)
+    deallocate(gain2)
+  end subroutine bar
+end function all_res
+
+function func()
+  implicit none
+  real, pointer :: gain 
+  integer :: all_res2, func
+  func = 0
+entry all_res2
+  allocate (gain,STAT=all_res2)
+  deallocate(gain)
+contains
+  subroutine test
+    implicit none
+    real, pointer :: gain2
+     allocate (gain2,STAT=all_res2)
+     deallocate(gain2)
+  end subroutine test
+end function func
+
+function func2() result(res)
+  implicit none
+  real, pointer :: gain 
+  integer :: res
+  allocate (gain,STAT=func2) ! { dg-error "is not a variable" }
+  deallocate(gain)
+  res = 0
+end function func2
+
+subroutine sub()
+  implicit none
+  interface
+    integer function func2()
+    end function
+  end interface
+  real, pointer :: gain 
+  integer, parameter :: res = 2
+  allocate (gain,STAT=func2) ! { dg-error "is not a variable" }
+  deallocate(gain)
+end subroutine sub
+
+module test
+contains
+ function one()
+   integer :: one, two
+   integer, pointer :: ptr
+   allocate(ptr, stat=one)
+   if(one == 0) deallocate(ptr)
+ entry two
+   allocate(ptr, stat=two)
+   if(associated(ptr)) deallocate(ptr)
+ end function one
+ subroutine sub()
+   integer, pointer :: p
+   allocate(p, stat=one) ! { dg-error "is not a variable" }
+   if(associated(p)) deallocate(p)
+   allocate(p, stat=two) ! { dg-error "is not a variable" }
+   if(associated(p)) deallocate(p)
+ end subroutine sub
+end module test
diff --git a/gcc/testsuite/gfortran.dg/allocate_stat_2.f90 b/gcc/testsuite/gfortran.dg/allocate_stat_2.f90
new file mode 100644
index 000000000..7cf6d659e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_stat_2.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! PR 41197
+program main
+  integer, dimension (4) :: ier = 0
+  character(len=30), dimension(2) :: er
+  integer, dimension (:), allocatable :: a
+  allocate (a (16), stat = ier) ! { dg-error "must be a scalar INTEGER" }
+  allocate (a (14), stat=ier(1),errmsg=er) ! { dg-error "must be a scalar CHARACTER" }
+end
+
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_1.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_1.f90
new file mode 100644
index 000000000..d386bb33b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_1.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! Test the fix for PR47592, in which the SOURCE expression was
+! being called twice.
+!
+! Contributed by Thomas Koenig  <tkoenig@gcc.gnu.org>
+!
+module foo
+  implicit none
+contains
+  function bar()
+    integer bar
+    integer :: i=9
+    i = i + 1
+    bar = i
+  end function bar
+end module foo
+
+program note7_35
+  use foo
+  implicit none
+  character(:), allocatable :: name
+  character(:), allocatable :: src
+  integer n
+  n = 10
+  allocate(name, SOURCE=repeat('x',bar()))
+  if (name .ne. 'xxxxxxxxxx') call abort
+  if (len (name) .ne. 10 ) call abort
+end program note7_35
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_typespec_1.f90 b/gcc/testsuite/gfortran.dg/allocate_with_typespec_1.f90
new file mode 100644
index 000000000..945a80e4a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_typespec_1.f90
@@ -0,0 +1,121 @@
+! { dg-do compile }
+!
+! Allocation of arrays with a type-spec specification with implicit none.
+!
+subroutine implicit_none_test1
+
+   implicit none
+
+   real, allocatable :: x(:)
+   real(4), allocatable :: x4(:)
+   real(8), allocatable :: x8(:)
+   double precision, allocatable :: d1(:)
+   doubleprecision, allocatable :: d2(:)
+   character, allocatable :: c1(:)
+   character(len=4), allocatable :: c2(:)
+
+   type a
+      integer mytype
+   end type a
+
+   type(a), allocatable :: b(:)
+
+   allocate(real :: x(1))
+   allocate(real(4) :: x4(1))
+   allocate(real(8) :: x8(1))
+   allocate(double precision :: d1(1))
+   allocate(doubleprecision :: d2(1))
+   allocate(character :: c1(1))
+   allocate(character(len=4) :: c2(1))
+   allocate(a :: b(1))
+
+end subroutine implicit_none_test1
+!
+! Allocation of a scalar with a type-spec specification with implicit none
+!
+subroutine implicit_none_test2
+
+   implicit none
+
+   real, allocatable :: x
+   real(4), allocatable :: x4
+   real(8), allocatable :: x8
+   double precision, allocatable :: d1
+   doubleprecision, allocatable :: d2
+   character, allocatable :: c1
+   character(len=4), allocatable :: c2
+
+   type a
+      integer mytype
+   end type a
+
+   type(a), allocatable :: b
+
+   allocate(real :: x)
+   allocate(real(4) :: x4)
+   allocate(real(8) :: x8)
+   allocate(double precision :: d1)
+   allocate(doubleprecision :: d2)
+   allocate(character :: c1)
+   allocate(character(len=4) :: c2)
+   allocate(a :: b)
+
+end subroutine implicit_none_test2
+!
+! Allocation of arrays with a type-spec specification with implicit none.
+!
+subroutine implicit_test3
+
+   real, allocatable :: x(:)
+   real(4), allocatable :: x4(:)
+   real(8), allocatable :: x8(:)
+   double precision, allocatable :: d1(:)
+   doubleprecision, allocatable :: d2(:)
+   character, allocatable :: c1(:)
+   character(len=4), allocatable :: c2(:)
+
+   type a
+      integer mytype
+   end type a
+
+   type(a), allocatable :: b(:)
+
+   allocate(real :: x(1))
+   allocate(real(4) :: x4(1))
+   allocate(real(8) :: x8(1))
+   allocate(double precision :: d1(1))
+   allocate(doubleprecision :: d2(1))
+   allocate(character :: c1(1))
+   allocate(character(len=4) :: c2(1))
+   allocate(a :: b(1))
+
+end subroutine implicit_test3
+!
+! Allocation of a scalar with a type-spec specification without implicit none
+!
+subroutine implicit_test4
+
+   real, allocatable :: x
+   real(4), allocatable :: x4
+   real(8), allocatable :: x8
+   double precision, allocatable :: d1
+   doubleprecision, allocatable :: d2
+   character, allocatable :: c1
+   character(len=4), allocatable :: c2
+
+   type a
+      integer mytype
+   end type a
+
+   type(a), allocatable :: b
+
+   allocate(real :: x)
+   allocate(real(4) :: x4)
+   allocate(real(8) :: x8)
+   allocate(double precision :: d1)
+   allocate(doubleprecision :: d2)
+   allocate(character :: c1)
+   allocate(character(len=4) :: c2)
+   allocate(a :: b)
+
+end subroutine implicit_test4
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_typespec_2.f b/gcc/testsuite/gfortran.dg/allocate_with_typespec_2.f
new file mode 100644
index 000000000..51d1afad0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_typespec_2.f
@@ -0,0 +1,121 @@
+C { dg-do compile }
+C
+C Allocation of arrays with a type-spec specification with implicit none.
+C
+       subroutine implicit_none_test1
+
+          implicit none
+
+          real, allocatable :: x(:)
+          real(4), allocatable :: x4(:)
+          real(8), allocatable :: x8(:)
+          double precision, allocatable :: d1(:)
+          doubleprecision, allocatable :: d2(:)
+          character, allocatable :: c1(:)
+          character(len=4), allocatable :: c2(:)
+
+          type a
+             integer mytype
+          end type a
+
+          type(a), allocatable :: b(:)
+
+          allocate(real :: x(1))
+          allocate(real(4) :: x4(1))
+          allocate(real(8) :: x8(1))
+          allocate(double precision :: d1(1))
+          allocate(doubleprecision :: d2(1))
+          allocate(character :: c1(1))
+          allocate(character(len=4) :: c2(1))
+          allocate(a :: b(1))
+
+       end
+C
+C Allocation of a scalar with a type-spec specification with implicit none
+C
+       subroutine implicit_none_test2
+
+          implicit none
+
+          real, allocatable :: x
+          real(4), allocatable :: x4
+          real(8), allocatable :: x8
+          double precision, allocatable :: d1
+          doubleprecision, allocatable :: d2
+          character, allocatable :: c1
+          character(len=4), allocatable :: c2
+
+          type a
+             integer mytype
+          end type a
+
+          type(a), allocatable :: b
+
+          allocate(real :: x)
+          allocate(real(4) :: x4)
+          allocate(real(8) :: x8)
+          allocate(double precision :: d1)
+          allocate(doubleprecision :: d2)
+          allocate(character :: c1)
+          allocate(character(len=4) :: c2)
+          allocate(a :: b)
+
+       end subroutine implicit_none_test2
+C
+C Allocation of arrays with a type-spec specification with implicit none.
+C
+       subroutine implicit_test3
+
+          real, allocatable :: x(:)
+          real(4), allocatable :: x4(:)
+          real(8), allocatable :: x8(:)
+          double precision, allocatable :: d1(:)
+          doubleprecision, allocatable :: d2(:)
+          character, allocatable :: c1(:)
+          character(len=4), allocatable :: c2(:)
+
+          type a
+             integer mytype
+          end type a
+
+          type(a), allocatable :: b(:)
+
+          allocate(real :: x(1))
+          allocate(real(4) :: x4(1))
+          allocate(real(8) :: x8(1))
+          allocate(double precision :: d1(1))
+          allocate(doubleprecision :: d2(1))
+          allocate(character :: c1(1))
+          allocate(character(len=4) :: c2(1))
+          allocate(a :: b(1))
+
+       end
+C
+C Allocation of a scalar with a type-spec specification without implicit none
+C
+       subroutine implicit_test4
+
+          real, allocatable :: x
+          real(4), allocatable :: x4
+          real(8), allocatable :: x8
+          double precision, allocatable :: d1
+          doubleprecision, allocatable :: d2
+          character, allocatable :: c1
+          character(len=4), allocatable :: c2
+
+          type a
+             integer mytype
+          end type a
+
+          type(a), allocatable :: b
+
+          allocate(real :: x)
+          allocate(real(4) :: x4)
+          allocate(real(8) :: x8)
+          allocate(double precision :: d1)
+          allocate(doubleprecision :: d2)
+          allocate(character :: c1)
+          allocate(character(len=4) :: c2)
+          allocate(a :: b)
+
+       end
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_typespec_3.f90 b/gcc/testsuite/gfortran.dg/allocate_with_typespec_3.f90
new file mode 100644
index 000000000..13a1596bf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_typespec_3.f90
@@ -0,0 +1,107 @@
+! { dg-do compile }
+!
+! Allocation of arrays with a type-spec specification with implicit none.
+!
+subroutine implicit_none_test1
+
+   implicit none
+
+   real, allocatable :: x(:)
+   real(4), allocatable :: x4(:)
+   real(8), allocatable :: x8(:)
+   double precision, allocatable :: d1(:)
+   doubleprecision, allocatable :: d2(:)
+   character, allocatable :: c1(:)
+
+   type a
+      integer mytype
+   end type a
+
+   type(a), allocatable :: b(:)
+
+   allocate(complex :: x(1))       ! { dg-error "is type incompatible" }
+   allocate(real(8) :: x4(1))      ! { dg-error "differs from the kind type parameter" }
+   allocate(real(4) :: x8(1))      ! { dg-error "differs from the kind type parameter" }
+   allocate(double :: d1(1))       ! { dg-error "Error in type-spec at" }
+   allocate(character(:) :: c1(1)) ! { dg-error "cannot contain a deferred type parameter" }
+   allocate(real :: b(1))          ! { dg-error "is type incompatible" }
+
+end subroutine implicit_none_test1
+!
+! Allocation of a scalar with a type-spec specification with implicit none
+!
+subroutine implicit_none_test2
+
+   implicit none
+
+   real, allocatable :: x
+   real(4), allocatable :: x4
+   real(8), allocatable :: x8
+   double precision, allocatable :: d1
+   character, allocatable :: c1
+
+   type a
+      integer mytype
+   end type a
+
+   type(a), allocatable :: b
+
+   allocate(complex :: x)       ! { dg-error "is type incompatible" }
+   allocate(real(8) :: x4)      ! { dg-error "differs from the kind type parameter" }
+   allocate(real(4) :: x8)      ! { dg-error "differs from the kind type parameter" }
+   allocate(double :: d1)       ! { dg-error "Error in type-spec at" }
+   allocate(character(:) :: c1) ! { dg-error "cannot contain a deferred type parameter" }
+   allocate(real :: b)          ! { dg-error "is type incompatible" }
+
+end subroutine implicit_none_test2
+!
+! Allocation of arrays with a type-spec specification with implicit none.
+!
+subroutine implicit_test3
+
+   real, allocatable :: x(:)
+   real(4), allocatable :: x4(:)
+   real(8), allocatable :: x8(:)
+   double precision, allocatable :: d1(:)
+   doubleprecision, allocatable :: d2(:)
+   character, allocatable :: c1(:)
+
+   type a
+      integer mytype
+   end type a
+
+   type(a), allocatable :: b(:)
+
+   allocate(complex :: x(1))       ! { dg-error "is type incompatible" }
+   allocate(real(8) :: x4(1))      ! { dg-error "differs from the kind type parameter" }
+   allocate(real(4) :: x8(1))      ! { dg-error "differs from the kind type parameter" }
+   allocate(double :: d1(1))       ! { dg-error "Error in type-spec" }
+   allocate(character(:) :: c1(1)) ! { dg-error "cannot contain a deferred type parameter" }
+   allocate(real :: b(1))          ! { dg-error "is type incompatible" }
+
+end subroutine implicit_test3
+!
+! Allocation of a scalar with a type-spec specification without implicit none
+!
+subroutine implicit_test4
+
+   real, allocatable :: x
+   real(4), allocatable :: x4
+   real(8), allocatable :: x8
+   double precision, allocatable :: d1
+   character, allocatable :: c1
+
+   type a
+      integer mytype
+   end type a
+
+   type(a), allocatable :: b
+
+   allocate(complex :: x)       ! { dg-error "is type incompatible" }
+   allocate(real(8) :: x4)      ! { dg-error "differs from the kind type parameter" }
+   allocate(real(4) :: x8)      ! { dg-error "differs from the kind type parameter" }
+   allocate(double :: d1)       ! { dg-error "Error in type-spec at" }
+   allocate(character(:) :: c1) ! { dg-error "cannot contain a deferred type parameter" }
+   allocate(real :: b)          ! { dg-error "is type incompatible" }
+
+end subroutine implicit_test4
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_typespec_4.f90 b/gcc/testsuite/gfortran.dg/allocate_with_typespec_4.f90
new file mode 100644
index 000000000..327f28dcd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_typespec_4.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-options "-w" }
+subroutine not_an_f03_intrinsic
+
+   implicit none
+
+   byte, allocatable :: x, y(:)
+   real*8, allocatable :: x8, y8(:)
+   double complex :: z
+
+   type real_type
+      integer mytype
+   end type real_type
+
+   type(real_type), allocatable :: b, c(:)
+
+   allocate(byte :: x)            ! { dg-error "Error in type-spec at" }
+   allocate(byte :: y(1))         ! { dg-error "Error in type-spec at" }
+
+   allocate(real*8 :: x)          ! { dg-error "Invalid type-spec at" }
+   allocate(real*8 :: y(1))       ! { dg-error "Invalid type-spec at" }
+   allocate(real*4 :: x8)         ! { dg-error "Invalid type-spec at" }
+   allocate(real*4 :: y8(1))      ! { dg-error "Invalid type-spec at" }
+   allocate(double complex :: d1) ! { dg-error "not a nonprocedure pointer or an allocatable" }
+   allocate(real_type :: b)
+   allocate(real_type :: c(1))
+
+end subroutine not_an_f03_intrinsic
diff --git a/gcc/testsuite/gfortran.dg/allocate_zerosize_1.f90 b/gcc/testsuite/gfortran.dg/allocate_zerosize_1.f90
new file mode 100644
index 000000000..c482ea0f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_zerosize_1.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+program main
+  implicit none
+  real, allocatable :: a(:), b(:,:)
+  integer :: n,m
+  character (len=2) :: one, two
+
+  one = ' 1'
+  two = ' 2'
+
+  allocate (a(1:-1))
+  if (size(a) /= 0) call abort
+  deallocate (a)
+
+  allocate (b(1:-1,0:10))
+  if (size(b) /= 0) call abort
+  deallocate (b)
+
+  ! Use variables for array bounds.  The internal reads
+  ! are there to hide fact that these are actually constant.
+
+  read (unit=one, fmt='(I2)') n
+  allocate (a(n:-1))
+  if (size(a) /= 0) call abort
+  deallocate (a)
+
+  read (unit=two, fmt='(I2)') m
+  allocate (b(1:3, m:0))
+  if (size(b) /= 0) call abort
+  deallocate (b)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/allocate_zerosize_2.f90 b/gcc/testsuite/gfortran.dg/allocate_zerosize_2.f90
new file mode 100644
index 000000000..bd6d299f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_zerosize_2.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! PR 27980 - We used to allocate negative amounts of memory
+!            for functions returning arrays if lbound > ubound-1.
+!            Based on a test case by beliavsky@aol.com posted to
+!            comp.lang.fortran.
+program xint_func
+  implicit none
+  integer, parameter :: n=3,ii(n)=(/2,0,-1/)
+  integer            :: i
+  character(len=80)  :: line
+  do i=1,n
+     write (line,'(10I5)') int_func(ii(i))
+  end do
+contains
+  function int_func(n) result(ivec)
+    integer, intent(in) :: n
+    integer             :: ivec(n)
+    integer             :: i
+    if (n > 0) then
+       forall (i=1:n) ivec(i) = i
+    end if
+  end function int_func
+end program xint_func
diff --git a/gcc/testsuite/gfortran.dg/allocate_zerosize_3.f b/gcc/testsuite/gfortran.dg/allocate_zerosize_3.f
new file mode 100644
index 000000000..57f2d75b6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_zerosize_3.f
@@ -0,0 +1,40 @@
+C { dg-do run }
+C Test the fix for PR35698, in which the negative size dimension would
+C throw out the subsequent bounds.
+C
+C Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+C
+      program try_lf0030
+      call LF0030(10)
+      end
+
+      SUBROUTINE LF0030(nf10)
+      INTEGER ILA1(7)
+      INTEGER ILA2(7)
+      LOGICAL LLA(:,:,:,:,:,:,:)
+      INTEGER ICA(7)
+      ALLOCATABLE LLA
+
+
+      ALLOCATE (LLA(2:3, 4, 0:5,
+     $          NF10:1, -2:7, -3:8,
+     $          -4:9))
+
+      ILA1 = LBOUND(LLA)
+      ILA2 = UBOUND(LLA)
+C     CORRECT FOR THE ZERO DIMENSIONED TERM TO ALLOW AN EASIER VERIFY
+      ILA1(4) = ILA1(4) - 2    !   1 - 2 = -1
+      ILA2(4) = ILA2(4) + 6    !   0 + 6 = 6     
+
+      DO J1 = 1,7
+      IVAL = 3-J1
+      IF (ILA1(J1) .NE. IVAL) call abort ()
+  100 ENDDO
+
+      DO J1 = 1,7
+      IVAL = 2+J1
+      IF (ILA2(J1) .NE. IVAL) call abort ()
+  101 ENDDO
+
+      END SUBROUTINE
+      
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/altreturn_1.f90 b/gcc/testsuite/gfortran.dg/altreturn_1.f90
new file mode 100644
index 000000000..c0ae15f9a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/altreturn_1.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+       subroutine foo (a)
+       real t, a, baz
+       call bar (*10)
+       t = 2 * baz ()
+       IF (t.gt.0) t = baz ()
+10     END
diff --git a/gcc/testsuite/gfortran.dg/altreturn_2.f90 b/gcc/testsuite/gfortran.dg/altreturn_2.f90
new file mode 100644
index 000000000..d0556d037
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/altreturn_2.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+       program altreturn_2
+         call foo()  ! { dg-error "Missing alternate return" }
+       contains
+         subroutine foo(*)
+           return
+         end subroutine
+       end program
diff --git a/gcc/testsuite/gfortran.dg/altreturn_3.f90 b/gcc/testsuite/gfortran.dg/altreturn_3.f90
new file mode 100644
index 000000000..daa090178
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/altreturn_3.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! Tests the fix for PR30236, which was due to alternate returns
+! in generic interfaces causing a segfault.  They now work
+! correctly.
+!
+! Contributed by Brooks Moses <brooks@gcc.gnu.org>
+!
+module arswitch
+  implicit none
+  interface gen
+    module procedure with
+    module procedure without
+  end interface
+contains
+  subroutine with(i,*)
+    integer i
+    if (i>0) then
+      i = -1
+      return 1
+    else
+      i = -2
+      return
+    end if
+  end subroutine
+  subroutine without()
+    return
+  end subroutine
+end module
+
+program test
+  use arswitch
+  implicit none
+  integer :: i = 0
+  call gen (i, *10)
+  if (i /= -2) call abort ()
+  i = 2
+  call gen (i, *20)
+ 10 continue
+  call abort()
+ 20 continue
+  if (i /= -1) call abort ()
+end
+! { dg-final { cleanup-modules "arswitch" } }
diff --git a/gcc/testsuite/gfortran.dg/altreturn_4.f90 b/gcc/testsuite/gfortran.dg/altreturn_4.f90
new file mode 100644
index 000000000..409ea51be
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/altreturn_4.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! Tests the fix for PR28172, in which an ICE would result from
+! the contained call with an alternate retrun.
+
+! Contributed by Tobias Schlüter <tobi@gcc.gnu.org>
+
+program blubb
+  call otherini(*998)
+  stop
+998 stop
+contains
+ subroutine init
+   call otherini(*999)
+   return
+999 stop
+ end subroutine init
+end program blubb
diff --git a/gcc/testsuite/gfortran.dg/altreturn_5.f90 b/gcc/testsuite/gfortran.dg/altreturn_5.f90
new file mode 100644
index 000000000..a8b6ff83c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/altreturn_5.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! Tests the fix for PR31483, in which dummy argument procedures
+! produced an ICE if they had an alternate return.
+!
+! Contributed by Mathias Fröhlich <M.Froehlich@science-computing.de>
+
+      SUBROUTINE R (i, *, *)
+      INTEGER i
+      RETURN i
+      END
+
+      SUBROUTINE PHLOAD (READER, i, res)

+      IMPLICIT NONE

+      EXTERNAL         READER
+      integer i
+      character(3) res

+      CALL READER (i, *1, *2)

+ 1    res = "one"
+      return

+ 2    res = "two"
+      return

+      END
+
+      EXTERNAL R
+      character(3) res

+      call PHLOAD (R, 1, res)
+      if (res .ne. "one") call abort ()
+      CALL PHLOAD (R, 2, res)
+      if (res .ne. "two") call abort ()
+      END

+

diff --git a/gcc/testsuite/gfortran.dg/altreturn_6.f90 b/gcc/testsuite/gfortran.dg/altreturn_6.f90
new file mode 100644
index 000000000..19c851e50
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/altreturn_6.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! PR 32938
+subroutine r (*)
+  integer(kind=8) :: i
+  return i
+end
diff --git a/gcc/testsuite/gfortran.dg/altreturn_7.f90 b/gcc/testsuite/gfortran.dg/altreturn_7.f90
new file mode 100644
index 000000000..d1786d038
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/altreturn_7.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! PR 40848: [4.5 Regression] ICE with alternate returns
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+
+MODULE TT
+
+INTERFACE M
+ MODULE PROCEDURE M1,M2
+END INTERFACE
+
+CONTAINS
+
+ SUBROUTINE M1(I,*)
+   INTEGER :: I
+   RETURN 1
+ END SUBROUTINE
+
+ SUBROUTINE M2(I,J)
+   INTEGER :: I,J
+ END SUBROUTINE
+
+END MODULE
+
+
+  USE TT
+  CALL M(1,*2)
+  CALL ABORT()
+2 CONTINUE
+END
+
+! { dg-final { cleanup-modules "tt" } }
+
diff --git a/gcc/testsuite/gfortran.dg/ambiguous_reference_1.f90 b/gcc/testsuite/gfortran.dg/ambiguous_reference_1.f90
new file mode 100644
index 000000000..93b155ef5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ambiguous_reference_1.f90
@@ -0,0 +1,50 @@
+! { dg-do compile }
+! Tests the fix for PR33550, in which an ICE would occur, instead of
+! the abiguous reference error.
+!
+! Found at
+! http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/1abc1549a6a164f1/
+! by James Van Buskirk:
+!
+module M1
+   real x
+end module M1
+
+module M2
+   contains
+      subroutine y
+      end subroutine y
+end module M2
+
+module M3
+   use M2, x => y
+end module M3
+
+module M4
+   use M1
+   use M3
+end module M4
+
+module M5
+   use M4             ! 'x' is ambiguous here but is not referred to
+end module M5
+
+module M6
+   use M5             ! ditto
+end module M6
+
+program test
+   use M1
+   use M3
+   interface
+      function x(z)   ! { dg-error "ambiguous reference" }
+      end function x  ! { dg-error "Expecting END INTERFACE" }
+   end interface
+
+   write(*,*) 'Hello, world!'
+end program test
+
+function x(z)
+   x = z
+end function x
+! { dg-final { cleanup-modules "m1 m2 m3 m4 m5 m6" } }
diff --git a/gcc/testsuite/gfortran.dg/ambiguous_reference_2.f90 b/gcc/testsuite/gfortran.dg/ambiguous_reference_2.f90
new file mode 100644
index 000000000..3ffaa1459
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ambiguous_reference_2.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+!
+! PR 39930: Bogus error: ambiguous reference
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module a1
+contains
+  subroutine myRoutine
+  end subroutine
+end module 
+
+module a2
+contains
+  subroutine myRoutine
+  end subroutine
+end module 
+
+module b
+contains
+
+  subroutine otherRoutine
+    use a1
+    use a2
+  end subroutine
+
+  subroutine myRoutine
+  end subroutine myRoutine      ! this is not ambiguous !
+
+end module
+
+! { dg-final { cleanup-modules "a1 a2 b" } }
+
diff --git a/gcc/testsuite/gfortran.dg/ambiguous_specific_1.f90 b/gcc/testsuite/gfortran.dg/ambiguous_specific_1.f90
new file mode 100644
index 000000000..b5292b2dd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ambiguous_specific_1.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! Checks the fix for PR33542, in which the ambiguity in the specific
+! interfaces of foo was missed.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+MODULE M1
+   INTERFACE FOO
+     MODULE PROCEDURE FOO
+   END INTERFACE
+CONTAINS
+   SUBROUTINE FOO(I)
+     INTEGER, INTENT(IN) :: I
+     WRITE(*,*) 'INTEGER'
+   END SUBROUTINE FOO
+END MODULE M1
+
+MODULE M2
+   INTERFACE FOO
+     MODULE PROCEDURE FOO
+   END INTERFACE
+CONTAINS
+   SUBROUTINE FOO(R)
+     REAL, INTENT(IN) :: R
+     WRITE(*,*) 'REAL'
+   END SUBROUTINE FOO
+END MODULE M2
+
+PROGRAM P
+   USE M1
+   USE M2
+   implicit none
+   external bar
+   CALL FOO(10)
+   CALL FOO(10.)
+   call bar (foo)  ! { dg-error "is ambiguous" }
+END PROGRAM P
+! { dg-final { cleanup-modules "m1 m2" } }
diff --git a/gcc/testsuite/gfortran.dg/ambiguous_specific_2.f90 b/gcc/testsuite/gfortran.dg/ambiguous_specific_2.f90
new file mode 100644
index 000000000..4597b3c86
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ambiguous_specific_2.f90
@@ -0,0 +1,42 @@
+! { dg-do compile }
+! Checks the fix for PR33542 does not throw an error if there is no
+! ambiguity in the specific interfaces of foo.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+MODULE M1
+   INTERFACE FOO
+     MODULE PROCEDURE FOO
+   END INTERFACE
+CONTAINS
+   SUBROUTINE FOO(I)
+     INTEGER, INTENT(IN) :: I
+     WRITE(*,*) 'INTEGER'
+   END SUBROUTINE FOO
+END MODULE M1
+
+MODULE M2
+   INTERFACE FOO
+     MODULE PROCEDURE FOOFOO
+   END INTERFACE
+CONTAINS
+   SUBROUTINE FOOFOO(R)
+     REAL, INTENT(IN) :: R
+     WRITE(*,*) 'REAL'
+   END SUBROUTINE FOOFOO
+END MODULE M2
+
+PROGRAM P
+   USE M1
+   USE M2
+   implicit none
+   external bar
+   CALL FOO(10)
+   CALL FOO(10.)
+   call bar (foo) 
+END PROGRAM P
+
+SUBROUTINE bar (arg)
+  EXTERNAL arg
+END SUBROUTINE bar
+! { dg-final { cleanup-modules "m1 m2" } }
diff --git a/gcc/testsuite/gfortran.dg/and_or_xor.f90 b/gcc/testsuite/gfortran.dg/and_or_xor.f90
new file mode 100644
index 000000000..412008b77
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/and_or_xor.f90
@@ -0,0 +1,7 @@
+! { dg-do run }
+program L
+   if (and(.TRUE._1, .TRUE._1) .neqv. .true.) call abort
+   if (or(.TRUE._1, .TRUE._1) .neqv. .true.) call abort
+   if (xor(.TRUE._1, .TRUE._1) .neqv. .false.) call abort
+end program L
+
diff --git a/gcc/testsuite/gfortran.dg/anint_1.f90 b/gcc/testsuite/gfortran.dg/anint_1.f90
new file mode 100644
index 000000000..a6b92cbcd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/anint_1.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! Check the fix for PR33568 in which the optional KIND
+! argument for ANINT, with an array for the first argument
+! would cause an ICE.
+!
+! Contributed by Ignacio Fernández Galván <jellby@yahoo.com>
+!
+PROGRAM Test
+  IMPLICIT NONE
+  INTEGER, PARAMETER :: DP=8
+  REAL(DP), DIMENSION(1:3) :: A = (/1.76,2.32,7.66/), B
+  A = ANINT ( A , DP)
+  B = A
+  A = ANINT ( A)
+  if (any (A .ne. B)) call abort ()
+END PROGRAM Test
diff --git a/gcc/testsuite/gfortran.dg/any_all_1.f90 b/gcc/testsuite/gfortran.dg/any_all_1.f90
new file mode 100644
index 000000000..f00c477b7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/any_all_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR 34817 - the wrong library function was called,
+! leading to garbage in the return value
+program main
+  real, dimension(2,2) :: a
+  logical(kind=4), dimension(2) :: b
+  integer(kind=4), dimension(2) :: i
+  equivalence (b,i)
+  data a /1.0, 2.0, -0.1, -0.2 /
+
+  i = 16843009 ! Initialize i to put junk into b
+  b = any(a>0.5,dim=1)
+  if (b(2) .or. .not. b(1)) call abort
+
+  i = 16843009  ! Initialize i to put junk into b
+  b = all(a>0.5,dim=1)
+  if (b(2) .or. .not. b(1)) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/any_all_2.f90 b/gcc/testsuite/gfortran.dg/any_all_2.f90
new file mode 100644
index 000000000..57df0cf6c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/any_all_2.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! PR 34838 - this failed with "Can't convert LOGICAL(1) to LOGICAL(1)
+! Test case contributed by Manfred Schwab.
+program main
+  Logical(kind=1) :: bmp(1),bmpv(1)
+
+  bmp(1)=.false.
+  bmpv(1)=.true.
+
+  if ( ANY(bmp(1:1) .NEQV. bmpv(1:1)) ) then
+     print*,"hello"
+  end if
+
+  if ( ALL(bmp(1:1) .NEQV. bmpv(1:1)) ) then
+     print*,"hello"
+  end if
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/anyallcount_1.f90 b/gcc/testsuite/gfortran.dg/anyallcount_1.f90
new file mode 100644
index 000000000..9e8c7768b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/anyallcount_1.f90
@@ -0,0 +1,71 @@
+! { dg-do run }
+program main
+   character(len=*), parameter :: f='(3L1)'
+   character(len=*), parameter :: g='(3I1)'
+   real, dimension(3,3) :: a
+   logical(kind=1), dimension(3,3) :: m1
+   logical(kind=2), dimension(3,3) :: m2
+   logical(kind=4), dimension(3,3) :: m4
+   logical(kind=8), dimension(3,3) :: m8
+   character(len=3) :: res
+   data a /-1.0, -2.0, -3.0, 2.0, 1.0, -2.1, 1.0, 2.0, 3.0 /
+
+   m1 = a > 0
+   m2 = a > 0
+   m4 = a > 0
+   m8 = a > 0
+
+   write (unit=res,fmt=f) any(m1,dim=1)
+   if (res /= 'FTT') call abort
+   write (unit=res,fmt=f) any(m2,dim=1)
+   if (res /= 'FTT') call abort
+   write (unit=res,fmt=f) any(m4,dim=1)
+   if (res /= 'FTT') call abort
+   write (unit=res,fmt=f) any(m8,dim=1)
+   if (res /= 'FTT') call abort
+   write (unit=res,fmt=f) any(m1,dim=2)
+   if (res /= 'TTT') call abort
+   write (unit=res,fmt=f) any(m2,dim=2)
+   if (res /= 'TTT') call abort
+   write (unit=res,fmt=f) any(m4,dim=2)
+   if (res /= 'TTT') call abort
+   write (unit=res,fmt=f) any(m8,dim=2)
+   if (res /= 'TTT') call abort
+
+   write (unit=res,fmt=f) all(m1,dim=1)
+   if (res /= 'FFT') call abort
+   write (unit=res,fmt=f) all(m2,dim=1)
+   if (res /= 'FFT') call abort
+   write (unit=res,fmt=f) all(m4,dim=1)
+   if (res /= 'FFT') call abort
+   write (unit=res,fmt=f) all(m8,dim=1)
+   if (res /= 'FFT') call abort
+
+   write (unit=res,fmt=f) all(m1,dim=2)
+   if (res /= 'FFF') call abort
+   write (unit=res,fmt=f) all(m2,dim=2)
+   if (res /= 'FFF') call abort
+   write (unit=res,fmt=f) all(m4,dim=2)
+   if (res /= 'FFF') call abort
+   write (unit=res,fmt=f) all(m8,dim=2)
+   if (res /= 'FFF') call abort
+
+   write (unit=res,fmt=g) count(m1,dim=1)
+   if (res /= '023') call abort
+   write (unit=res,fmt=g) count(m2,dim=1)
+   if (res /= '023') call abort
+   write (unit=res,fmt=g) count(m4,dim=1)
+   if (res /= '023') call abort
+   write (unit=res,fmt=g) count(m8,dim=1)
+   if (res /= '023') call abort
+
+   write (unit=res,fmt=g) count(m1,dim=2)
+   if (res /= '221') call abort
+   write (unit=res,fmt=g) count(m2,dim=2)
+   if (res /= '221') call abort
+   write (unit=res,fmt=g) count(m4,dim=2)
+   if (res /= '221') call abort
+   write (unit=res,fmt=g) count(m8,dim=2)
+   if (res /= '221') call abort
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/append_1.f90 b/gcc/testsuite/gfortran.dg/append_1.f90
new file mode 100644
index 000000000..8b81bc384
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/append_1.f90
@@ -0,0 +1,36 @@
+! PR libfortran/21471
+! Testing POSITION="APPEND"
+!
+! { dg-do run }
+      subroutine failed
+        close (10,status='delete')
+        call abort
+      end subroutine failed
+
+      integer,parameter :: n = 13
+      integer :: i, j, error
+
+      open (10, file='foo')
+      close (10)
+
+      do i = 1, n
+        open (10, file='foo',position='append')
+        write (10,*) i
+        close (10)
+      end do
+
+      open (10,file='foo',status='old')
+      error = 0
+      i = -1
+      do while (error == 0)
+        i = i + 1
+        read (10,*,iostat=error) j
+        if (error == 0) then
+          if (i + 1 /= j) call failed
+        end if
+        if (i > n + 1) call failed
+      end do
+      if (i /= n) call failed
+      close (10,status='delete')
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_1.f90 b/gcc/testsuite/gfortran.dg/argument_checking_1.f90
new file mode 100644
index 000000000..b42047ae6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_1.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+!
+! PR fortran/30940
+program main
+  implicit none
+  character(len=10) :: digit_string = '123456789', str
+  character :: digit_arr(10)
+  call copy(digit_string, digit_arr)
+  call copy(digit_arr,str)
+  if(str /= '123456789') call abort()
+  digit_string = 'qwertasdf'
+  call copy2(digit_string, digit_arr)
+  call copy2(digit_arr,str)
+  if(str /= 'qwertasdf') call abort()
+  digit_string = '1qayxsw23e'
+  call copy3("1qayxsw23e", digit_arr)
+  call copy3(digit_arr,str)
+  if(str /= '1qayxsw23e') call abort()
+contains
+  subroutine copy(in, out)
+    character, dimension(*)  :: in
+    character, dimension(10) :: out
+    out = in(:10)
+  end subroutine copy
+  subroutine copy2(in, out)
+    character, dimension(2,*)  :: in
+    character, dimension(2,5) :: out
+    out(1:2,1:5) = in(1:2,1:5)
+  end subroutine copy2
+  subroutine copy3(in, out)
+    character(len=2), dimension(5)  :: in
+    character(len=2), dimension(5) :: out
+    out = in
+  end subroutine copy3
+end program main
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_10.f90 b/gcc/testsuite/gfortran.dg/argument_checking_10.f90
new file mode 100644
index 000000000..315ee0388
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_10.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! PR fortran/34425
+!
+! Contributed by Joost VandeVondele
+!
+IMPLICIT NONE
+INTEGER :: i(-1:1)
+INTEGER :: j(-2:-1)
+CALL S(i)
+CALL S(j) ! { dg-warning "Actual argument contains too few elements for dummy argument 'i' .2/3." }
+CONTAINS
+ SUBROUTINE S(i)
+  INTEGER :: i(0:2)
+ END SUBROUTINE
+END
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_11.f90 b/gcc/testsuite/gfortran.dg/argument_checking_11.f90
new file mode 100644
index 000000000..7c70c37ee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_11.f90
@@ -0,0 +1,285 @@
+! { dg-do compile }
+! { dg-options "-std=f95 -fmax-errors=100" }
+!
+! PR fortran/34665
+!
+! Test argument checking
+!
+! TODO: Check also expressions, e.g. "(a(1))" instead of "a(1)
+! for strings; check also "string" and [ "string" ]
+!
+implicit none
+CONTAINS
+SUBROUTINE test1(a,b,c,d,e)
+ integer, dimension(:) :: a
+ integer, pointer, dimension(:) :: b
+ integer, dimension(*) :: c
+ integer, dimension(5) :: d
+ integer               :: e
+
+ call as_size(a)
+ call as_size(b)
+ call as_size(c)
+ call as_size(d)
+ call as_size(e) ! { dg-error "Rank mismatch" }
+ call as_size(1) ! { dg-error "Rank mismatch" }
+ call as_size( (/ 1 /) )
+ call as_size( (a) )
+ call as_size( (b) )
+ call as_size( (c) ) ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
+ call as_size( (d) )
+ call as_size( (e) ) ! { dg-error "Rank mismatch" }
+ call as_size(a(1)) ! { dg-error "Element of assumed-shaped" }
+ call as_size(b(1)) ! { dg-error "Element of assumed-shaped" }
+ call as_size(c(1))
+ call as_size(d(1))
+ call as_size( (a(1)) ) ! { dg-error "Rank mismatch" }
+ call as_size( (b(1)) ) ! { dg-error "Rank mismatch" }
+ call as_size( (c(1)) ) ! { dg-error "Rank mismatch" }
+ call as_size( (d(1)) ) ! { dg-error "Rank mismatch" }
+ call as_size(a(1:2))
+ call as_size(b(1:2))
+ call as_size(c(1:2))
+ call as_size(d(1:2))
+ call as_size( (a(1:2)) )
+ call as_size( (b(1:2)) )
+ call as_size( (c(1:2)) )
+ call as_size( (d(1:2)) )
+
+ call as_shape(a)
+ call as_shape(b)
+ call as_shape(c) ! { dg-error "cannot be an assumed-size array" }
+ call as_shape(d)
+ call as_shape(e) ! { dg-error "Rank mismatch" }
+ call as_shape( 1 ) ! { dg-error "Rank mismatch" }
+ call as_shape( (/ 1 /) )
+ call as_shape( (a) )
+ call as_shape( (b) )
+ call as_shape( (c) ) ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
+ call as_shape( (d) )
+ call as_shape( (e) ) ! { dg-error "Rank mismatch" }
+ call as_shape( (1) ) ! { dg-error "Rank mismatch" }
+ call as_shape( ((/ 1 /)) )
+ call as_shape(a(1)) ! { dg-error "Rank mismatch" }
+ call as_shape(b(1)) ! { dg-error "Rank mismatch" }
+ call as_shape(c(1)) ! { dg-error "Rank mismatch" }
+ call as_shape(d(1)) ! { dg-error "Rank mismatch" }
+ call as_shape( (a(1)) ) ! { dg-error "Rank mismatch" }
+ call as_shape( (b(1)) ) ! { dg-error "Rank mismatch" }
+ call as_shape( (c(1)) ) ! { dg-error "Rank mismatch" }
+ call as_shape( (d(1)) ) ! { dg-error "Rank mismatch" }
+ call as_shape(a(1:2))
+ call as_shape(b(1:2))
+ call as_shape(c(1:2))
+ call as_shape(d(1:2))
+ call as_shape( (a(1:2)) )
+ call as_shape( (b(1:2)) )
+ call as_shape( (c(1:2)) )
+ call as_shape( (d(1:2)) )
+
+ call as_expl(a)
+ call as_expl(b)
+ call as_expl(c)
+ call as_expl(d)
+ call as_expl(e) ! { dg-error "Rank mismatch" }
+ call as_expl( 1 ) ! { dg-error "Rank mismatch" }
+ call as_expl( (/ 1, 2, 3 /) )
+ call as_expl( (a) )
+ call as_expl( (b) )
+ call as_expl( (c) ) ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
+ call as_expl( (d) )
+ call as_expl( (e) ) ! { dg-error "Rank mismatch" }
+ call as_expl(a(1)) ! { dg-error "Element of assumed-shaped" }
+ call as_expl(b(1)) ! { dg-error "Element of assumed-shaped" }
+ call as_expl(c(1))
+ call as_expl(d(1))
+ call as_expl( (a(1)) ) ! { dg-error "Rank mismatch" }
+ call as_expl( (b(1)) ) ! { dg-error "Rank mismatch" }
+ call as_expl( (c(1)) ) ! { dg-error "Rank mismatch" }
+ call as_expl( (d(1)) )  ! { dg-error "Rank mismatch" }
+ call as_expl(a(1:3))
+ call as_expl(b(1:3))
+ call as_expl(c(1:3))
+ call as_expl(d(1:3))
+ call as_expl( (a(1:3)) )
+ call as_expl( (b(1:3)) )
+ call as_expl( (c(1:3)) )
+ call as_expl( (d(1:3)) )
+END SUBROUTINE test1
+
+SUBROUTINE as_size(a)
+ integer, dimension(*) :: a
+END SUBROUTINE as_size
+
+SUBROUTINE as_shape(a)
+ integer, dimension(:) :: a
+END SUBROUTINE as_shape
+
+SUBROUTINE as_expl(a)
+ integer, dimension(3) :: a
+END SUBROUTINE as_expl
+
+
+SUBROUTINE test2(a,b,c,d,e)
+ character(len=*), dimension(:) :: a
+ character(len=*), pointer, dimension(:) :: b
+ character(len=*), dimension(*) :: c
+ character(len=*), dimension(5) :: d
+ character(len=*)               :: e
+
+ call cas_size(a)
+ call cas_size(b)
+ call cas_size(c)
+ call cas_size(d)
+ call cas_size(e) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size("abc") ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size( (/"abc"/) )
+ call cas_size(a//"a")
+ call cas_size(b//"a")
+ call cas_size(c//"a")  ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
+ call cas_size(d//"a")
+ call cas_size(e//"a") ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size(("abc")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size( ((/"abc"/)) )
+ call cas_size(a(1)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size(b(1)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size(c(1)) ! OK in F95
+ call cas_size(d(1)) ! OK in F95
+ call cas_size((a(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" } 
+ call cas_size((b(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size((c(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" } 
+ call cas_size((d(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size(a(1:2))
+ call cas_size(b(1:2))
+ call cas_size(c(1:2))
+ call cas_size(d(1:2))
+ call cas_size((a(1:2)//"a"))
+ call cas_size((b(1:2)//"a"))
+ call cas_size((c(1:2)//"a"))
+ call cas_size((d(1:2)//"a"))
+ call cas_size(a(:)(1:3))
+ call cas_size(b(:)(1:3))
+ call cas_size(d(:)(1:3))
+ call cas_size((a(:)(1:3)//"a"))
+ call cas_size((b(:)(1:3)//"a"))
+ call cas_size((d(:)(1:3)//"a"))
+ call cas_size(a(1:2)(1:3))
+ call cas_size(b(1:2)(1:3))
+ call cas_size(c(1:2)(1:3))
+ call cas_size(d(1:2)(1:3))
+ call cas_size((a(1:2)(1:3)//"a"))
+ call cas_size((b(1:2)(1:3)//"a"))
+ call cas_size((c(1:2)(1:3)//"a"))
+ call cas_size((d(1:2)(1:3)//"a"))
+ call cas_size(e(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" } 
+ call cas_size("abcd"(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" } 
+ call cas_size((e(1:3))) ! { dg-error "Fortran 2003: Scalar CHARACTER" } 
+ call cas_size(("abcd"(1:3)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" } 
+
+ call cas_shape(a)
+ call cas_shape(b)
+ call cas_shape(c) ! { dg-error "cannot be an assumed-size array" }
+ call cas_shape(d)
+ call cas_shape(e) ! { dg-error "Rank mismatch" }
+ call cas_shape("abc") ! { dg-error "Rank mismatch" }
+ call cas_shape( (/"abc"/) )
+ call cas_shape(a//"c")
+ call cas_shape(b//"c")
+ call cas_shape(c//"c") ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
+ call cas_shape(d//"c")
+ call cas_shape(e//"c") ! { dg-error "Rank mismatch" }
+ call cas_shape(("abc")) ! { dg-error "Rank mismatch" }
+ call cas_shape( ((/"abc"/)) )
+ call cas_shape(a(1)) ! { dg-error "Rank mismatch" }
+ call cas_shape(b(1)) ! { dg-error "Rank mismatch" }
+ call cas_shape(c(1)) ! { dg-error "Rank mismatch" }
+ call cas_shape(d(1)) ! { dg-error "Rank mismatch" }
+ call cas_shape(a(1:2))
+ call cas_shape(b(1:2))
+ call cas_shape(c(1:2))
+ call cas_shape(d(1:2))
+ call cas_shape((a(1:2)//"a"))
+ call cas_shape((b(1:2)//"a"))
+ call cas_shape((c(1:2)//"a"))
+ call cas_shape((d(1:2)//"a"))
+ call cas_shape(a(:)(1:3))
+ call cas_shape(b(:)(1:3))
+ call cas_shape(d(:)(1:3))
+ call cas_shape((a(:)(1:3)//"a"))
+ call cas_shape((b(:)(1:3)//"a"))
+ call cas_shape((d(:)(1:3)//"a"))
+ call cas_shape(a(1:2)(1:3))
+ call cas_shape(b(1:2)(1:3))
+ call cas_shape(c(1:2)(1:3))
+ call cas_shape(d(1:2)(1:3))
+ call cas_shape((a(1:2)(1:3)//"a"))
+ call cas_shape((b(1:2)(1:3)//"a"))
+ call cas_shape((c(1:2)(1:3)//"a"))
+ call cas_shape((d(1:2)(1:3)//"a"))
+ call cas_size(e(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size("abcd"(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size((e(1:3))) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_size(("abcd"(1:3)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+
+ call cas_expl(a)
+ call cas_expl(b)
+ call cas_expl(c)
+ call cas_expl(d)
+ call cas_expl(e) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl("abc") ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl((/"a","b","c"/))
+ call cas_expl(a//"a")
+ call cas_expl(b//"a")
+ call cas_expl(c//"a")  ! { dg-error "The upper bound in the last dimension must appear in the reference to the assumed size array" }
+ call cas_expl(d//"a")
+ call cas_expl(e//"a") ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl(("abc")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl(((/"a","b","c"/)))
+ call cas_expl(a(1)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl(b(1)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl(c(1)) ! OK in F95
+ call cas_expl(d(1)) ! OK in F95
+ call cas_expl((a(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl((b(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl((c(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl((d(1)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl(a(1:3))
+ call cas_expl(b(1:3))
+ call cas_expl(c(1:3))
+ call cas_expl(d(1:3))
+ call cas_expl((a(1:3)//"a"))
+ call cas_expl((b(1:3)//"a"))
+ call cas_expl((c(1:3)//"a"))
+ call cas_expl((d(1:3)//"a"))
+ call cas_expl(a(:)(1:3))
+ call cas_expl(b(:)(1:3))
+ call cas_expl(d(:)(1:3))
+ call cas_expl((a(:)(1:3)))
+ call cas_expl((b(:)(1:3)))
+ call cas_expl((d(:)(1:3)))
+ call cas_expl(a(1:2)(1:3))
+ call cas_expl(b(1:2)(1:3))
+ call cas_expl(c(1:2)(1:3))
+ call cas_expl(d(1:2)(1:3))
+ call cas_expl((a(1:2)(1:3)//"a"))
+ call cas_expl((b(1:2)(1:3)//"a"))
+ call cas_expl((c(1:2)(1:3)//"a"))
+ call cas_expl((d(1:2)(1:3)//"a"))
+ call cas_expl(e(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl("abcd"(1:3)) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl((e(1:3))) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+ call cas_expl(("abcd"(1:3)//"a")) ! { dg-error "Fortran 2003: Scalar CHARACTER" }
+END SUBROUTINE test2
+
+SUBROUTINE cas_size(a)
+ character(len=*), dimension(*) :: a
+END SUBROUTINE cas_size
+
+SUBROUTINE cas_shape(a)
+ character(len=*), dimension(:) :: a
+END SUBROUTINE cas_shape
+
+SUBROUTINE cas_expl(a)
+ character(len=*), dimension(3) :: a
+END SUBROUTINE cas_expl
+END
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_12.f90 b/gcc/testsuite/gfortran.dg/argument_checking_12.f90
new file mode 100644
index 000000000..dc5b5268a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_12.f90
@@ -0,0 +1,59 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/34665
+!
+! Test argument checking
+!
+implicit none
+CONTAINS
+SUBROUTINE test2(a,b,c,d,e)
+ character(len=*), dimension(:) :: a
+ character(len=*), pointer, dimension(:) :: b
+ character(len=*), dimension(*) :: c
+ character(len=*), dimension(5) :: d
+ character(len=*)               :: e
+
+ call cas_size(e) 
+ call cas_size("abc") 
+ call cas_size(e//"a") 
+ call cas_size(("abc")) 
+ call cas_size(a(1)) 
+ call cas_size(b(1)) 
+ call cas_size((a(1)//"a")) 
+ call cas_size((b(1)//"a")) 
+ call cas_size((c(1)//"a")) 
+ call cas_size((d(1)//"a")) 
+ call cas_size(e(1:3)) 
+ call cas_size("abcd"(1:3)) 
+ call cas_size((e(1:3))) 
+ call cas_size(("abcd"(1:3)//"a")) 
+ call cas_size(e(1:3)) 
+ call cas_size("abcd"(1:3)) 
+ call cas_size((e(1:3))) 
+ call cas_size(("abcd"(1:3)//"a")) 
+ call cas_expl(e) 
+ call cas_expl("abc") 
+ call cas_expl(e//"a") 
+ call cas_expl(("abc")) 
+ call cas_expl(a(1)) 
+ call cas_expl(b(1)) 
+ call cas_expl((a(1)//"a")) 
+ call cas_expl((b(1)//"a")) 
+ call cas_expl((c(1)//"a")) 
+ call cas_expl((d(1)//"a")) 
+ call cas_expl(e(1:3)) 
+ call cas_expl("abcd"(1:3)) 
+ call cas_expl((e(1:3))) 
+ call cas_expl(("abcd"(1:3)//"a")) 
+END SUBROUTINE test2
+
+SUBROUTINE cas_size(a)
+ character(len=*), dimension(*) :: a
+END SUBROUTINE cas_size
+
+SUBROUTINE cas_expl(a)
+ character(len=*), dimension(5) :: a
+END SUBROUTINE cas_expl
+END
+
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_13.f90 b/gcc/testsuite/gfortran.dg/argument_checking_13.f90
new file mode 100644
index 000000000..b94bbc7ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_13.f90
@@ -0,0 +1,83 @@
+! { dg-do compile }
+!
+! PR fortran/34796
+!
+! Argument checks:
+! - elements of deferred-shape arrays (= non-dummies) are allowed
+!   as the memory is contiguous
+! - while assumed-shape arrays (= dummy arguments) and pointers are
+!   not (strides can make them non-contiguous)
+! and
+! - if the memory is non-contigous, character arguments have as
+!   storage size only the size of the element itself, check for
+!   too short actual arguments.
+!
+subroutine test1(assumed_sh_dummy, pointer_dummy)
+implicit none
+interface
+  subroutine rlv1(y)
+    real   :: y(3)
+  end subroutine rlv1
+end interface
+
+real          :: assumed_sh_dummy(:,:,:)
+real, pointer :: pointer_dummy(:,:,:)
+
+real, allocatable :: deferred(:,:,:)
+real, pointer     :: ptr(:,:,:)
+call rlv1(deferred(1,1,1))         ! valid since contiguous
+call rlv1(ptr(1,1,1))              ! { dg-error "Element of assumed-shaped or pointer array" }
+call rlv1(assumed_sh_dummy(1,1,1)) ! { dg-error "Element of assumed-shaped or pointer array" }
+call rlv1(pointer_dummy(1,1,1))    ! { dg-error "Element of assumed-shaped or pointer array" }
+end
+
+subroutine test2(assumed_sh_dummy, pointer_dummy)
+implicit none
+interface
+  subroutine rlv2(y)
+    character   :: y(3)
+  end subroutine rlv2
+end interface
+
+character(3)          :: assumed_sh_dummy(:,:,:)
+character(3), pointer :: pointer_dummy(:,:,:)
+
+character(3), allocatable :: deferred(:,:,:)
+character(3), pointer     :: ptr(:,:,:)
+call rlv2(deferred(1,1,1))         ! Valid since contiguous
+call rlv2(ptr(1,1,1))              ! Valid F2003
+call rlv2(assumed_sh_dummy(1,1,1)) ! Valid F2003
+call rlv2(pointer_dummy(1,1,1))    ! Valid F2003
+
+! The following is kind of ok: The memory access it valid
+! We warn nonetheless as the result is not what is intented
+! and also formally wrong.
+! Using (1:string_length) would be ok.
+call rlv2(ptr(1,1,1)(1:1))              ! { dg-warning "contains too few elements" }
+call rlv2(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-warning "contains too few elements" }
+call rlv2(pointer_dummy(1,1,1)(1:3))    ! Valid F2003
+end
+
+subroutine test3(assumed_sh_dummy, pointer_dummy)
+implicit none
+interface
+  subroutine rlv3(y)
+    character   :: y(3)
+  end subroutine rlv3
+end interface
+
+character(2)          :: assumed_sh_dummy(:,:,:)
+character(2), pointer :: pointer_dummy(:,:,:)
+
+character(2), allocatable :: deferred(:,:,:)
+character(2), pointer     :: ptr(:,:,:)
+call rlv3(deferred(1,1,1))         ! Valid since contiguous
+call rlv3(ptr(1,1,1))              ! { dg-warning "contains too few elements" }
+call rlv3(assumed_sh_dummy(1,1,1)) ! { dg-warning "contains too few elements" }
+call rlv3(pointer_dummy(1,1,1))    ! { dg-warning "contains too few elements" }
+
+call rlv3(deferred(1,1,1)(1:2))         ! Valid since contiguous
+call rlv3(ptr(1,1,1)(1:2))              ! { dg-warning "contains too few elements" }
+call rlv3(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-warning "contains too few elements" }
+call rlv3(pointer_dummy(1,1,1)(1:2))    ! { dg-warning "contains too few elements" }
+end
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_14.f90 b/gcc/testsuite/gfortran.dg/argument_checking_14.f90
new file mode 100644
index 000000000..4c32b253a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_14.f90
@@ -0,0 +1,68 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/34796
+!
+! This checks for Fortran 2003 extensions.
+!
+! Argument checks:
+! - elements of deferred-shape arrays (= non-dummies) are allowed
+!   as the memory is contiguous
+! - while assumed-shape arrays (= dummy arguments) and pointers are
+!   not (strides can make them non-contiguous)
+! and
+! - if the memory is non-contigous, character arguments have as
+!   storage size only the size of the element itself, check for
+!   too short actual arguments.
+!
+subroutine test2(assumed_sh_dummy, pointer_dummy)
+implicit none
+interface
+  subroutine rlv2(y)
+    character   :: y(3)
+  end subroutine rlv2
+end interface
+
+character(3)          :: assumed_sh_dummy(:,:,:)
+character(3), pointer :: pointer_dummy(:,:,:)
+
+character(3), allocatable :: deferred(:,:,:)
+character(3), pointer     :: ptr(:,:,:)
+call rlv2(deferred(1,1,1))         ! Valid since contiguous
+call rlv2(ptr(1,1,1))              ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv2(assumed_sh_dummy(1,1,1)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv2(pointer_dummy(1,1,1))    ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+
+! The following is kind of ok: The memory access it valid
+! We warn nonetheless as the result is not what is intented
+! and also formally wrong.
+! Using (1:string_length) would be ok.
+call rlv2(deferred(1,1,1)(1:3))         ! OK
+call rlv2(ptr(1,1,1)(1:1))              ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv2(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv2(pointer_dummy(1,1,1)(1:3))    ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+end
+
+subroutine test3(assumed_sh_dummy, pointer_dummy)
+implicit none
+interface
+  subroutine rlv3(y)
+    character   :: y(2)
+  end subroutine rlv3
+end interface
+
+character(2)          :: assumed_sh_dummy(:,:,:)
+character(2), pointer :: pointer_dummy(:,:,:)
+
+character(2), allocatable :: deferred(:,:,:)
+character(2), pointer     :: ptr(:,:,:)
+call rlv3(deferred(1,1,1))         ! Valid since contiguous
+call rlv3(ptr(1,1,1))              ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv3(assumed_sh_dummy(1,1,1)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv3(pointer_dummy(1,1,1))    ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+
+call rlv3(deferred(1,1,1)(1:2))         ! Valid since contiguous
+call rlv3(ptr(1,1,1)(1:2))              ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv3(assumed_sh_dummy(1,1,1)(1:2)) ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+call rlv3(pointer_dummy(1,1,1)(1:2))    ! { dg-error "Fortran 2003: Scalar CHARACTER actual" }
+end
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_15.f90 b/gcc/testsuite/gfortran.dg/argument_checking_15.f90
new file mode 100644
index 000000000..5d3c9f654
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_15.f90
@@ -0,0 +1,57 @@
+! { dg-do compile }
+!
+! PR fortran/32616
+!
+! Check for to few elements of the actual argument
+! and reject mismatching string lengths for assumed-shape dummies
+!
+implicit none
+external test
+integer :: i(10)
+integer :: j(2,2)
+character(len=4) :: str(2)
+character(len=4) :: str2(2,2)
+
+call test()
+
+call foo(i(8)) ! { dg-warning "too few elements for dummy argument 'a' .3/4." }
+call foo(j(1,1))
+call foo(j(2,1)) ! { dg-warning "too few elements for dummy argument 'a' .3/4." }
+call foo(j(1,2)) ! { dg-warning "too few elements for dummy argument 'a' .2/4." }
+
+str = 'FORT'
+str2 = 'fort'
+call bar(str(:)(1:2)) ! { dg-warning "too few elements for dummy argument 'c' .4/6." }
+call bar(str(1:2)(1:1)) ! { dg-warning "too few elements for dummy argument 'c' .2/6." }
+call bar(str(2)) ! { dg-warning "too few elements for dummy argument 'c' .4/6." }
+call bar(str(1)(2:1)) ! OK
+call bar(str2(2,1)(4:1)) ! OK
+call bar(str2(1,2)(3:4)) ! OK
+call bar(str2(1,2)(4:4)) ! { dg-warning "too few elements for dummy argument 'c' .5/6." }
+contains
+  subroutine foo(a)
+    integer :: a(4)
+  end subroutine foo
+  subroutine bar(c)
+    character(len=2) :: c(3)
+!    print '(3a)', ':',c(1),':'
+!    print '(3a)', ':',c(2),':'
+!    print '(3a)', ':',c(3),':'
+  end subroutine bar
+end
+
+
+subroutine test()
+implicit none
+character(len=5), pointer :: c
+character(len=5) :: str(5)
+call foo(c) ! { dg-warning "Character length mismatch" }
+call bar(str) ! { dg-warning "Character length mismatch" }
+contains
+  subroutine foo(a)
+    character(len=3), pointer :: a
+  end subroutine
+  subroutine bar(a)
+    character(len=3) :: a(:)
+  end subroutine bar
+end subroutine test
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_16.f90 b/gcc/testsuite/gfortran.dg/argument_checking_16.f90
new file mode 100644
index 000000000..75b2eced1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_16.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR fortran/35152 - implicit procedure with keyword=argument
+
+external bar
+
+call bar(a=5)       ! { dg-error "requires explicit interface" }
+call foo(a=5)       ! { dg-error "requires explicit interface" }
+end
+
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_17.f90 b/gcc/testsuite/gfortran.dg/argument_checking_17.f90
new file mode 100644
index 000000000..df8296ba5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_17.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+!
+! PR fortran/47569
+!
+! Contributed by Jos de Kloe 
+!
+module teststr
+  implicit none
+  integer, parameter :: GRH_SIZE = 20, NMAX = 41624
+  type strtype
+    integer   :: size
+    character :: mdr(NMAX)
+  end type strtype
+contains
+  subroutine sub2(string,str_size)
+    integer,intent(in)    :: str_size
+    character,intent(out) :: string(str_size)
+    string(:) = 'a'
+  end subroutine sub2
+  subroutine sub1(a)
+    type(strtype),intent(inout) :: a
+    call sub2(a%mdr(GRH_SIZE+1),a%size-GRH_SIZE)
+  end subroutine sub1
+end module teststr
+
+! { dg-final { cleanup-modules "teststr" } }
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_18.f90 b/gcc/testsuite/gfortran.dg/argument_checking_18.f90
new file mode 100644
index 000000000..dd95b6197
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_18.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+!
+! PR 47349: missing warning: Actual argument contains too few elements
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+ implicit none
+ type t
+    integer :: j(3)
+ end type t
+
+ type(t) :: tt
+ integer :: i(3) = (/ 1,2,3 /)
+
+ tt%j = i
+
+ call sub1 (i)     ! { dg-warning "Actual argument contains too few elements" }
+ call sub1 (tt%j)  ! { dg-warning "Actual argument contains too few elements" }
+ call sub2 (i)     ! { dg-error "Rank mismatch in argument" }
+ call sub2 (tt%j)  ! { dg-error "Rank mismatch in argument" }
+
+contains
+
+  subroutine sub1(i)
+    integer, dimension(1:3,1:3) :: i
+    print *,"sub1:",i
+  end subroutine
+
+  subroutine sub2(i)
+    integer, dimension(:,:) :: i
+    print *,"sub2:",i
+  end subroutine
+
+end
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_2.f90 b/gcc/testsuite/gfortran.dg/argument_checking_2.f90
new file mode 100644
index 000000000..ba1dd633a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_2.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/30940
+program main
+  implicit none
+  character(len=10) :: digit_string = '123456789', str
+  character :: digit_arr(10)
+  call copy(digit_string, digit_arr)  ! { dg-error "Scalar CHARACTER actual argument with array dummy argument 'in'" }
+  call copy(digit_arr,str)            ! { dg-error "Scalar CHARACTER actual argument with array dummy argument 'out'" }
+  if(str /= '123456789') call abort()
+  digit_string = 'qwertasdf'
+  call copy2(digit_string, digit_arr) ! { dg-error "Scalar CHARACTER actual argument with array dummy argument 'in'" }
+  call copy2(digit_arr,str) ! { dg-error "Scalar CHARACTER actual argument with array dummy argument 'out'" }
+  if(str /= 'qwertasdf') call abort()
+  digit_string = '1qayxsw23e'
+  call copy('1qayxsw23e', digit_arr) ! { dg-error "Scalar CHARACTER actual argument with array dummy argument 'in'" }
+  call copy(digit_arr,str) ! { dg-error "Scalar CHARACTER actual argument with array dummy argument 'out'" }
+  if(str /= '1qayxsw23e') call abort()
+contains
+  subroutine copy(in, out)
+    character, dimension(*)  :: in
+    character, dimension(10) :: out
+    out = in(:10)
+  end subroutine copy
+  subroutine copy2(in, out)
+    character, dimension(2,*)  :: in
+    character, dimension(2,5) :: out
+    out(1:2,1:5) = in(1:2,1:5)
+  end subroutine copy2
+end program main
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_3.f90 b/gcc/testsuite/gfortran.dg/argument_checking_3.f90
new file mode 100644
index 000000000..5f451bf6d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_3.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+!
+! PR fortran/30940
+program test
+implicit none
+interface
+  subroutine foo(a)
+     character(len=1),dimension(:) :: a
+  end subroutine foo
+  subroutine bar(a)
+     character(len=1),dimension(:,:) :: a
+  end subroutine bar
+  subroutine foobar(a)
+     character(len=1),dimension(4) :: a
+  end subroutine foobar
+  subroutine arr(a)
+     character(len=1),dimension(1,2,1,2) :: a
+  end subroutine arr
+end interface
+  character(len=2) :: len2
+  character(len=4) :: len4
+  len2 = '12'
+  len4 = '1234'
+
+  call foo(len2) ! { dg-error "Rank mismatch in argument" }
+  call foo("ca") ! { dg-error "Rank mismatch in argument" }
+  call bar("ca") ! { dg-error "Rank mismatch in argument" }
+  call foobar(len2) ! { dg-warning "contains too few elements" }
+  call foobar(len4)
+  call foobar("bar") ! { dg-warning "contains too few elements" }
+  call foobar("bar33")
+  call arr(len2) ! { dg-warning "contains too few elements" }
+  call arr(len4)
+  call arr("bar") ! { dg-warning "contains too few elements" }
+  call arr("bar33")
+end program test
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_4.f90 b/gcc/testsuite/gfortran.dg/argument_checking_4.f90
new file mode 100644
index 000000000..a2a56e8dd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_4.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+!
+! PR fortran/30940
+program test
+implicit none
+interface
+  subroutine foobar(a)
+     character(len=1),dimension(4) :: a
+  end subroutine foobar
+  subroutine arr(a)
+     character(len=1),dimension(1,2,1,2) :: a
+  end subroutine arr
+end interface
+
+  call foobar( [ "bar" ]) ! { dg-warning "contains too few elements" }
+  call foobar( ["ba ","r33"])
+  call arr( [ "bar" ]) ! { dg-warning "contains too few elements" }
+  call arr( reshape(["b","a","r","3"], [2,2]))
+  call arr( reshape(["b","a"], [1,2])) ! { dg-warning "contains too few elements" }
+  call arr( reshape(["b","a"], [2,1])) ! { dg-warning "contains too few elements" }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_5.f90 b/gcc/testsuite/gfortran.dg/argument_checking_5.f90
new file mode 100644
index 000000000..3715b30cf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_5.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+!
+! PR fortran/30940
+program test
+implicit none
+interface
+  subroutine foobar(x)
+     integer,dimension(4) :: x
+  end subroutine foobar
+  subroutine arr(y)
+     integer,dimension(1,2,1,2) :: y
+  end subroutine arr
+end interface
+
+integer a(3), b(5)
+call foobar(a) ! { dg-warning "contains too few elements" }
+call foobar(b)
+call foobar(b(1:3)) ! { dg-warning "contains too few elements" }
+call foobar(b(1:5))
+call foobar(b(1:5:2)) ! { dg-warning "contains too few elements" }
+call foobar(b(2))
+call foobar(b(3)) ! { dg-warning "Actual argument contains too few elements" }
+call foobar(reshape(a(1:3),[2,1])) ! { dg-warning "contains too few elements" }
+call foobar(reshape(b(2:5),[2,2]))
+
+call arr(a) ! { dg-warning "contains too few elements" }
+call arr(b)
+call arr(b(1:3)) ! { dg-warning "contains too few elements" }
+call arr(b(1:5))
+call arr(b(1:5:2)) ! { dg-warning "contains too few elements" }
+call arr(b(2))
+call arr(b(3)) ! { dg-warning "contains too few elements" }
+call arr(reshape(a(1:3),[2,1])) ! { dg-warning "contains too few elements" }
+call arr(reshape(b(2:5),[2,2]))
+end program test
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_6.f90 b/gcc/testsuite/gfortran.dg/argument_checking_6.f90
new file mode 100644
index 000000000..e2d26923d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_6.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! PR fortran/32669
+!
+! Contributed by Janus Weil <jaydub66@gmail.com>
+!
+program tfe
+implicit none
+
+real,dimension(-1:1) ::  w
+real,dimension(1:4) ::  x
+real,dimension(0:3) ::  y
+real,dimension(-1:2) ::  z
+
+call sub(x(:))
+call sub(y(:))
+call sub(z(:))
+call sub(w(:)) ! { dg-warning "too few elements" }
+
+contains
+  subroutine sub(a)
+    implicit none
+    real,dimension(1:4) :: a
+  end subroutine sub
+end program tfe
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_7.f90 b/gcc/testsuite/gfortran.dg/argument_checking_7.f90
new file mode 100644
index 000000000..0bf76cbb4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_7.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! PR31306 ICE with implicit character variables
+! Test case from PR and prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+module cyclic
+  implicit none
+  contains
+    function ouch(x,y) ! { dg-error "has no IMPLICIT type" }
+      implicit character(len(ouch)) (x) ! { dg-error "used before it is typed" }
+      implicit character(len(x)+1) (y) ! { dg-error "used before it is typed" }
+      implicit character(len(y)-1) (o) ! { dg-error "used before it is typed" }
+      intent(in) x,y
+      character(len(y)-1) ouch ! { dg-error "used before it is typed" }
+      integer i
+      do i = 1, len(ouch)
+        ouch(i:i) = achar(ieor(iachar(x(i:i)),iachar(y(i:i)))) ! { dg-error "Unclassifiable statement" }
+      end do
+      end function ouch
+end module cyclic
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_8.f90 b/gcc/testsuite/gfortran.dg/argument_checking_8.f90
new file mode 100644
index 000000000..05c94f625
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_8.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! PR31306 ICE with implicit character variables
+! Test case from PR and prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+module cyclic
+ implicit none
+ contains
+   character(10) function ouch(x,y)
+     implicit character(len(ouch)) (x)
+     implicit character(len(x)+1) (y)
+     intent(in) x,y
+     integer i
+     do i = 1, len(ouch)
+        ouch(i:i) = achar(ieor(iachar(x(i:i)),iachar(y(i:i))))
+     end do
+   end function ouch
+end module cyclic
+
+program test
+  use cyclic
+  implicit none
+  character(10) astr
+  integer i
+  write(astr,'(a)') ouch('YOW!      ','jerry      ')
+  if (astr(1:5) /= "3*%SY") call abort
+  do i=6,10
+    if (astr(i:i) /= achar(0)) call abort
+  end do    
+end program test
+! { dg-final { cleanup-modules "cyclic" } }
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_9.f90 b/gcc/testsuite/gfortran.dg/argument_checking_9.f90
new file mode 100644
index 000000000..fd7dde33d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_9.f90
@@ -0,0 +1,52 @@
+! { dg-do compile }
+! { dg-options "-fmax-errors=40" }
+! PR33162 INTRINSIC functions as ACTUAL argument
+! Prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+program double_specs
+
+real(kind=4) :: rr, x, y
+real(kind=8) :: dr, dx, dy
+
+x = .5
+y = .7
+dx = .5d0
+dy = .5d0
+
+r = dabs(x) ! { dg-error "must be double precision" }
+r = dacos(x) ! { dg-error "must be double precision" }
+r = dacosh(x) ! { dg-error "must be double precision" }
+r = dasin(x) ! { dg-error "must be double precision" }
+r = dasinh(x) ! { dg-error "must be double precision" }
+r = datan(x) ! { dg-error "must be double precision" }
+r = datanh(x) ! { dg-error "must be double precision" }
+r = datan2(y, dx) ! { dg-error "must be double precision" }
+r = datan2(dy, x) ! { dg-error "must be double precision" }
+r = dbesj0(x) ! { dg-error "must be double precision" }
+r = dbesj1(x) ! { dg-error "must be double precision" }
+r = dbesy0(x) ! { dg-error "must be double precision" }
+r = dbesy1(x) ! { dg-error "must be double precision" }
+r = dcos(x) ! { dg-error "must be double precision" }
+r = dcosh(x) ! { dg-error "must be double precision" }
+r = ddim(x, dy) ! { dg-error "must be double precision" }
+r = ddim(dx, y) ! { dg-error "must be double precision" }
+r = derf(x) ! { dg-error "must be double precision" }
+r = derfc(x) ! { dg-error "must be double precision" }
+r = dexp(x) ! { dg-error "must be double precision" }
+r = dgamma(x) ! { dg-error "must be double precision" }
+r = dlgama(x) ! { dg-error "must be double precision" }
+r = dlog(x) ! { dg-error "must be double precision" }
+r = dlog10(x) ! { dg-error "must be double precision" }
+r = dmod(x, dy) ! { dg-error "must be double precision" }
+r = dmod(dx, y) ! { dg-error "must be double precision" }
+r = dsign(x, dy) ! { dg-error "must be double precision" }
+r = dsign(dx, y) ! { dg-error "must be double precision" }
+r = dsin(x) ! { dg-error "must be double precision" }
+r = dsinh(x) ! { dg-error "must be double precision" }
+r = dsqrt(x) ! { dg-error "must be double precision" }
+r = dtan(x) ! { dg-error "must be double precision" }
+r = dtanh(x) ! { dg-error "must be double precision" }
+dr = dprod(dx,y) ! { dg-error "must be default real" }
+dr = dprod(x,dy) ! { dg-error "must be default real" }
+dr = dprod(x,y)
+
+end program double_specs
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/arith_divide.f b/gcc/testsuite/gfortran.dg/arith_divide.f
new file mode 100644
index 000000000..5140e2c77
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arith_divide.f
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! This test executes all code paths in gfc_arith_divide
+! when executed along with it's companion test
+! arith_divide_no_check.f
+        implicit none
+        integer i,j
+        real a,b
+        complex c,d
+        i = 10/40
+        j = 10/0! { dg-error "Division by zero at" }
+        a = 10.0/40.0
+        b = 10.0/0.0! { dg-error "Division by zero at" }
+        c = (1.0,1.0)/(10.0,40.0) !  Not division by zero
+        d = (1.0,10.)/(0.0,0.0)! { dg-error "Division by zero at" }
+        end
diff --git a/gcc/testsuite/gfortran.dg/arith_divide_no_check.f b/gcc/testsuite/gfortran.dg/arith_divide_no_check.f
new file mode 100644
index 000000000..82ef1c359
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arith_divide_no_check.f
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-fno-range-check" }
+! This test executes all code paths in gfc_arith_divide
+! when executed along with it's companion test
+! arith_divide.f
+
+        implicit none
+        integer i,j
+        real a,b
+        complex c,d
+        i = 10/40
+        j = 10/0! { dg-error "Division by zero at" }
+        a = 10.0/40.0
+        b = 10.0/0.0
+        c = (1.0,1.0)/(10.0,40.0)
+        d = (1.0,10.)/(0.0,0.0)
+        end
diff --git a/gcc/testsuite/gfortran.dg/arithmetic_if.f90 b/gcc/testsuite/gfortran.dg/arithmetic_if.f90
new file mode 100644
index 000000000..16dccae03
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arithmetic_if.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-options "-w" }
+! Test program for PR 28439
+integer function myfunc(i)
+   integer i
+   integer, save :: value = 2
+   value = value - 1 + 0 * i
+   myfunc = value
+end function myfunc
+
+program pr28439
+
+   integer myfunc
+      
+   if (myfunc(0)) 10, 20, 30  ! Should go to 30
+10 call abort
+20 call abort
+
+30 if (myfunc(0)) 40, 50, 60  ! Should go to 50
+40 call abort
+60 call abort
+
+50 if (myfunc(0)) 70, 80, 90  ! Should go to 70
+80 call abort
+90 call abort
+
+70 continue
+
+end program pr28439
+
+
diff --git a/gcc/testsuite/gfortran.dg/arithmetic_overflow_1.f90 b/gcc/testsuite/gfortran.dg/arithmetic_overflow_1.f90
new file mode 100644
index 000000000..b19844f93
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arithmetic_overflow_1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! Fixes PR37787 where the arithmetic overflow was not detected and an ICE ensued.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+program bug
+  implicit none
+   integer(1) :: a(2) = (/ Z'FF', Z'FF' /) ! { dg-error "Arithmetic overflow" }
+   print*, a
+end program bug
diff --git a/gcc/testsuite/gfortran.dg/array_1.f90 b/gcc/testsuite/gfortran.dg/array_1.f90
new file mode 100644
index 000000000..6609025a5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_1.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+! PR 15553 : the array used to be filled with garbage
+! this problem disappeared between 2004-05-20 and 2004-09-15
+program arrpack
+  implicit none
+  
+  double precision x(10,10)
+  integer i, j
+
+  x = -1
+  do i=1,6
+     do j=1,5
+        x(i,j) = i+j*10
+     end do
+  end do
+  call pack (x, 6, 5)
+
+  if (any(reshape(x(1:10,1:3), (/ 30 /)) & 
+          /= (/ 11, 12, 13, 14, 15, 16,  &
+                21, 22, 23, 24, 25, 26,  &
+                31, 32, 33, 34, 35, 36,  &
+                41, 42, 43, 44, 45, 46,  &
+                51, 52, 53, 54, 55, 56 /))) call abort ()
+  
+contains
+  
+  subroutine pack (arr, ni, nj)
+    integer, intent(in) :: ni, nj
+    double precision, intent(inout) :: arr(:,:)
+    double precision :: tmp(ni,nj)
+    tmp(:,:) = arr(1:ni, 1:nj)
+    call copy (arr, tmp, ni, nj)
+  end subroutine pack
+  
+  subroutine copy (dst, src, ni, nj)
+    integer, intent(in) :: ni, nj
+    double precision, intent(out) :: dst(ni, nj)
+    double precision, intent(in)  :: src(ni, nj)
+    dst = src
+  end subroutine copy
+  
+end program arrpack
diff --git a/gcc/testsuite/gfortran.dg/array_2.f90 b/gcc/testsuite/gfortran.dg/array_2.f90
new file mode 100644
index 000000000..d182f044a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_2.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! PR tree-optimization/30092
+! This caused once an ICE due to internal tree changes
+program test
+  implicit none
+  integer, parameter :: N = 30
+  real, dimension(N) :: rho, pre, cs
+  real               :: gamma
+  gamma = 2.1314
+  rho = 5.0
+  pre = 3.0
+  call EOS(N, rho, pre, cs, gamma)
+  if (abs(CS(1) - sqrt(gamma*pre(1)/rho(1))) > epsilon(cs)) &
+     call abort()
+contains
+      SUBROUTINE EOS(NODES, DENS, PRES, CS, CGAMMA)
+      IMPLICIT NONE
+      INTEGER NODES
+      REAL CGAMMA
+      REAL, DIMENSION(NODES) :: DENS, PRES, CS
+      REAL, PARAMETER :: RGAS = 8.314
+      CS(:NODES) = SQRT(CGAMMA*PRES(:NODES)/DENS(:NODES))
+      END SUBROUTINE EOS
+end program test
diff --git a/gcc/testsuite/gfortran.dg/array_3.f90 b/gcc/testsuite/gfortran.dg/array_3.f90
new file mode 100644
index 000000000..26879ffaa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_3.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! PR31610 ICE with transfer, merge in gfc_conv_expr_descriptor
+  integer :: i(1) = 1
+  integer :: foo(3)
+  integer :: n(1)
+  foo(1) = 17
+  foo(2) = 55
+  foo(3) = 314
+  print *, i, foo
+  write(*,*) foo([1]), foo([1]+i), [1]+1
+  n = foo([1]+i)
+  print *, n, shape(foo([1]+i)), shape(foo(i+[1]))
+end
diff --git a/gcc/testsuite/gfortran.dg/array_4.f90 b/gcc/testsuite/gfortran.dg/array_4.f90
new file mode 100644
index 000000000..869522af0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_4.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! PR fortran/36824
+!
+! Dimension of tgclist was not recognized as having constant bounds
+!
+program test
+implicit none
+integer, dimension( 3 ), parameter :: tgc = (/5, 6, 7 /)
+type tgccomp
+   integer, dimension( tgc( 1 ) : tgc( 2 ) ) :: tgclist
+end type tgccomp
+end program
diff --git a/gcc/testsuite/gfortran.dg/array_alloc_1.f90 b/gcc/testsuite/gfortran.dg/array_alloc_1.f90
new file mode 100644
index 000000000..17be757a9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_alloc_1.f90
@@ -0,0 +1,21 @@
+! PR 21104.  Make sure that either f() or its caller will allocate
+! the array data.  We've decided to make the caller allocate it.
+! { dg-do run }
+program main
+  implicit none
+  call test (f ())
+contains
+  subroutine test (x)
+    integer, dimension (10) :: x
+    integer :: i
+    do i = 1, 10
+      if (x (i) .ne. i * 100) call abort
+    end do
+  end subroutine test
+
+  function f ()
+    integer, dimension (10) :: f
+    integer :: i
+    forall (i = 1:10) f (i) = i * 100
+  end function f
+end program main
diff --git a/gcc/testsuite/gfortran.dg/array_alloc_2.f90 b/gcc/testsuite/gfortran.dg/array_alloc_2.f90
new file mode 100644
index 000000000..a225854f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_alloc_2.f90
@@ -0,0 +1,38 @@
+! Like array_alloc_1.f90, but check cases in which the array length is
+! not a literal constant.
+! { dg-do run }
+program main
+  implicit none
+  integer, parameter :: n = 100
+  call test (n, f1 ())
+  call test (47, f2 (50))
+  call test (n, f3 (f1 ()))
+contains
+  subroutine test (expected, x)
+    integer, dimension (:) :: x
+    integer :: i, expected
+    if (size (x, 1) .ne. expected) call abort
+    do i = 1, expected
+      if (x (i) .ne. i * 100) call abort
+    end do
+  end subroutine test
+
+  function f1 ()
+    integer, dimension (n) :: f1
+    integer :: i
+    forall (i = 1:n) f1 (i) = i * 100
+  end function f1
+
+  function f2 (howmuch)
+    integer :: i, howmuch
+    integer, dimension (4:howmuch) :: f2
+    forall (i = 4:howmuch) f2 (i) = i * 100 - 300
+  end function f2
+
+  function f3 (x)
+    integer, dimension (:) :: x
+    integer, dimension (size (x, 1)) :: f3
+    integer :: i
+    forall (i = 1:size(x)) f3 (i) = i * 100
+  end function f3
+end program main
diff --git a/gcc/testsuite/gfortran.dg/array_alloc_3.f90 b/gcc/testsuite/gfortran.dg/array_alloc_3.f90
new file mode 100644
index 000000000..5e27297b1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_alloc_3.f90
@@ -0,0 +1,35 @@
+! Like array_alloc_1.f90, but check multi-dimensional arrays.
+! { dg-do run }
+program main
+  implicit none
+  call test ((/ 3, 4, 5 /), f ((/ 3, 4, 5 /)))
+contains
+  subroutine test (expected, x)
+    integer, dimension (:,:,:) :: x
+    integer, dimension (3) :: expected
+    integer :: i, i1, i2, i3
+    do i = 1, 3
+      if (size (x, i) .ne. expected (i)) call abort
+    end do
+    do i1 = 1, expected (1)
+      do i2 = 1, expected (2)
+        do i3 = 1, expected (3)
+          if (x (i1, i2, i3) .ne. i1 + i2 * 10 + i3 * 100) call abort
+        end do
+      end do
+    end do
+  end subroutine test
+
+  function f (x)
+    integer, dimension (3) :: x
+    integer, dimension (x(1), x(2), x(3)) :: f
+    integer :: i1, i2, i3
+    do i1 = 1, x(1)
+      do i2 = 1, x(2)
+        do i3 = 1, x(3)
+          f (i1, i2, i3) = i1 + i2 * 10 + i3 * 100
+        end do
+      end do
+    end do
+  end function f
+end program main
diff --git a/gcc/testsuite/gfortran.dg/array_assignment_1.F90 b/gcc/testsuite/gfortran.dg/array_assignment_1.F90
new file mode 100644
index 000000000..328107011
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_assignment_1.F90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! { dg-options "-ffree-line-length-none" }
+! Test that different array assignments work even when interleaving,
+! reversing etc.  Make sure the results from assignment with constants
+! as array triples and runtime array triples (where we always create
+! a temporary) match.
+#define TST(b,c,d,e,f,g,r) a=init; a(b:c:d) = a(e:f:g); \
+       write(unit=line ,fmt="(9I1)") a;\
+       if (line /= r) call abort ; \
+       call mytst(b,c,d,e,f,g,r);
+
+program main
+  implicit none
+  integer :: i
+  integer, parameter :: n=9
+  integer,  dimension(n) :: a
+  character(len=n) :: line
+  integer, dimension(n), parameter :: init = (/(i,i=1,n)/)
+  TST(2,n,2,1,n-1,2,'113355779')
+  TST(3,9,3,2,6,2,'122454786');
+  TST(1,8,2,3,9,2,'325476989');
+  TST(1,6,1,4,9,1,'456789789');
+  TST(9,5,-1,1,5,1,'123454321');
+  TST(9,5,-2,1,5,2,'123456381');
+  TST(5,9,2,5,1,-2,'123456381');
+  TST(1,6,1,2,7,1,'234567789');
+  TST(2,7,1,1,6,1,'112345689');
+end program main
+
+subroutine mytst(b,c,d,e,f,g,r)
+  integer,intent(in) :: b,c,d,e,f,g
+  character(len=9), intent(in) :: r
+  character(len=9) :: line
+  integer, dimension(9) :: a
+  a = (/(i,i=1,9)/)
+  a(b:c:d) = a(e:f:g)
+  write (unit=line,fmt='(9I1)') a
+  if (line /= r) call abort
+end subroutine mytst
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_1.f90 b/gcc/testsuite/gfortran.dg/array_constructor_1.f90
new file mode 100644
index 000000000..0ba8ba0d0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_1.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! Check that [...] style array constructors work
+program bracket_array_constructor
+    implicit none
+    integer :: a(4), i
+
+    a = [ 1, 2, 3, 4 ]
+    do i = 1, size(a)
+        if (a(i) /= i) call abort()
+    end do
+
+    a = [ (/ 1, 2, 3, 4 /) ]
+    do i = 1, size(a)
+        if (a(i) /= i) call abort()
+    end do
+
+end program bracket_array_constructor
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_10.f90 b/gcc/testsuite/gfortran.dg/array_constructor_10.f90
new file mode 100644
index 000000000..c439e0c7f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_10.f90
@@ -0,0 +1,27 @@
+! Like array_constructor_6.f90, but check constructors that apply
+! an elemental function to an array.
+! { dg-do run }
+program main
+  implicit none
+  call build (200)
+contains
+  subroutine build (order)
+    integer :: order, i
+
+    call test (order, (/ (abs ((/ i, -i, -i * 2 /)), i = 1, order) /))
+    call test (order, abs ((/ ((/ -i, -i, i * 2 /), i = 1, order) /)))
+    call test (order, (/ abs ((/ ((/ i, i, -i * 2 /), i = 1, order) /)) /))
+  end subroutine build
+
+  subroutine test (order, values)
+    integer, dimension (3:) :: values
+    integer :: order, i
+
+    if (size (values, dim = 1) .ne. order * 3) call abort
+    do i = 1, order
+      if (values (i * 3) .ne. i) call abort
+      if (values (i * 3 + 1) .ne. i) call abort
+      if (values (i * 3 + 2) .ne. i * 2) call abort
+    end do
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_11.f90 b/gcc/testsuite/gfortran.dg/array_constructor_11.f90
new file mode 100644
index 000000000..bb9f0dddb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_11.f90
@@ -0,0 +1,47 @@
+! Like array_constructor_6.f90, but check iterators with non-default stride,
+! including combinations which lead to zero-length vectors.
+! { dg-do run }
+program main
+  implicit none
+  call build (77)
+contains
+  subroutine build (order)
+    integer :: order, i, j
+
+    call test (1, 11, 3, (/ (i, i = 1, 11, 3) /))
+    call test (3, 20, 2, (/ (i, i = 3, 20, 2) /))
+    call test (4, 0, 11, (/ (i, i = 4, 0, 11) /)) ! { dg-warning "will be executed zero times" }
+
+    call test (110, 10, -3,  (/ (i, i = 110, 10, -3) /))
+    call test (200, 20, -12, (/ (i, i = 200, 20, -12) /))
+    call test (29, 30, -6,   (/ (i, i = 29, 30, -6) /)) ! { dg-warning "will be executed zero times" }
+
+    call test (1, order, 3,  (/ (i, i = 1, order, 3) /))
+    call test (order, 1, -3, (/ (i, i = order, 1, -3) /))
+
+    ! Triggers compile-time iterator calculations in trans-array.c
+    call test (1, 1000, 2,   (/ (i, i = 1, 1000, 2),   (i, i = order, 0, 1) /))
+    call test (1, 0, 3,      (/ (i, i = 1, 0, 3),      (i, i = order, 0, 1) /)) ! { dg-warning "will be executed zero times" }
+    call test (1, 2000, -5,  (/ (i, i = 1, 2000, -5),  (i, i = order, 0, 1) /)) ! { dg-warning "will be executed zero times" }
+    call test (3000, 99, 4,  (/ (i, i = 3000, 99, 4),  (i, i = order, 0, 1) /)) ! { dg-warning "will be executed zero times" }
+    call test (400, 77, -39, (/ (i, i = 400, 77, -39), (i, i = order, 0, 1) /))
+
+    do j = -10, 10
+      call test (order + j, order, 5,  (/ (i, i = order + j, order, 5) /))
+      call test (order + j, order, -5, (/ (i, i = order + j, order, -5) /))
+    end do
+
+  end subroutine build
+
+  subroutine test (from, to, step, values)
+    integer, dimension (:) :: values
+    integer :: from, to, step, last, i
+
+    last = 0
+    do i = from, to, step
+      last = last + 1
+      if (values (last) .ne. i) call abort
+    end do
+    if (size (values, dim = 1) .ne. last) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_12.f90 b/gcc/testsuite/gfortran.dg/array_constructor_12.f90
new file mode 100644
index 000000000..082e90ecc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_12.f90
@@ -0,0 +1,51 @@
+! Like array_constructor_6.f90, but check integer(8) iterators.
+! { dg-do run }
+program main
+  integer (kind = 8) :: i, l8, u8, step8
+  integer (kind = 4) :: l4, step4
+  integer (kind = 8), parameter :: big = 10000000000_8
+
+  l4 = huge (l4)
+  u8 = l4 + 10_8
+  step4 = 2
+  call test ((/ (i, i = l4, u8, step4) /), l4 + 0_8, u8, step4 + 0_8)
+
+  l8 = big
+  u8 = big * 20
+  step8 = big
+  call test ((/ (i, i = l8, u8, step8) /), l8, u8, step8)
+
+  u8 = big + 100
+  l8 = big
+  step4 = -20
+  call test ((/ (i, i = u8, l8, step4) /), u8, l8, step4 + 0_8)
+
+  u8 = big * 40
+  l8 = big * 20
+  step8 = -big * 2
+  call test ((/ (i, i = u8, l8, step8) /), u8, l8, step8)
+
+  u8 = big
+  l4 = big / 100
+  step4 = -big / 500
+  call test ((/ (i, i = u8, l4, step4) /), u8, l4 + 0_8, step4 + 0_8)
+
+  u8 = big * 40 + 200
+  l4 = 200
+  step8 = -big
+  call test ((/ (i, i = u8, l4, step8) /), u8, l4 + 0_8, step8)
+contains
+  subroutine test (a, l, u, step)
+    integer (kind = 8), dimension (:), intent (in) :: a
+    integer (kind = 8), intent (in) :: l, u, step
+    integer (kind = 8) :: i
+    integer :: j
+
+    j = 1
+    do i = l, u, step
+      if (a (j) .ne. i) call abort
+      j = j + 1
+    end do
+    if (size (a, 1) .ne. j - 1) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_13.f90 b/gcc/testsuite/gfortran.dg/array_constructor_13.f90
new file mode 100644
index 000000000..74f3d497a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_13.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! Tests patch for PR29431, which arose from PR29373.
+!
+! Contributed by Tobias Schlueter  <tobi@gcc.gnu.org>
+!
+  implicit none
+  CHARACTER(len=6), DIMENSION(2,2)  :: a
+
+! Reporters original triggered another error:
+! gfc_todo: Not Implemented: complex character array
+! constructors.
+
+  a = reshape([to_string(1.0), trim("abcdef"), &
+               to_string(7.0), trim("hijklm")], &
+               [2, 2])
+  print *, a
+
+  CONTAINS
+    FUNCTION to_string(x)
+      character*6 to_string
+      REAL, INTENT(in) :: x
+      WRITE(to_string, FMT="(F6.3)") x
+    END FUNCTION
+end
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_14.f90 b/gcc/testsuite/gfortran.dg/array_constructor_14.f90
new file mode 100644
index 000000000..f2f89cd04
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_14.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+
+subroutine foo(x)
+  integer :: x(4)
+  x(:) = (/ 3, 1, 4, 1 /)
+end subroutine
+
+subroutine bar(x)
+  integer :: x(4)
+  x = (/ 3, 1, 4, 1 /)
+end subroutine
+
+! { dg-final { scan-tree-dump-times "data" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_15.f90 b/gcc/testsuite/gfortran.dg/array_constructor_15.f90
new file mode 100644
index 000000000..71260169d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_15.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+  integer :: x(2,2)
+  if (any(x(:,:) .ne. reshape ((/ 3, 1, 4, 1 /), (/ 2, 2 /)))) call abort ()
+end
+! { dg-final { scan-tree-dump-times "atmp" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_16.f90 b/gcc/testsuite/gfortran.dg/array_constructor_16.f90
new file mode 100644
index 000000000..7c2e8d156
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_16.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! Tests the fix for PR31204, in which 'i' below would be incorrectly
+! host associated by the contained subroutines.  The checks for 'ii'
+! and 'iii' have been added, since they can be host associated because
+! of the explicit declarations in the main program.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+  integer ii
+  INTEGER, PARAMETER :: jmin(1:10) = (/ (i, i = 1, 10) /)
+  INTEGER, PARAMETER :: kmin(1:10) = (/ (ii, ii = 1, 10) /)
+  INTEGER, PARAMETER :: lmin(1:10) = (/ (iii, iii = 1, 10) /)
+  integer iii
+  CALL two
+
+CONTAINS
+
+  SUBROUTINE one
+    i = 99
+    ii = 99
+    iii = 999
+  END SUBROUTINE
+
+  SUBROUTINE two
+    i = 0
+    ii = 0
+    iii = 0
+    CALL one
+    IF (i .NE. 0) CALL ABORT ()
+    IF (ii .NE. 99) CALL ABORT ()
+    IF (iii .NE. 999) CALL ABORT ()
+  END SUBROUTINE
+END
+
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_17.f90 b/gcc/testsuite/gfortran.dg/array_constructor_17.f90
new file mode 100644
index 000000000..3ce7a9183
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_17.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! Tests the fix for PR31219, in which the character length of
+! the functions in the array constructor was not being obtained
+! correctly and this caused an ICE.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+  INTEGER :: J
+  CHARACTER(LEN = 8) :: str
+  J = 3
+  write (str,'(2A4)') (/( F(I, J), I = 1, 2)/)
+  IF (str .NE. " ODD EVE") call abort ()
+
+! Comment #1 from F-X Coudert (noted by T. Burnus) that
+! actually exercises a different part of the bug.
+  call gee( (/g (3)/) )
+
+CONTAINS
+  FUNCTION F (K,J) RESULT(I)
+    INTEGER :: K, J
+    CHARACTER(LEN = J) :: I
+    IF (MODULO (K, 2) .EQ. 0) THEN
+       I = "EVEN"
+    ELSE
+       I = "ODD"
+    ENDIF
+  END FUNCTION
+
+  function g(k) result(i)
+    integer :: k
+    character(len = k) :: i
+    i = '1234'
+  end function
+  subroutine gee(a)
+    character(*),dimension(1) :: a
+    if(len (a) /= 3) call abort ()
+    if(a(1) /= '123') call abort ()
+  end subroutine gee
+
+END
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_18.f90 b/gcc/testsuite/gfortran.dg/array_constructor_18.f90
new file mode 100644
index 000000000..c78976839
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_18.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! Tests the fix for PR32875, in which the character length for the
+! array constructor would get lost in simplification and would lead
+! the error 'Not Implemented: complex character array constructor'.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+  call foo ((/(S1(i),i=1,3,-1)/)) ! { dg-warning "will be executed zero times" }
+CONTAINS
+  FUNCTION S1(i)
+    CHARACTER(LEN=1) :: S1
+    INTEGER :: I
+    S1="123456789"(i:i)
+  END FUNCTION S1
+  subroutine foo (chr)
+    character(1) :: chr(:)
+    print *, chr
+  end subroutine
+END
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_19.f90 b/gcc/testsuite/gfortran.dg/array_constructor_19.f90
new file mode 100644
index 000000000..460a34f5c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_19.f90
@@ -0,0 +1,17 @@
+! Simplification of unary and binary expressions containing
+! array constructors.
+!
+! See PR33288
+!
+! { dg-do run }
+  real, parameter :: x(1) = 42
+  real, parameter :: x1(1) = (/ x /) + 1
+  real, parameter :: x2(1) = 1 + (/ x /)
+  real, parameter :: x3(1) = -(/ x /)
+  real, parameter :: x4(2) = (/ x, 1. /) + (/ 2, (/3/) /)
+
+  if (any (x1 /= (/43./))) call abort
+  if (any (x2 /= (/43./))) call abort
+  if (any (x3 /= (/-42./))) call abort
+  if (any (x4 /= (/44., 4./))) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_2.f90 b/gcc/testsuite/gfortran.dg/array_constructor_2.f90
new file mode 100644
index 000000000..ffed1f0fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_2.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! Check that array constructor delimiters match
+program bracket_array_constr_2
+    implicit none
+    integer :: a(4)
+    a = (/ 1, 2, 3, 4 ] ! { dg-error "array constructor" }
+    a = (/ [ 1, 2, 3, 4 /) ] ! { dg-error "array constructor" }
+end program bracket_array_constr_2
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_20.f90 b/gcc/testsuite/gfortran.dg/array_constructor_20.f90
new file mode 100644
index 000000000..de7246d20
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_20.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+!
+! PR fortran/34784, in which the intrinsic expression would be
+! given the implicit type.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+MODULE m
+  implicit character(s)
+  INTEGER :: I(1) = (/ (SELECTED_INT_KIND(J),J=1,1) /)
+END MODULE m
+
+MODULE s_TESTS
+  IMPLICIT CHARACTER (P)
+CONTAINS
+  subroutine simple (u,j1)
+    optional ::  j1
+    if (present (j1)) stop
+  end subroutine
+END MODULE s_TESTS
+
+! { dg-final { cleanup-modules "m s_TESTS" } }
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_21.f90 b/gcc/testsuite/gfortran.dg/array_constructor_21.f90
new file mode 100644
index 000000000..f9e612cef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_21.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+!
+! PR fortran/34785, in which the character length of BA_T was not
+! passed on to the array constructor argument of SEQ.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+      MODULE o_TYPE_DEFS
+        implicit none
+        TYPE SEQ
+          SEQUENCE
+          CHARACTER(len = 9) ::  BA(2)
+        END TYPE SEQ
+        CHARACTER(len = 9)   ::  BA_T(2)
+        CHARACTER(LEN = 9)   ::  CA_T(1,2)
+      END MODULE o_TYPE_DEFS
+
+      MODULE TESTS
+        use o_type_defs
+        implicit none
+      CONTAINS
+        SUBROUTINE OG0015(UDS0L)
+          TYPE(SEQ)          UDS0L
+          integer :: j1
+          UDS0L = SEQ((/ (BA_T(J1),J1=1,2) /))
+        END SUBROUTINE
+      END MODULE TESTS
+
+      use o_type_defs
+      CONTAINS
+        SUBROUTINE OG0015(UDS0L)
+          TYPE(SEQ)          UDS0L
+          UDS0L = SEQ(RESHAPE ( (/ ((CA_T(J1,J2), J1 = 1, 1), J2 = 1, 2)/),(/2/)))
+        END SUBROUTINE
+      END
+! { dg-final { cleanup-modules "o_TYPE_DEFS TESTS" } }
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_22.f90 b/gcc/testsuite/gfortran.dg/array_constructor_22.f90
new file mode 100644
index 000000000..0dcdaea68
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_22.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! PR34990 ICE in gfc_typenode_for_spec, at fortran/trans-types.c:842
+! Test case that of the reporters.
+module test 
+   implicit none 
+   contains 
+      function my_string(x) 
+         integer i 
+         real, intent(in) :: x(:) 
+         character(0) h4(1:minval([(1,i=1,0)],1)) ! { dg-warning "will be executed zero times" }
+         character(0) sv1(size(x,1):size(h4)) 
+         character(0) sv2(2*lbound(sv1,1):size(h4)) 
+         character(lbound(sv2,1)-3) my_string 
+
+         do i = 1, len(my_string) 
+            my_string(i:i) = achar(modulo(i-1,10)+iachar('0')) 
+         end do 
+      end function my_string 
+end module test 
+
+program len_test 
+   use test 
+   implicit none 
+   real x(7) 
+
+   write(*,*) my_string(x) 
+end program len_test
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_23.f b/gcc/testsuite/gfortran.dg/array_constructor_23.f
new file mode 100644
index 000000000..fa0a28a1f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_23.f
@@ -0,0 +1,48 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+! Tests the fix for PR35944/6/7, in which the variable array constructors below
+! were incorrectly translated and wrong code was produced.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+      program try_fa6013
+      call fa6013 (10, 1, -1)
+      call fa6077 (10, 1, -1, (/1,2,3,4,5,6,7,8,9,10/))
+      call fa2083
+      end program
+
+      subroutine  FA6013 (nf10, nf1, mf1)
+      integer, parameter :: kv = 4
+      REAL(KV) DDA1(10)
+      REAL(KV) DDA2(10)
+      REAL(KV) DDA(10), dval
+      dda = (/1,2,3,4,5,6,7,8,9,10/)
+      DDA1 = ATAN2 ((/(REAL(J1,KV),J1=1,10)/),
+     $                 REAL((/(J1,J1=nf10,nf1,mf1)/), KV))   !fails
+      DDA2 = ATAN2 (DDA, DDA(10:1:-1))
+      if (any (DDA1 - DDA2 .gt. epsilon(dval))) call abort ()
+      END
+
+      subroutine FA6077 (nf10,nf1,mf1, ida)
+      INTEGER IDA1(10)
+      INTEGER IDA2(10), ida(10)
+      IDA1 = IEOR((/1,2,3,4,5,6,7,8,9,10/),
+     $            (/(IDA(J1),J1=10,1,-1)/) )
+      IDA2 = IEOR ((/1,2,3,4,5,6,7,8,9,10/), (/10,9,8,7,6,5,4,3,2,1/) )
+      if (any (ida1 .ne. ida2)) call abort ()
+      END SUBROUTINE
+
+      subroutine fa2083
+      implicit none
+      integer j1,k
+      parameter (k=selected_real_kind (precision (0.0_8) + 1)) ! failed
+      REAL(k) QDA1(10)
+      REAL(k) QDA(10), qval
+      qda = (/ 1,2,3,4,5,6,7,8,9,10 /)
+      QDA1 = MOD ( 1.1_k*( QDA(1) -5.0_k), P=( QDA -2.5_k))
+      DO J1 = 1,10
+        QVAL = MOD(1.1_k*(QDA(1)-5.0_k),P=(QDA(J1)-2.5_k))
+        if (qval - qda1(j1) .gt. epsilon(qval)) call abort ()
+      ENDDO
+      END
+
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_24.f b/gcc/testsuite/gfortran.dg/array_constructor_24.f
new file mode 100644
index 000000000..ee7b55694
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_24.f
@@ -0,0 +1,47 @@
+! { dg-do run }
+! Tests the fix for PR35944/6/7, in which the variable array constructors below
+! were incorrectly translated and wrong code was produced.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+      program try_fa6013
+      call fa6013 (10, 1, -1)
+      call fa6077 (10, 1, -1, (/1,2,3,4,5,6,7,8,9,10/))
+      call fa2083
+      end program
+
+      subroutine  FA6013 (nf10, nf1, mf1)
+      integer, parameter :: kv = 4
+      REAL(KV) DDA1(10)
+      REAL(KV) DDA2(10)
+      REAL(KV) DDA(10), dval
+      dda = (/1,2,3,4,5,6,7,8,9,10/)
+      DDA1 = ATAN2 ((/(REAL(J1,KV),J1=1,10)/),
+     $                 REAL((/(J1,J1=nf10,nf1,mf1)/), KV))   !fails
+      DDA2 = ATAN2 (DDA, DDA(10:1:-1))
+      if (any (abs(DDA1-DDA2) .gt. 1.0e-6)) call abort ()
+      END
+
+      subroutine FA6077 (nf10,nf1,mf1, ida)
+      INTEGER IDA1(10)
+      INTEGER IDA2(10), ida(10)
+      IDA1 = IEOR((/1,2,3,4,5,6,7,8,9,10/),
+     $            (/(IDA(J1),J1=10,1,-1)/) )
+      IDA2 = IEOR ((/1,2,3,4,5,6,7,8,9,10/), (/10,9,8,7,6,5,4,3,2,1/) )
+      if (any (ida1 .ne. ida2)) call abort ()
+      END SUBROUTINE
+
+      subroutine fa2083
+      implicit none
+      integer j1,k
+      parameter (k=8)              !failed for k=10
+      REAL(k) QDA1(10)
+      REAL(k) QDA(10), qval
+      qda = (/ 1,2,3,4,5,6,7,8,9,10 /)
+      QDA1 = MOD ( 1.1_k*( QDA(1) -5.0_k), P=( QDA -2.5_k))
+      DO J1 = 1,10
+        QVAL = MOD(1.1_k*(QDA(1)-5.0_k),P=(QDA(J1)-2.5_k))
+        if (qval .ne. qda1(j1)) call abort ()
+      ENDDO
+      END
+
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_25.f03 b/gcc/testsuite/gfortran.dg/array_constructor_25.f03
new file mode 100644
index 000000000..b18746815
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_25.f03
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! PR fortran/36492
+! Check for incorrect error message with -std=f2003.
+! Reduced test based on the one from comment #4, PR 36492.
+
+type t
+  character (2) :: arr (1) = [ "a" ]
+end type t
+
+end
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_26.f03 b/gcc/testsuite/gfortran.dg/array_constructor_26.f03
new file mode 100644
index 000000000..622bb515e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_26.f03
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-std=gnu" }
+
+! PR fortran/36492
+! Check for incorrect error message with -std=f2003.
+! Test from comment #4, PR 36492 causing ICE.
+
+MODULE WinData
+  IMPLICIT NONE
+  INTEGER (1), PARAMETER :: MAXFLD = 25_1, MAXHED = 5_1, MAXCHR = 80_1
+  integer :: i
+  TYPE TWindowData
+    CHARACTER (MAX_FLD_HED, 1) :: DWFdHd(MAXFLD) = [(" ", i = 1, MAXFLD)]
+    ! { dg-error "no IMPLICIT type" "" { target *-*-* } 13 }
+    ! { dg-error "specification expression" "" { target *-*-* } 13 }
+  END TYPE TWindowData
+END MODULE WinData
+
+! { dg-final { cleanup-modules "WinData" } }
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_27.f03 b/gcc/testsuite/gfortran.dg/array_constructor_27.f03
new file mode 100644
index 000000000..8068364ce
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_27.f03
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-std=gnu" }
+
+! PR fortran/36492
+! Check for incorrect error message with -std=f2003.
+! Reduced test triggering the ICE mentioned in comment #4, PR 36492.
+
+implicit none
+
+type t
+  character (a) :: arr (1) = [ "a" ]
+  ! { dg-error "no IMPLICIT type" "" { target *-*-* } 11 }
+  ! { dg-error "specification expression" "" { target *-*-* } 11 }
+end type t
+
+end
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_28.f03 b/gcc/testsuite/gfortran.dg/array_constructor_28.f03
new file mode 100644
index 000000000..382e49aef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_28.f03
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! PR fortran/36492
+! Check that the error is still emitted for really incorrect constructor.
+
+type t
+  character (2) :: arr (2) = [ "a", "ab" ] ! { dg-error "Different CHARACTER" }
+end type t
+
+end
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_29.f03 b/gcc/testsuite/gfortran.dg/array_constructor_29.f03
new file mode 100644
index 000000000..03534fa81
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_29.f03
@@ -0,0 +1,13 @@
+! { dg-do compile }
+
+! PR fortran/36492
+! Similar to the ICE-test, but now test it works for real constants.
+
+implicit none
+
+integer, parameter :: a = 42
+type t
+  character (a) :: arr (1) = [ "a" ]
+end type t
+
+end
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_3.f90 b/gcc/testsuite/gfortran.dg/array_constructor_3.f90
new file mode 100644
index 000000000..7ddd1f419
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_3.f90
@@ -0,0 +1,5 @@
+! { dg-do compile }
+! Check that empty array constructors are rejected
+program hum
+    print *, (//)  { dg-error "Empty array constructor" }
+end program hum
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_30.f03 b/gcc/testsuite/gfortran.dg/array_constructor_30.f03
new file mode 100644
index 000000000..587ce0397
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_30.f03
@@ -0,0 +1,16 @@
+! { dg-do compile }
+
+! PR fortran/36492
+! Similar to the ICE-test, but now test for complaint about constant
+! specification expression.
+
+implicit none
+
+integer :: a = 42
+type t
+  character (a) :: arr (1) = [ "a" ]
+  ! { dg-error "in the expression" "" { target *-*-* } 11 }
+  ! { dg-error "specification expression" "" { target *-*-* } 11 }
+end type t
+
+end
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_31.f90 b/gcc/testsuite/gfortran.dg/array_constructor_31.f90
new file mode 100644
index 000000000..02936340f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_31.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! Test the fix for pr40018 in which the elements in the array
+! constructor would be of default type and this would cause an
+! ICE in the backend because of the type mistmatch with 'i'.
+!
+! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!
+  integer(kind=8) :: i
+  write(*,*) [(i, i = 1, 10)]
+  end
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_32.f90 b/gcc/testsuite/gfortran.dg/array_constructor_32.f90
new file mode 100644
index 000000000..5cf49aee7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_32.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! PR41807  data statement with nested type constructors
+! Test case provided by Steve Kargl
+  implicit none
+
+  type :: a
+     real :: x(3)
+  end type a
+
+  integer, parameter :: n = 3
+
+  type(a) :: b(n)
+
+  real, parameter :: d1(3) = (/1., 2., 3./)
+  real, parameter :: d2(3) = (/4., 5., 6./)
+  real, parameter :: d3(3) = (/7., 8., 9./)
+
+  integer :: i, z(n)
+ 
+  data (b(i), i = 1, n) /a(d1), a(d2), a(d3)/
+  data (z(i), i = 1, n) / 1, 2, 3/
+
+  if (any(z.ne.[1, 2, 3])) call abort
+  if (any(b(1)%x.ne.[1, 2, 3]) .or. &
+      any(b(2)%x.ne.[4, 5, 6]) .or. &
+      any(b(3)%x.ne.[7, 8, 9])) call abort
+end
+
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_33.f90 b/gcc/testsuite/gfortran.dg/array_constructor_33.f90
new file mode 100644
index 000000000..79118af3f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_33.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-timeout-factor 4 }
+! PR20923 gfortran slow for large array constructors.
+! Test case prepared from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+program sel
+    implicit none
+    integer(kind=4),parameter      :: n=1000
+    integer(kind=4)                :: i,j
+    real(kind=4),dimension(n*n)    :: vect
+    vect(:) = (/ ((( (i+j+3)),i=1,n),j=1,n) /)
+end
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_34.f90 b/gcc/testsuite/gfortran.dg/array_constructor_34.f90
new file mode 100644
index 000000000..1a0931a3f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_34.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! PR32489 Endless loop when compiling.
+! Derived from fft257.f90, Public domain 2004 James Van Buskirk.
+! Note: The problem solved here was not an infinite loop issue. Middle-end
+! could not handle the array constructor unfolded by the front end.
+! WARNING: Potential resource hog.
+! Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program test
+   implicit none
+   integer, parameter :: dp = selected_real_kind(15,300)
+   integer, parameter :: N = 257
+   complex(dp) h1(0:N-1)
+   complex(dp) h2(0:N-1)
+   complex(dp) hh(0:N-1)
+   complex(dp), parameter :: ri(2) = (/(1,0),(0,1)/)
+   integer i, j, k, L
+   real(dp) pi
+
+   pi = 4*atan(1.0_dp)
+   do i = 0, N-1
+     do j = 1, 2
+       h2 = 0
+       h2(i) = ri(j)
+       h1 = (/(sum((/(exp(-2*pi*(0,1)*mod(k*L,N)/N)*h2(L),L=0,N-1)/)),k=0,N-1)/)
+     end do
+   end do
+end program test 
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_35.f90 b/gcc/testsuite/gfortran.dg/array_constructor_35.f90
new file mode 100644
index 000000000..fddd1e952
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_35.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR42999  bogus error: Parameter 'i' at (1) has not been declared
+! or is a variable, which does not reduce to a constant expression
+ TYPE DD
+  INTEGER :: I
+ END TYPE DD
+ TYPE(DD) :: X(2)=(/(DD(I),I=1,2)/)
+ END
+
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_36.f90 b/gcc/testsuite/gfortran.dg/array_constructor_36.f90
new file mode 100644
index 000000000..a74d256d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_36.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! Test the fix for PR47348, in which the substring length
+! in the array constructor at line 19 would be missed and
+! the length of q used instead.
+!
+! Contributed by Thomas Koenig  <tkoenig@netcologne.de>
+!
+program main
+  implicit none
+  character(len = *), parameter :: fmt='(2(A,"|"))'
+  character(len = *), parameter :: test='xyc|aec|'
+  integer :: i
+  character(len = 4) :: q
+  character(len = 8) :: buffer
+  q = 'xy'
+  i = 2
+  write (buffer, fmt) (/ trim(q), 'ae' /)//'c'
+  if (buffer .ne. test) Call abort
+  write (buffer, FMT) (/ q(1:i), 'ae' /)//'c'
+  if (buffer .ne. test) Call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_37.f90 b/gcc/testsuite/gfortran.dg/array_constructor_37.f90
new file mode 100644
index 000000000..5c66cce1c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_37.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! Check the fix for PR47850, in which the argument of ANY, below, was not
+! simplified, thereby causing an ICE.
+!
+! Contributed by Tobias Burnus  <burnus@gcc.gnu.org> but based on James van Buskirk's program in
+! http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/625faf82578e9af8
+!
+!
+program Cindex
+   implicit none
+   integer,parameter :: SENSOR_CHANNEL(8) = &
+      [10,12,17,20,22,30,33,34]
+   integer,parameter :: NLTE_CHANNEL(3) = [20,22,34]
+   integer,parameter :: N_NLTE_CHANNELS = size(NLTE_CHANNEL)
+   integer,parameter :: N_CHANNELS = size(SENSOR_CHANNEL)
+   integer i
+   integer,parameter :: C_INDEX(8) = unpack( &
+      vector = [(i,i=1,size(SENSOR_CHANNEL))], &
+      mask = [(any(SENSOR_CHANNEL(i) == NLTE_CHANNEL), &
+         i=lbound(SENSOR_CHANNEL,1),ubound(SENSOR_CHANNEL,1))], &
+      field = 0)
+   character(20) fmt
+
+   write(fmt,'(a,i0,a)') '(a,t19,',size(SENSOR_CHANNEL),'(i3:","))'
+   write(*,fmt) 'SENSOR_CHANNEL = ',SENSOR_CHANNEL
+   write(fmt,'(a,i0,a)') '(a,t19,',size(NLTE_CHANNEL),'(i3:","))'
+   write(*,fmt) 'NLTE_CHANNEL = ',NLTE_CHANNEL
+   write(*,'(a,t19,i3)') 'N_NLTE_CHANNELS = ',N_NLTE_CHANNELS
+   write(*,'(a,t19,i3)') 'N_CHANNELS = ',N_CHANNELS
+   write(fmt,'(a,i0,a)') '(a,t19,',size(C_INDEX),'(i3:","))'
+   write(*,fmt) 'C_INDEX = ',C_INDEX
+end program Cindex
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_4.f90 b/gcc/testsuite/gfortran.dg/array_constructor_4.f90
new file mode 100644
index 000000000..cae651567
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_4.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! PR 21912
+! We didn't adapt the exit condition to negative steps in array constructors,
+! leaving the resulting arrays uninitialized.
+integer :: i(5), n, m, l, k
+
+n = 5
+i = (/ (m, m = n, 1, -1) /)
+if (any (i /= (/ 5, 4, 3, 2, 1 /))) call abort
+
+k = 1
+
+i(5:1:-1) = (/ (m, m = n, k, -1) /)
+if (any (i /= (/ 1, 2, 3, 4, 5 /))) call abort
+
+l = -1
+
+i = (/ (m, m = n, 1, l) /)
+if (any (i /= (/ 5, 4, 3, 2, 1 /))) call abort
+
+i(5:1:-1) = (/ (m, m = n, k, l) /)
+if (any (i /= (/ 1, 2, 3, 4, 5 /))) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_5.f90 b/gcc/testsuite/gfortran.dg/array_constructor_5.f90
new file mode 100644
index 000000000..8b8f6b041
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_5.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! PR22327
+program array_constructor
+    implicit none
+    integer :: a(6), i
+    i = 6
+    a = (/ 1, 2, 3, 4, 5, i /)
+    do i = 1, 6
+        if (a(i) /= i) call abort()
+    end do
+end program array_constructor
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_6.f90 b/gcc/testsuite/gfortran.dg/array_constructor_6.f90
new file mode 100644
index 000000000..177fb20ee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_6.f90
@@ -0,0 +1,25 @@
+! PR 12840.  Make sure that array constructors can be used to determine
+! the bounds of a scalarization loop.
+! { dg-do run }
+program main
+  implicit none
+  call build (11)
+contains
+  subroutine build (order)
+    integer :: order, i
+
+    call test (order, (/ (i * 2, i = 1, order) /))
+    call test (17, (/ (i * 2, i = 1, 17) /))
+    call test (5, (/ 2, 4, 6, 8, 10 /))
+  end subroutine build
+
+  subroutine test (order, values)
+    integer, dimension (:) :: values
+    integer :: order, i
+
+    if (size (values, dim = 1) .ne. order) call abort
+    do i = 1, order
+      if (values (i) .ne. i * 2) call abort
+    end do
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_7.f90 b/gcc/testsuite/gfortran.dg/array_constructor_7.f90
new file mode 100644
index 000000000..65ec26c87
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_7.f90
@@ -0,0 +1,26 @@
+! Like array_constructor_6.f90, but test for nested iterators.
+! { dg-do run }
+program main
+  implicit none
+  call build (17)
+contains
+  subroutine build (order)
+    integer :: order, i, j
+
+    call test (order, (/ (((j + 100) * i, j = 1, i), i = 1, order) /))
+    call test (9, (/ (((j + 100) * i, j = 1, i), i = 1, 9) /))
+    call test (3, (/ 101, 202, 204, 303, 306, 309 /))
+  end subroutine build
+
+  subroutine test (order, values)
+    integer, dimension (:) :: values
+    integer :: order, i, j
+
+    if (size (values, dim = 1) .ne. order * (order + 1) / 2) call abort
+    do i = 1, order
+      do j = 1, i
+        if (values (i * (i - 1) / 2 + j) .ne. (j + 100) * i) call abort
+      end do
+    end do
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_8.f90 b/gcc/testsuite/gfortran.dg/array_constructor_8.f90
new file mode 100644
index 000000000..0ecebbca9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_8.f90
@@ -0,0 +1,46 @@
+! Like array_constructor_6.f90, but check constructors that mix iterators
+! and individual scalar elements.
+! { dg-do run }
+program main
+  implicit none
+  call build (42)
+contains
+  subroutine build (order)
+    integer :: order, i
+
+    call test (order, 8, 5, (/ ((/ 1, 2, 3, 4, 5, 6, 7, 8 /), i = 1, order), &
+                               100, 200, 300, 400, 500 /))
+
+    call test (order, 2, 3, (/ ((/ 1, 2 /), i = 1, order), &
+                               100, 200, 300 /))
+
+    call test (order, 3, 5, (/ ((/ 1, 2, 3 /), i = 1, order), &
+                               100, 200, 300, 400, 500 /))
+
+    call test (order, 6, 1, (/ ((/ 1, 2, 3, 4, 5, 6 /), i = 1, order), &
+                               100 /))
+
+    call test (order, 5, 0, (/ ((/ 1, 2, 3, 4, 5 /), i = 1, order) /))
+
+    call test (order, 0, 4, (/ 100, 200, 300, 400 /))
+
+    call test (11, 5, 2, (/ ((/ 1, 2, 3, 4, 5 /), i = 1, 11), &
+                            100, 200 /))
+
+    call test (6, 2, order, (/ ((/ 1, 2 /), i = 1, 6), &
+                               (i * 100, i = 1, order) /))
+  end subroutine build
+
+  subroutine test (order, repeat, trail, values)
+    integer, dimension (:) :: values
+    integer :: order, repeat, trail, i
+
+    if (size (values, dim = 1) .ne. order * repeat + trail) call abort
+    do i = 1, order * repeat
+      if (values (i) .ne. mod (i - 1, repeat) + 1) call abort
+    end do
+    do i = 1, trail
+      if (values (i + order * repeat) .ne. i * 100) call abort
+    end do
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_9.f90 b/gcc/testsuite/gfortran.dg/array_constructor_9.f90
new file mode 100644
index 000000000..71e939bf0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_9.f90
@@ -0,0 +1,43 @@
+! Like array_constructor_6.f90, but check constructors in which the length
+! of each subarray can only be determined at run time.
+! { dg-do run }
+program main
+  implicit none
+  call build (9)
+contains
+  function gen (order)
+    real, dimension (:, :), pointer :: gen
+    integer :: order, i, j
+
+    allocate (gen (order, order + 1))
+    forall (i = 1 : order, j = 1 : order + 1) gen (i, j) = i * i + j
+  end function gen
+
+  ! Deliberately leaky!
+  subroutine build (order)
+    integer :: order, i
+
+    call test (order, 0, (/ (gen (i), i = 1, order) /))
+    call test (3, 2, (/ ((/ 1.5, 1.5, gen (i) /), i = 1, 3) /))
+  end subroutine build
+
+  subroutine test (order, prefix, values)
+    real, dimension (:) :: values
+    integer :: order, prefix, last, i, j, k
+
+    last = 0
+    do i = 1, order
+      do j = 1, prefix
+        last = last + 1
+        if (values (last) .ne. 1.5) call abort
+      end do
+      do j = 1, i + 1
+        do k = 1, i
+          last = last + 1
+          if (values (last) .ne. j + k * k) call abort
+        end do
+      end do
+    end do
+    if (size (values, dim = 1) .ne. last) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_1.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_1.f03
new file mode 100644
index 000000000..fc8813cc5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_1.f03
@@ -0,0 +1,17 @@
+! { dg-do run }
+!
+! PR fortran/27997
+!
+! Simple array constructor with typespec.
+!
+PROGRAM test
+  IMPLICIT NONE
+  INTEGER :: array(5)
+
+  array = (/ INTEGER :: 18, 12, 31, 3, 42.4 /)
+
+  IF (array(1) /= 18 .OR. array(2) /= 12 .OR. &
+      array(3) /= 31 .OR. array(4) /=  3 .OR. array(5) /= 42) THEN
+      CALL abort()
+  END IF
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_10.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_10.f03
new file mode 100644
index 000000000..f4dfae2bd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_10.f03
@@ -0,0 +1,23 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+!
+! PR fortran/27997
+!
+! Array constructor with typespec and dynamic
+! character length.
+!
+PROGRAM test
+  CALL foo(8, "short", "short")
+  CALL foo(2, "lenghty", "le")
+CONTAINS
+  SUBROUTINE foo (n, s, shouldBe)
+    CHARACTER(len=*) :: s
+    CHARACTER(len=*) :: shouldBe
+    CHARACTER(len=16) :: arr(2)
+    INTEGER :: n
+    arr = [ character(len=n) :: s, s ]
+    IF (arr(1) /= shouldBe .OR. arr(2) /= shouldBe) THEN
+      CALL abort ()
+    END IF
+  END SUBROUTINE foo
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_11.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_11.f03
new file mode 100644
index 000000000..e27515c7d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_11.f03
@@ -0,0 +1,11 @@
+! { dg-do run }
+!
+! PR fortran/27997
+!
+! Empty array constructor with typespec.
+!
+ integer :: i(3)
+ i(3:2) = (/ integer :: /)
+ if (len((/ character(5) :: /)) /= 5) call abort()
+ if (kind((/ integer(8) :: /)) /= 8) call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_12.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_12.f03
new file mode 100644
index 000000000..e06fd4799
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_12.f03
@@ -0,0 +1,12 @@
+! { dg-do run }
+!
+! PR fortran/27997
+!
+! Array constructor with typespec.
+!
+real :: a(3)
+integer :: j(3)
+a = (/ integer :: 1.4, 2.2, 3.33  /)
+j = (/ 1.4, 2.2, 3.33  /)
+if( any(a /= j )) call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_13.f90 b/gcc/testsuite/gfortran.dg/array_constructor_type_13.f90
new file mode 100644
index 000000000..eab35ccd1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_13.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/27997
+!
+! Array constructor with typespec
+! should be rejected for Fortran 95.
+!
+real :: a(3)
+integer :: j(3)
+a = (/ integer :: 1.4, 2.2, 3.33  /) ! { dg-error "Fortran 2003" }
+j = (/ 1.4, 2.2, 3.33  /)
+if( any(a /= j )) call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_14.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_14.f03
new file mode 100644
index 000000000..04ac72801
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_14.f03
@@ -0,0 +1,24 @@
+! { dg-do run }
+! PR fortran/27997
+!
+! Array constructor with typespec
+! for derived types.
+
+PROGRAM test
+  IMPLICIT NONE
+
+  TYPE foo
+    INTEGER :: i
+    REAL :: x
+  END TYPE foo
+
+  TYPE(foo), PARAMETER :: x = foo(42, 42.)
+
+  TYPE(foo), DIMENSION(2) :: arr
+
+  arr = (/ TYPE(foo) :: x, foo(0, 1.) /)
+  IF (arr(1)%i /= 42 .OR. arr(1)%x /= 42. .OR. &
+      arr(2)%i /= 0 .OR. arr(2)%x /= 1.) THEN
+    CALL abort()
+  END IF
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_15.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_15.f03
new file mode 100644
index 000000000..20736988b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_15.f03
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! PR fortran/27997
+!
+! Array constructor with typespec
+! for derived types, failing conversion.
+
+PROGRAM test
+  IMPLICIT NONE
+
+  TYPE foo
+    INTEGER :: i
+    REAL :: x
+  END TYPE foo
+
+  TYPE bar
+    LOGICAL :: logos
+  END TYPE bar
+
+  TYPE(foo), PARAMETER :: x = foo(42, 42.)
+
+  WRITE (*,*) (/ TYPE(foo) :: x, foo(0, 1.), bar(.TRUE.) /) ! { dg-error "convert TYPE" }
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_16.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_16.f03
new file mode 100644
index 000000000..a6950997e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_16.f03
@@ -0,0 +1,25 @@
+! { dg-do run }
+! PR fortran/27997
+!
+! Nested array constructors with typespec.
+
+PROGRAM test
+  IMPLICIT NONE
+
+  INTEGER(KIND=8) :: arr(3)
+  CHARACTER(len=6) :: carr(3)
+
+  arr = (/ INTEGER(KIND=8) :: 4, [ INTEGER(KIND=4) :: 42, 12 ] /)
+  IF (arr(1) /= 4 .OR. arr(2) /= 42 .OR. arr(3) /= 12) CALL abort()
+  arr = (/ INTEGER(KIND=8) :: [ INTEGER(KIND=4) :: 4, 42, 12 ] /)
+  IF (arr(1) /= 4 .OR. arr(2) /= 42 .OR. arr(3) /= 12) CALL abort()
+  arr = (/ INTEGER(KIND=8) :: [ INTEGER(KIND=4) :: 4, 42 ], 12 /)
+  IF (arr(1) /= 4 .OR. arr(2) /= 42 .OR. arr(3) /= 12) CALL abort()
+  arr = (/ INTEGER(KIND=8) :: [ INTEGER(KIND=4) :: ], 4, 42, 12 /)
+  IF (arr(1) /= 4 .OR. arr(2) /= 42 .OR. arr(3) /= 12) CALL abort()
+
+  carr = [ CHARACTER(len=6) :: "foo", [ CHARACTER(len=4) :: "foobar", "xyz" ] ]
+  IF (carr(1) /= "foo" .OR. carr(2) /= "foob" .OR. carr(3) /= "xyz") THEN
+    CALL abort()
+  END IF
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_17.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_17.f03
new file mode 100644
index 000000000..f8f15f9eb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_17.f03
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-fno-range-check -Wconversion" }
+! PR fortran/27997
+!
+! Range check on array-constructors with typespec.
+
+PROGRAM test
+  IMPLICIT NONE
+
+  INTEGER(KIND=4) :: arr(1)
+  arr = (/ INTEGER(KIND=4) :: HUGE(0_8) /) ! { dg-warning "conversion from" }
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_18.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_18.f03
new file mode 100644
index 000000000..d88b3227c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_18.f03
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-frange-check" }
+! PR fortran/27997
+!
+! Range check on array-constructors with typespec.
+
+PROGRAM test
+  IMPLICIT NONE
+
+  INTEGER(KIND=4) :: arr(1)
+  arr = (/ INTEGER(KIND=4) :: HUGE(0_8) /) ! { dg-error "overflow converting" }
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_19.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_19.f03
new file mode 100644
index 000000000..f3c8fd5ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_19.f03
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! PR fortran/36517
+! Check for incorrect error message with -std=f2003.
+! This is the test of comment #1, PR 36517.
+
+print *, [ character(len=2) :: 'a', 'bb' ]
+end
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_2.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_2.f03
new file mode 100644
index 000000000..492555055
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_2.f03
@@ -0,0 +1,20 @@
+! { dg-do run }
+!
+! PR fortran/27997
+!
+! Array constructor with typespec, length parameter.
+!
+program test
+  implicit none
+  character(15) :: a(3)
+  a =  (/ character(len=7) :: 'Takata', 'Tanaka', 'Hayashi' /)
+  if ( len([ character(len=7) :: ]) /= 7) call abort()
+  if ( size([ integer :: ]) /= 0) call abort()
+  if(     a(1) /= 'Takata'  .or. a(1)(7:7)   /= achar(32) &
+                            .or. a(1)(15:15) /= achar(32) &
+     .or. a(2) /= 'Tanaka'  .or. a(2)(7:7)   /= achar(32) &
+                            .or. a(2)(15:15) /= achar(32) &
+     .or. a(3) /= 'Hayashi' .or. a(3)(8:8)   /= achar(32) &
+                            .or. a(3)(15:15) /= achar(32))&
+   call abort()
+end program test
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_20.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_20.f03
new file mode 100644
index 000000000..9702669d4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_20.f03
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! PR fortran/36517
+! Check for incorrect error message with -std=f2003.
+! This is the original test from PR 36517.
+
+CHARACTER (len=*) MY_STRING(1:3)
+PARAMETER ( MY_STRING = (/ CHARACTER (len=3) :: "AC", "B", "C" /) )
+CHARACTER (len=*), PARAMETER :: str(2) = [ CHARACTER (len=3) :: 'A', 'cc' ]
+END
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_21.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_21.f03
new file mode 100644
index 000000000..41e4da346
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_21.f03
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! PR fortran/36492
+! Check that it works with a typespec even for not-the-same-length elements.
+
+type t
+  character (1) :: arr (2) = [ character(len=2) :: "a", "ab" ]
+end type t
+
+end
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_3.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_3.f03
new file mode 100644
index 000000000..bebaea5c5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_3.f03
@@ -0,0 +1,16 @@
+! { dg-do run }
+!
+! PR fortran/27997
+!
+! Test empty array constructor with typespec.
+!
+PROGRAM test
+  IMPLICIT NONE
+  INTEGER :: array(2)
+
+  array = (/ 5, [INTEGER ::], 6 /)
+
+  IF (array(1) /= 5 .OR. array(2) /= 6) THEN
+      CALL abort()
+  END IF
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_4.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_4.f03
new file mode 100644
index 000000000..d804bfada
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_4.f03
@@ -0,0 +1,15 @@
+! { dg-do run }
+!
+! PR fortran/27997
+!
+! Ensure that :: is present when a typespec is deduced.
+!
+PROGRAM test
+  INTEGER :: array(1)
+  INTEGER = 42
+
+  array = [ INTEGER ]
+  IF (array(1) /= 42) THEN
+    CALL abort()
+  END IF
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_5.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_5.f03
new file mode 100644
index 000000000..98ddfa38e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_5.f03
@@ -0,0 +1,18 @@
+! { dg-do run }
+!
+! PR fortran/27997
+!
+! Array constructor with typespec and small length value.
+!
+program test
+  implicit none
+  character(15) :: a(3)
+  a =  (/ character(len=3) :: 'Takata', 'Tanaka', 'Hayashi' /)
+  if(     a(1) /= 'Tak'  .or. a(1)(4:4)   /= achar(32) &
+                         .or. a(1)(15:15) /= achar(32) &
+     .or. a(2) /= 'Tan'  .or. a(2)(4:4)   /= achar(32) &
+                         .or. a(2)(15:15) /= achar(32) &
+     .or. a(3) /= 'Hay'  .or. a(3)(4:4)   /= achar(32) &
+                         .or. a(3)(15:15) /= achar(32))&
+   call abort()
+end program test
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_6.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_6.f03
new file mode 100644
index 000000000..df784f872
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_6.f03
@@ -0,0 +1,30 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+!
+! PR fortran/27997
+!
+! Array constructor with typespec.
+!
+program test
+  character(15) :: a(3)
+  character(10), volatile :: b(3)
+  b(1) = 'Takata'
+  b(2) = 'Tanaka'
+  b(3) = 'Hayashi'
+
+  a =  (/ character(len=7) :: trim(b(1)), trim(b(2)), trim(b(3)) /)
+  if (a(1) /= 'Takata' .or. a(2) /= 'Tanaka' .or. a(3) /= 'Hayashi') then
+    call abort ()
+  end if
+
+  a =  (/ character(len=2) :: trim(b(1)), trim(b(2)), trim(b(3)) /)
+  if (a(1) /= 'Ta' .or. a(2) /= 'Ta' .or. a(3) /= 'Ha') then
+    call abort ()
+  end if
+
+  a =  (/ character(len=8) :: trim(b(1)), trim(b(2)), trim(b(3)) /)
+  if (a(1) /= 'Takata' .or. a(2) /= 'Tanaka' .or. a(3) /= 'Hayashi') then
+    call abort ()
+  end if
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_7.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_7.f03
new file mode 100644
index 000000000..8fb210a68
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_7.f03
@@ -0,0 +1,23 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+!
+! PR fortran/27997
+!
+! Array constructor with typespec and dynamic
+! character length.
+!
+PROGRAM test
+  CALL foo(8, "short", "test", "short")
+  CALL foo(2, "lenghty", "te", "le")
+CONTAINS
+  SUBROUTINE foo (n, s, a1, a2)
+    CHARACTER(len=*) :: s
+    CHARACTER(len=*) :: a1, a2
+    CHARACTER(len=n) :: arr(2)
+    INTEGER :: n
+    arr = [ character(len=n) :: 'test', s ]
+    IF (arr(1) /= a1 .OR. arr(2) /= a2) THEN
+      CALL abort ()
+    END IF
+  END SUBROUTINE foo
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_8.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_8.f03
new file mode 100644
index 000000000..9be467def
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_8.f03
@@ -0,0 +1,13 @@
+! { dg-do run }
+!
+! PR fortran/27997
+!
+! Array constructor with typespec, check for regression
+!
+program test
+  implicit none
+  type :: real_info
+    integer :: kind
+  end type real_info
+  type (real_info) :: real_infos(1) = (/ real_info (4) /)
+end program test
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_9.f b/gcc/testsuite/gfortran.dg/array_constructor_type_9.f
new file mode 100644
index 000000000..c2a2bd1d8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_type_9.f
@@ -0,0 +1,10 @@
+! { dg-do run }
+!
+! PR fortran/27997
+!
+! Array constructor with typespec, check for regression
+! with fixed form.
+!
+      integer :: a(2), realabc, real_abc2
+      a = [ realabc, real_abc2 ]
+      end
diff --git a/gcc/testsuite/gfortran.dg/array_function_1.f90 b/gcc/testsuite/gfortran.dg/array_function_1.f90
new file mode 100644
index 000000000..281ae88b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_function_1.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! PR fortran/30720
+program array_function_1
+  integer :: a(5), b, l, u
+  l = 4
+  u = 2
+
+  a = (/ 1, 2, 3, 4, 5 /)
+
+  b = f(a(l:u) - 2)
+  if (b /= 0) call abort
+
+  b = f(a(4:2) - 2)
+  if (b /= 0) call abort
+
+  b = f(a(u:l) - 2)
+  if (b /= 3) call abort
+
+  b = f(a(2:4) - 2)
+  if (b /= 3) call abort
+
+  contains
+    integer function f(x)
+      integer, dimension(:), intent(in) :: x
+      f = sum(x)
+    end function
+end program
diff --git a/gcc/testsuite/gfortran.dg/array_function_2.f90 b/gcc/testsuite/gfortran.dg/array_function_2.f90
new file mode 100644
index 000000000..a9374116a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_function_2.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+
+! PR fortran/37199
+! We used to produce wrong (segfaulting) code for this one because the
+! temporary array for the function result had wrong bounds.
+
+! Contributed by Gavin Salam <salam@lpthe.jussieu.fr>
+
+program bounds_issue
+  implicit none
+  integer, parameter  :: dp = kind(1.0d0)
+  real(dp), pointer :: pdf0(:,:), dpdf(:,:)
+
+  allocate(pdf0(0:282,-6:7))
+  allocate(dpdf(0:282,-6:7))  ! with dpdf(0:283,-6:7) [illegal] error disappears
+  !write(0,*) lbound(dpdf), ubound(dpdf)
+  dpdf = tmp_PConv(pdf0)
+
+contains
+  function tmp_PConv(q_in) result(Pxq)
+    real(dp),      intent(in) :: q_in(0:,-6:)
+    real(dp)                  :: Pxq(0:ubound(q_in,dim=1),-6:7)
+    Pxq = 0d0
+    !write(0,*) lbound(q_in), ubound(q_in)
+    !write(0,*) lbound(Pxq),  ubound(Pxq)
+    return
+  end function tmp_PConv
+
+end program bounds_issue
diff --git a/gcc/testsuite/gfortran.dg/array_function_3.f90 b/gcc/testsuite/gfortran.dg/array_function_3.f90
new file mode 100644
index 000000000..b1a9cac44
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_function_3.f90
@@ -0,0 +1,48 @@
+! { dg-do compile }
+
+! PR fortran/36167
+! This used to cause an ICE because of a missing array spec after interface
+! mapping.
+
+! Contributed by Frank Muldoon <fmuldoo@me.lsu.edu>
+
+module communication_tools
+
+contains   
+!*******************************************************************************
+function overlap_1(u,lbound_u,ubound_u)
+!*******************************************************************************
+integer, intent(in), dimension(:) :: lbound_u,ubound_u
+real, intent(in), dimension(lbound_u(1):ubound_u(1),lbound_u(2):ubound_u(2),&
+                            lbound_u(3):ubound_u(3)) :: u
+
+real, dimension(&
+lbound(u,1):ubound(u,1),&
+lbound(u,2):ubound(u,2),&
+lbound(u,3):ubound(u,3)) :: overlap_1
+
+return
+end function overlap_1
+
+end module communication_tools
+
+!*******************************************************************************
+subroutine write_out_particles
+!*******************************************************************************
+
+use communication_tools
+real, dimension(1:5, 2:4, 3:10) :: vorticityMag
+real, allocatable, dimension(:,:,:) :: temp3d
+
+allocate(temp3d( &
+lbound(overlap_1(vorticityMag,lbound(vorticityMag),ubound(vorticityMag)),1):&
+ubound(overlap_1(vorticityMag,lbound(vorticityMag),ubound(vorticityMag)),1),&
+lbound(overlap_1(vorticityMag,lbound(vorticityMag),ubound(vorticityMag)),2):&
+ubound(overlap_1(vorticityMag,lbound(vorticityMag),ubound(vorticityMag)),2),&
+lbound(overlap_1(vorticityMag,lbound(vorticityMag),ubound(vorticityMag)),3):&
+ubound(overlap_1(vorticityMag,lbound(vorticityMag),ubound(vorticityMag)),3)))
+
+return 
+end subroutine write_out_particles
+
+! { dg-final { cleanup-modules "communication_tools" } }
diff --git a/gcc/testsuite/gfortran.dg/array_function_4.f90 b/gcc/testsuite/gfortran.dg/array_function_4.f90
new file mode 100644
index 000000000..c7e7d6e57
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_function_4.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+
+! PR fortran/37411
+! This used to cause an ICE because of a missing array spec after interface
+! mapping.
+
+! Contributed by Kristjan Jonasson <jonasson@hi.is>
+
+MODULE B1
+CONTAINS
+  subroutine sub()
+    integer :: x(1)
+    character(3) :: st
+    st = fun(x)
+  end subroutine sub
+
+  function fun(x) result(st)
+    integer, intent(in) :: x(1)
+    character(lenf(x)) :: st
+    st = 'abc'
+  end function fun
+
+  pure integer function lenf(x)
+    integer, intent(in) :: x(1)
+    lenf = x(1)
+  end function lenf
+END MODULE B1
+
+! { dg-final { cleanup-modules "B1" } }
diff --git a/gcc/testsuite/gfortran.dg/array_function_5.f90 b/gcc/testsuite/gfortran.dg/array_function_5.f90
new file mode 100644
index 000000000..9c95f8005
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_function_5.f90
@@ -0,0 +1,17 @@
+! {  dg-do run }
+! PR41278 internal compiler error related to matmul and transpose
+! Test case prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+! Original test case by Chris <cmklaij@hetnet.nl>
+program bug
+  implicit none
+  real, dimension(3,3) :: matA,matB,matC
+
+  matA(1,:)=(/1., 2., 3./)
+  matA(2,:)=(/4., 5., 6./)
+  matA(3,:)=(/7., 8., 9./)
+
+  matB=matmul(transpose(0.5*matA),matA)
+  matC = transpose(0.5*matA)
+  matC = matmul(matC, matA)
+  if (any(matB.ne.matC)) call abort()
+end program bug
diff --git a/gcc/testsuite/gfortran.dg/array_function_6.f90 b/gcc/testsuite/gfortran.dg/array_function_6.f90
new file mode 100644
index 000000000..3dab43dcb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_function_6.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! PR46842 wrong results with MATMUL(..., TRANSPOSE (func ()))
+implicit none
+call sub()
+contains
+   subroutine sub()
+      real, dimension(2,2) :: b
+      b = 1.0
+      b = matmul(b,transpose(func()))
+      if (any(b.ne.reshape((/ 4.0, 4.0, 6.0, 6.0 /),[2,2]) )) print *, b
+   end subroutine
+
+   function func() result(res)
+      real, dimension(2,2) :: res
+      res = reshape([1,2,3,4], [2,2])
+   end function
+end
diff --git a/gcc/testsuite/gfortran.dg/array_initializer_1.f90 b/gcc/testsuite/gfortran.dg/array_initializer_1.f90
new file mode 100644
index 000000000..3347758dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_initializer_1.f90
@@ -0,0 +1,35 @@
+! { dg-do run }

+! Check the fix for PR16206, in which array sections would not work

+! in array initializers. Use of implied do loop variables for indices

+! and substrings, with and without implied do loops, were fixed at the

+! same time.

+!

+! Contributed by Paul Thomas   <pault@gcc.gnu.org>

+! based on testcase from Harald Anlauf  <anlauf@gmx.de>  

+!

+  real, parameter :: x(4,4) = reshape((/(i, i = 1, 16)/), (/4,4/))

+  real, parameter :: y(4) = (/ x(1:2, 2), x(3:4, 4)/)

+  real, parameter :: z(2) = x(2:3, 3) + 1

+  real, parameter :: r(6) = (/(x(i:i +1, i), i = 1,3)/)

+  real, parameter :: s(12) = (/((x(i, i:j-1:-1), i = 3,4), j = 2,3)/)

+  real, parameter :: t(8) = (/(z, real (i)**3, y(i), i = 2, 3)/)

+

+  integer, parameter :: ii = 4

+

+  character(4), parameter :: chr(4) = (/"abcd", "efgh", "ijkl", "mnop"/)

+  character(4), parameter :: chrs = chr(ii)(2:3)//chr(2)(ii-3:ii-2) 

+  character(4), parameter :: chrt(2) = (/chr(2:2)(2:3), chr(ii-1)(3:ii)/)

+  character(2), parameter :: chrx(2) = (/(chr(i)(i:i+1), i=2,3)/)

+

+  if (any (y .ne. (/5., 6., 15., 16./))) call abort ()

+  if (any (z .ne. (/11., 12./))) call abort ()

+  if (any (r .ne. (/1., 2., 6., 7., 11., 12./))) call abort ()

+  if (any (s .ne. (/11., 7., 3., 16., 12., 8., 4., &

+                    11., 7.,     16., 12., 8. /))) call abort ()

+

+  if (any (t .ne. (/11., 12., 8., 6., 11., 12., 27., 15. /))) call abort ()

+

+  if (chrs .ne. "noef") call abort ()

+  if (any (chrt .ne. (/"fg", "kl"/))) call abort ()

+  if (any (chrx .ne. (/"fg", "kl"/))) call abort ()

+end

diff --git a/gcc/testsuite/gfortran.dg/array_initializer_2.f90 b/gcc/testsuite/gfortran.dg/array_initializer_2.f90
new file mode 100644
index 000000000..ef30b84d4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_initializer_2.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! Tests the fix for PR28496 in which initializer array constructors with
+! a missing initial array index would cause an ICE.
+!
+! Test for the fix of the initializer array constructor part of PR29975
+! was added later.  Here, the indexing would get in a mess if the array
+! specification had a lower bound other than unity.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+! Based on original test case from Samir Nordin  <snordin_ng@yahoo.fr> 
+!
+  integer, dimension(3), parameter :: a=(/1,2,3/)
+  integer, dimension(3), parameter :: b=(/a(:)/)
+  integer, dimension(3,3), parameter :: c=reshape ((/(i, i = 1,9)/),(/3,3/))
+  integer, dimension(2,3), parameter :: d=reshape ((/c(3:2:-1,:)/),(/2,3/))
+  integer, dimension(3,3), parameter :: e=reshape ((/a(:),a(:)+3,a(:)+6/),(/3,3/))
+  integer, dimension(2,3), parameter :: f=reshape ((/c(2:1:-1,:)/),(/2,3/))
+  CHARACTER (LEN=1), DIMENSION(3:7),  PARAMETER :: g =  &
+    (/ '+', '-', '*', '/', '^' /)
+  CHARACTER (LEN=3) :: h = "A+C"
+!
+! PR28496
+!
+  if (any (b .ne. (/1,2,3/))) call abort ()
+  if (any (reshape(d,(/6/)) .ne. (/3, 2, 6, 5, 9, 8/))) call abort () 
+  if (any (reshape(f,(/6/)) .ne. (/2, 1, 5, 4, 8, 7/))) call abort () 
+!
+! PR29975
+!
+  IF (all(h(2:2) /= g(3:4))) call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/array_initializer_3.f90 b/gcc/testsuite/gfortran.dg/array_initializer_3.f90
new file mode 100644
index 000000000..c420e95dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_initializer_3.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! Tests the fix for PR28923 in which initializer array constructors with
+! a missing initial array index and negative stride would be incorrectly
+! interpreted.
+!
+! Contributed by Dominique d'Humieres  <dominiq@lps.ens.fr>
+!
+real, dimension(3,3), parameter :: a=reshape ((/(i, i = 1,9)/),(/3,3/))
+real, dimension(2,3) :: b=a(:2:-1,:)  ! { dg-error "Different shape for array assignment" }
+real, dimension(2,3) :: c=a(3:2:-1,:)
+print *, b
+print *, c
+end
+
diff --git a/gcc/testsuite/gfortran.dg/array_memcpy_1.f90 b/gcc/testsuite/gfortran.dg/array_memcpy_1.f90
new file mode 100644
index 000000000..2d2f8f730
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_memcpy_1.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine testi(a,b)
+  integer :: a(20)
+  integer :: b(20)
+  a = b;
+end subroutine
+
+subroutine testr(a,b)
+  real :: a(20)
+  real :: b(20)
+  a = b;
+end subroutine
+
+subroutine testz(a,b)
+  complex :: a(20)
+  complex :: b(20)
+  a = b;
+end subroutine
+
+subroutine testl(a,b)
+  logical :: a(20)
+  logical :: b(20)
+  a = b;
+end subroutine
+
+! { dg-final { scan-tree-dump-times "memcpy" 4 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/array_memcpy_2.f90 b/gcc/testsuite/gfortran.dg/array_memcpy_2.f90
new file mode 100644
index 000000000..be8f00d17
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_memcpy_2.f90
@@ -0,0 +1,20 @@
+! This checks that the "z = y" assignment is not considered copyable, as the
+! array is of a derived type containing allocatable components.  Hence, we
+! we should expand the scalarized loop, which contains *two* memcpy calls.
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+
+  type :: a
+    integer, allocatable :: i(:)
+  end type a
+
+  type :: b
+    type (a), allocatable :: at(:)
+  end type b
+
+  type(b) :: y(2), z(2)
+
+  z = y
+end
+! { dg-final { scan-tree-dump-times "memcpy" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/array_memcpy_3.f90 b/gcc/testsuite/gfortran.dg/array_memcpy_3.f90
new file mode 100644
index 000000000..0c4964d8f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_memcpy_3.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+
+subroutine foo(x)
+  integer :: x(4)
+  x(:) = (/ 3, 1, 4, 1 /)
+end subroutine
+
+subroutine bar(x)
+  integer :: x(4)
+  x = (/ 3, 1, 4, 1 /)
+end subroutine
+
+! { dg-final { scan-tree-dump-times "memcpy|ref-all\[^\\n\]*ref-all" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/array_memcpy_4.f90 b/gcc/testsuite/gfortran.dg/array_memcpy_4.f90
new file mode 100644
index 000000000..9f2279d88
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_memcpy_4.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+  type t
+    logical valid
+    integer :: x, y
+  end type
+  type (t) :: s(5)
+  type (t) :: d(5)
+
+  d = s
+end
+! { dg-final { scan-tree-dump-times "MEM.*d\\\] = MEM" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/array_memcpy_5.f90 b/gcc/testsuite/gfortran.dg/array_memcpy_5.f90
new file mode 100644
index 000000000..40fb6957a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_memcpy_5.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! Tests the fix for PR33370, in which array copying, with subreferences
+! was broken due to a regression.
+!
+! Reported by Thomas Koenig <tkoenig@gcc.gnu.org>
+!
+program main
+  type foo
+    integer :: i
+     character(len=3) :: c
+  end type foo
+  type(foo), dimension(2) :: a = (/foo (1, "uvw"), foo (2, "xyz")/)
+  type(foo), dimension(2) :: b = (/foo (101, "abc"), foo (102, "def")/)
+  a%i = 0
+  print *, a
+  a%i = (/ 12, 2/)
+  if (any (a%c .ne. (/"uvw", "xyz"/))) call abort ()
+  if (any (a%i .ne. (/12, 2/))) call abort ()
+  a%i = b%i
+  if (any (a%c .ne. (/"uvw", "xyz"/))) call abort ()
+  if (any (a%i .ne. (/101, 102/))) call abort ()
+end program main
diff --git a/gcc/testsuite/gfortran.dg/array_memset_1.f90 b/gcc/testsuite/gfortran.dg/array_memset_1.f90
new file mode 100644
index 000000000..cd6cb0d6d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_memset_1.f90
@@ -0,0 +1,64 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine i1(a)
+  integer :: a(20)
+  a = 0;
+end subroutine
+
+subroutine i2(a)
+  integer :: a(20)
+  a(:) = 0;
+end subroutine
+
+subroutine i3(a)
+  integer :: a(20)
+  a(1:20) = 0;
+end subroutine
+
+subroutine r1(a)
+  real :: a(20)
+  a = 0.0;
+end subroutine
+
+subroutine r2(a)
+  real :: a(20)
+  a(:) = 0.0;
+end subroutine
+
+subroutine r3(a)
+  real :: a(20)
+  a(1:20) = 0.0;
+end subroutine
+
+subroutine z1(a)
+  complex :: a(20)
+  a = 0;
+end subroutine
+
+subroutine z2(a)
+  complex :: a(20)
+  a(:) = 0;
+end subroutine
+
+subroutine z3(a)
+  complex :: a(20)
+  a(1:20) = 0;
+end subroutine
+
+subroutine l1(a)
+  logical :: a(20)
+  a = .false.;
+end subroutine
+
+subroutine l2(a)
+  logical :: a(20)
+  a(:) = .false.;
+end subroutine
+
+subroutine l3(a)
+  logical :: a(20)
+  a(1:20) = .false.;
+end subroutine
+
+! { dg-final { scan-tree-dump-times "memset" 12 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/array_memset_2.f90 b/gcc/testsuite/gfortran.dg/array_memset_2.f90
new file mode 100644
index 000000000..7805f7b94
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_memset_2.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! { dg-options "-O2 -fdump-tree-original" }
+
+module foo
+contains
+  subroutine bar(a)
+    real, dimension(:,:) :: a
+    a(1,:) = 0.
+  end subroutine bar
+end module foo
+
+program test
+  use foo
+  implicit none
+  real, dimension (2,2) :: a, d, e
+  real, dimension (1,2) :: b
+  real, dimension (2) :: c
+  data a, d, e /12*1.0/
+  data b /2*1.0/
+  data c /2*1.0/
+
+  a(1,:) = 0.    ! This can't be optimized to a memset.
+  b(1,:) = 0.    ! This is optimized to = {}.
+  c = 0.         ! This is optimized to = {}.
+  d(:,1) = 0.    ! This can't be otimized to a memset.
+  call bar(e)
+
+  if (any(a /= reshape((/ 0.0, 1.0, 0.0, 1.0/), shape(a)))) call abort
+  if (any(b /= 0.)) call abort
+  if (any(c /= 0.)) call abort
+  if (any(d /= reshape((/ 0.0, 0.0, 1.0, 1.0/), shape(d)))) call abort
+  if (any(e /= reshape((/ 0.0, 1.0, 0.0, 1.0/), shape(e)))) call abort
+
+end program
+
+! { dg-final { scan-tree-dump-times "= {}" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/array_reference_1.f90 b/gcc/testsuite/gfortran.dg/array_reference_1.f90
new file mode 100644
index 000000000..6de09919f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_reference_1.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+! Tests the fix for PR31994, aka 31867, in which the offset
+! of 'a' in both subroutines was being evaluated incorrectly.
+! The testcase for PR31867 is char_length_5.f90
+!
+! Contributed by Elizabeth Yip <elizabeth.l.yip@boeing.com>
+!            and Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!
+program main
+  call PR31994
+  call PR31994_comment6
+contains
+  subroutine PR31994

+    implicit none

+    complex (kind=4), dimension(2,2) :: a, b, c

+    a(1,1) = (1.,1.)

+    a(2,1) = (2.,2.)

+    a(1,2) = (3.,3.)

+    a(2,2) = (4.,4.)

+    b=conjg (transpose (a))

+    c=transpose (a)

+    c=conjg (c)

+    if (any (b .ne. c)) call abort ()
+  end subroutine PR31994
+  subroutine PR31994_comment6
+    implicit none

+    real ,dimension(2,2)::a
+    integer ,dimension(2,2) :: b, c
+    a = reshape ((/1.,2.,3.,4./), (/2,2/))
+    b=int (transpose(a))
+    c = int (a)
+    c = transpose (c)
+    if (any (b .ne. c)) call abort ()
+  end subroutine PR31994_comment6

+END program main

diff --git a/gcc/testsuite/gfortran.dg/array_return_value_1.f90 b/gcc/testsuite/gfortran.dg/array_return_value_1.f90
new file mode 100644
index 000000000..45699ffd7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_return_value_1.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! Tests the fix for PR27124 in which the unpacking of argument
+! temporaries and of array result temporaries occurred in the
+! incorrect order.
+! 
+! Test is based on the original example, provided by
+! Philippe Schaffnit <P.Schaffnit@access.rwth-aachen.de>
+!
+  PROGRAM Test
+    INTEGER :: Array(2, 3) = reshape ((/1,4,2,5,3,6/),(/2,3/))
+    integer :: Brray(2, 3) = 0
+    Brray(1,:) = Function_Test (Array(1,:))
+    if (any(reshape (Brray, (/6/)) .ne. (/11, 0, 12, 0, 13, 0/))) call abort ()
+    Array(1,:) = Function_Test (Array(1,:))
+    if (any(reshape (Array, (/6/)) .ne. (/11, 4, 12, 5, 13, 6/))) call abort ()
+
+  contains
+      FUNCTION Function_Test (Input)
+          INTEGER, INTENT(IN) :: Input(1:3)
+          INTEGER :: Function_Test(1:3)
+          Function_Test = Input + 10
+      END FUNCTION Function_Test
+  END PROGRAM Test
+
diff --git a/gcc/testsuite/gfortran.dg/array_section_1.f90 b/gcc/testsuite/gfortran.dg/array_section_1.f90
new file mode 100644
index 000000000..4d5eedf2a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_section_1.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! Tests the fix for PR30003, in which the 'end' of an array section
+! would not be evaluated at all if it was on the lhs of an assignment
+! or would be evaluated many times if bound checking were on.
+!
+! Contributed by Erik Edelmann <eedelmann@gcc.gnu.org>
+!
+    implicit none
+    integer :: a(5), b(3), cnt
+
+    b = [ 1, 2, 3 ]
+! Check the lhs references
+    cnt = 0
+    a(bar(1):3) = b
+    if (cnt /= 1) call abort ()
+    cnt = 0
+    a(1:bar(3)) = b
+    if (cnt /= 1) call abort ()
+    cnt = 0
+    a(1:3:bar(1)) = b
+    if (cnt /= 1) call abort ()
+! Check the rhs references
+    cnt = 0
+    a(1:3) = b(bar(1):3)
+    if (cnt /= 1) call abort ()
+    cnt = 0
+    a(1:3) = b(1:bar(3))
+    if (cnt /= 1) call abort ()
+    cnt = 0
+    a(1:3) = b(1:3:bar(1))
+    if (cnt /= 1) call abort ()
+contains
+    integer function bar(n)
+        integer, intent(in) :: n
+        cnt = cnt + 1
+        bar = n
+    end function bar
+end
diff --git a/gcc/testsuite/gfortran.dg/array_section_2.f90 b/gcc/testsuite/gfortran.dg/array_section_2.f90
new file mode 100644
index 000000000..ed5208cf3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_section_2.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR38033 - size(a) was not stabilized correctly and so the expression was
+! evaluated twice outside the loop and then within the scalarization loops.
+!
+! Contributed by Thomas Bruel  <tmbdev@gmail.com>
+!
+program test
+   integer, parameter :: n = 100
+   real, pointer :: a(:),temp(:)  ! pointer or allocatable have the same effect
+   allocate(a(n), temp(n))
+   temp(1:size(a)) = a
+end program
+! { dg-final { scan-tree-dump-times "MAX_EXPR\[^\n\t\]+ubound\[^\n\t\]+lbound" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/array_section_3.f90 b/gcc/testsuite/gfortran.dg/array_section_3.f90
new file mode 100644
index 000000000..d3093d14d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_section_3.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+!
+! PR fortran/54225
+!
+! Contributed by robb wu
+!
+program test
+  implicit none
+  real :: A(2,3)
+
+  print *, A(1, *)  ! { dg-error "Expected array subscript" }
+end program
+
+subroutine test2
+integer, dimension(2) :: a
+a(*) = 1  ! { dg-error "Expected array subscript" }
+end
diff --git a/gcc/testsuite/gfortran.dg/array_simplify_1.f90 b/gcc/testsuite/gfortran.dg/array_simplify_1.f90
new file mode 100644
index 000000000..c638dee0c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_simplify_1.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! Tests the fix for PR24168, in which line   would return
+! Error: Incompatible ranks 2 and 1 in assignment at (1)
+! This came about because the simplification of the binary
+! operation, in the first actual argument of spread, was not
+! returning the rank of the result.  Thus the error could
+! be generated with any operator and other intrinsics than
+! cshift.
+!
+! Contributed by Steve Kargl  <kargl@gcc.gnu.org>
+!
+ integer, parameter :: nx=2, ny=2
+ real, dimension(nx, ny) :: f
+ f = spread(2 * cshift((/ 1, 2 /), nx/2), 2, ny)
+end
+
diff --git a/gcc/testsuite/gfortran.dg/array_temporaries_1.f90 b/gcc/testsuite/gfortran.dg/array_temporaries_1.f90
new file mode 100644
index 000000000..64fc59046
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_temporaries_1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-Warray-temporaries" }
+
+subroutine bar(a)
+  real, dimension(2) :: a
+end
+
+program main
+  integer, parameter :: n=3
+  integer :: i
+  real, dimension(n) :: a, b
+
+  a = 0.2
+  i = 2
+  a(i:i+1) = a(1:2) ! { dg-warning "Creating array temporary" }
+  a = cshift(a,1) ! { dg-warning "Creating array temporary" }
+  b = cshift(a,1) 
+  call bar(a(1:3:2)) ! { dg-warning "Creating array temporary" }
+end program main
diff --git a/gcc/testsuite/gfortran.dg/array_temporaries_2.f90 b/gcc/testsuite/gfortran.dg/array_temporaries_2.f90
new file mode 100644
index 000000000..86e0a45e7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_temporaries_2.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-fcheck-array-temporaries" }
+ program test
+  implicit none
+  integer :: a(3,3)
+  call foo(a(:,1))  ! OK, no temporary created
+  call foo(a(1,:))  ! BAD, temporary var created
+contains
+  subroutine foo(x)
+    integer :: x(3)
+    x = 5
+  end subroutine foo
+end program test
+
+! { dg-output "At line 7 of file .*array_temporaries_2.f90(\n|\r\n|\r)Fortran runtime warning: An array temporary was created for argument 'x' of procedure 'foo'" }
diff --git a/gcc/testsuite/gfortran.dg/array_temporaries_3.f90 b/gcc/testsuite/gfortran.dg/array_temporaries_3.f90
new file mode 100644
index 000000000..929a4c08e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_temporaries_3.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! PR38119 - The scalarizer got the loop size wrong
+! for the temporary coming from the call to 'same'.
+!
+! Contributed by Mikael Morin <mikael.morin@tele2.fr>
+! based on a program by Vivek Rao.
+!
+module bar
+  implicit none
+  character(len = 2) :: c(1)
+contains
+  elemental function trim_append (xx,yy) result(xy)
+    character (len = *), intent(in) :: xx,yy
+    character (len = len (xx) + len (yy)) :: xy
+    xy = trim (xx) // trim (yy)
+  end function trim_append
+  function same(xx) result(yy)
+    character (len = *), intent(in) :: xx(:)
+    character (len = len (xx))       :: yy(size (xx))
+    yy = xx
+  end function same
+  subroutine xmain()
+    c =  trim_append(["a"],same(["b"]))  ! The problem occurred here
+  end subroutine xmain
+end module bar
+  use bar
+  call xmain
+  if (c(1) .ne. "ab") call abort
+end
+! { dg-final { cleanup-modules "bar" } }
+
diff --git a/gcc/testsuite/gfortran.dg/arrayio_0.f90 b/gcc/testsuite/gfortran.dg/arrayio_0.f90
new file mode 100644
index 000000000..3801a69e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_0.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! Tests fix for PR20840 - would ICE with vector subscript in 
+! internal unit.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+  character(len=12), dimension(4) :: iu, buff
+  character(len=48), dimension(2) :: iue
+  equivalence (iu, iue)
+  integer, dimension(4) :: v = (/2,1,4,3/)
+  iu = (/"Vector    ","subscripts","not       ","allowed!  "/)
+  read (iu, '(a12/)') buff
+  read (iue(1), '(4a12)') buff
+  read (iu(4:1:-1), '(a12/)') buff
+  read (iu(v), '(a12/)') buff           ! { dg-error "with vector subscript" }
+  read (iu((/2,4,3,1/)), '(a12/)') buff ! { dg-error "with vector subscript" }
+  print *, buff
+  end
+
diff --git a/gcc/testsuite/gfortran.dg/arrayio_1.f90 b/gcc/testsuite/gfortran.dg/arrayio_1.f90
new file mode 100644
index 000000000..7b40d6573
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_1.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! PR 21875 : Test formatted input/output to/from character arrays.
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+      program arrayio_1
+      implicit none
+      integer         :: i(6),j,k
+      character(12)  :: r(12,2) = '0123456789AB'
+ 
+! Write to and read from a whole character array
+
+      i = (/(j,j=1,6)/)
+      write(r,'(3(2x,i4/)/3(3x,i6/))') i
+      i = 0
+      read(r,'(3(2x,i4/)/3(3x,i6/))') i
+      if (any(i.ne.(/(j,j=1,6)/))) call abort()
+      do j=1,12
+         do k=1,2
+            if ((j.gt.8.and.k.eq.1).or.(k.eq.2)) then
+              if (r(j,k).ne.'0123456789AB') call abort()
+            end if
+         end do
+      end do
+
+ ! Write to a portion of a character array      
+      r = '0123456789AB'
+      write(r(3:9,1),'(6(i12/))') i
+      if (r(2,1).ne.'0123456789AB') call abort()
+      do j=3,8
+        if (iachar(trim(adjustl(r(j,1))))-46.ne.j) call abort()
+      end do
+      if (r(9,1).ne.'            ') call abort()
+      end program arrayio_1
diff --git a/gcc/testsuite/gfortran.dg/arrayio_10.f90 b/gcc/testsuite/gfortran.dg/arrayio_10.f90
new file mode 100644
index 000000000..2be99ec72
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_10.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! PR29563 Internal read loses data.
+! Test case submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+! Without patch, values get muddled.
+program pr29563
+  character(len=4), dimension(3)::arraydata = (/'1123',' 456','789 '/)
+  real(kind=8), dimension(3) :: tmp
+  read(arraydata,*,iostat=iostat)tmp
+  if (tmp(1).ne.1123.0) call abort()
+  if (tmp(2).ne.456.0) call abort()
+  if (tmp(3).ne.789.0) call abort()
+end program pr29563
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/arrayio_11.f90 b/gcc/testsuite/gfortran.dg/arrayio_11.f90
new file mode 100644
index 000000000..04735d11b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_11.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+! Tests the fix for PR30284, in which the substring plus
+! component reference for an internal file would cause an ICE.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+
+program gfcbug51
+  implicit none
+
+  type :: date_t
+    character(len=12) :: date      ! yyyymmddhhmm
+  end type date_t
+
+  type year_t
+    integer :: year = 0
+  end type year_t
+
+  type(date_t) :: file(3)
+  type(year_t) :: time(3)
+
+  FILE%date = (/'200612231200', '200712231200', &
+                '200812231200'/)
+
+  call date_to_year (FILE)
+  if (any (time%year .ne. (/2006, 2007, 2008/))) call abort ()
+
+  call month_to_date ((/8, 9, 10/), FILE)
+  if ( any (file%date .ne. (/'200608231200', '200709231200', &
+                             '200810231200'/))) call abort ()
+
+contains
+
+  subroutine date_to_year (d)
+    type(date_t) :: d(3)
+    read (d%date(1:4),'(i4)')  time%year
+  end subroutine
+
+  subroutine month_to_date (m, d)
+    type(date_t) :: d(3)
+    integer :: m(:)
+    write (d%date(5:6),'(i2.2)')  m
+  end subroutine month_to_date
+
+end program gfcbug51
diff --git a/gcc/testsuite/gfortran.dg/arrayio_12.f90 b/gcc/testsuite/gfortran.dg/arrayio_12.f90
new file mode 100644
index 000000000..09fa6c8a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_12.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+! Tests the fix for PR30626, in which the substring reference
+! for an internal file would cause an ICE.
+!
+! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+program gfcbug51
+  implicit none
+
+  character(len=12) :: cdate(3)      ! yyyymmddhhmm
+
+  type year_t
+    integer :: year = 0
+  end type year_t
+
+  type(year_t) :: time(3)
+
+  cdate = (/'200612231200', '200712231200', &
+            '200812231200'/)
+
+  call date_to_year (cdate)
+  if (any (time%year .ne. (/2006, 2007, 2008/))) call abort ()
+
+  call month_to_date ((/8, 9, 10/), cdate)
+  if ( any (cdate .ne. (/'200608231200', '200709231200', &
+                         '200810231200'/))) call abort ()
+
+contains
+
+  subroutine date_to_year (d)
+    character(len=12) :: d(3)
+    read (cdate(:)(1:4),'(i4)')  time%year
+  end subroutine
+
+  subroutine month_to_date (m, d)
+    character(len=12) :: d(3)
+    integer :: m(:)
+    write (cdate(:)(5:6),'(i2.2)')  m
+  end subroutine month_to_date
+
+end program gfcbug51
diff --git a/gcc/testsuite/gfortran.dg/arrayio_2.f90 b/gcc/testsuite/gfortran.dg/arrayio_2.f90
new file mode 100644
index 000000000..00b96bf41
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_2.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! PR 21875 : Test formatted input/output to/from character arrays.
+! This test ckecks proper positioning and padding with trailing blanks
+! after write operations.  Contributed by Paul Thomas.
+     program arrayio_2
+     implicit none
+     integer :: i=2
+     character(len=12), dimension(4,2)  :: r = "0123456789ab"
+     character(len=80)                  :: f
+
+     f = '("hello"/"world")'
+
+     write(r(1:4,i-1), f)
+
+     f = '("hello",t1,"HELLO",1x,"!"/"world",tl12,"WORLD")'
+
+     write(r((i-1):(i+1),i), f)
+
+     if ( r(1,1).ne.'hello       ' .or. &
+          r(2,1).ne.'world       ' .or. &
+          r(3,1).ne.'0123456789ab' .or. &
+          r(4,1).ne.'0123456789ab' .or. &
+          r(1,2).ne.'HELLO !     ' .or. &
+          r(2,2).ne.'WORLD       ' .or. &
+          r(3,2).ne.'0123456789ab' .or. &
+          r(4,2).ne.'0123456789ab') call abort()
+
+     end program arrayio_2 
diff --git a/gcc/testsuite/gfortran.dg/arrayio_3.f90 b/gcc/testsuite/gfortran.dg/arrayio_3.f90
new file mode 100644
index 000000000..eb872eb15
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_3.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! PR 21875 : Test formatted input/output to/from character arrays.
+! This test deliberately exceeds the record length in a write and verifies
+! the error message.  Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+      program arrayio_3
+      implicit none
+      integer        :: i(6),j,ierr
+      character(12)  :: r(4,2) = '0123456789AB'
+ 
+! Write using a format string that defines a record greater than 
+! the length of an element in the character array.
+
+      i = (/(j,j=1,6)/)
+      write(r,'(3(2x,i4/)/3(4x,i9/))', iostat=ierr) i
+      if (ierr.ne.-2) call abort()
+      end program arrayio_3
diff --git a/gcc/testsuite/gfortran.dg/arrayio_4.f90 b/gcc/testsuite/gfortran.dg/arrayio_4.f90
new file mode 100644
index 000000000..6236d2d67
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_4.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! PR 24244 : Test formatted input/output to/from character arrays.
+! This test checks array I/O with strides other than 1.
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+program arrayio_4
+  implicit none
+  integer        :: ierr
+  character(12)  :: r(2,3,4) = '0123456789AB'
+   
+  write(r(::2,:,::1),'(i5)', iostat=ierr) 1,2,3,4,5
+  if (ierr.ne.0) call abort()
+
+  write(r(:,:,::2),'(i5)', iostat=ierr) 1,2,3,4,5
+  if (ierr.ne.0) call abort()
+
+  write(r(::1,::2,::1),'(i5)', iostat=ierr) 1,2,3,4,5
+  if (ierr.ne.0) call abort()
+
+  write(r(::1,::1,::1),'(i5)', iostat=ierr) 1,2,3,4,5
+  if (ierr.ne.0) call abort()
+end program arrayio_4
+
diff --git a/gcc/testsuite/gfortran.dg/arrayio_5.f90 b/gcc/testsuite/gfortran.dg/arrayio_5.f90
new file mode 100644
index 000000000..cb062037a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_5.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! PR 21875 : Test formatted input/output to/from character arrays.
+! This test checks the error checking for end of file condition.
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+program arrayio_5
+  implicit none
+  integer        :: i,ierr
+  character(12)  :: r(10) = '0123456789AB'
+
+  write(r,'(i12)',iostat=ierr) 1,2,3,4,5,6,7,8,9,10,11
+  if (ierr.ne.-1) call abort()
+ end program arrayio_5
+
diff --git a/gcc/testsuite/gfortran.dg/arrayio_6.f90 b/gcc/testsuite/gfortran.dg/arrayio_6.f90
new file mode 100644
index 000000000..d9343ab36
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_6.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! PR24224 Test formatted input/output to/from character arrays with strides
+! other than 1.  Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+      program arrayio_6
+      implicit none
+      integer         :: i(3),j,k(3)
+      character(12)  :: r(4,4,4) = '0123456789AB'
+      character(12)  :: s(64)
+      equivalence(r,s)
+ 
+      i = (/(j,j=1,3)/)
+      write(r(1:4:2,2:4:1,3:4:2),'(3(2x,i4/)/3(3x,i6/))') i
+
+      if (s(36).ne.'0123456789AB') call abort()
+      if (s(37).ne.'     1      ') call abort()
+      if (s(38).ne.'0123456789AB') call abort()
+      if (s(39).ne.'     2      ') call abort()
+      if (s(40).ne.'0123456789AB') call abort()
+      if (s(41).ne.'     3      ') call abort()
+      if (s(42).ne.'0123456789AB') call abort()
+      if (s(43).ne.'            ') call abort()
+      if (s(44).ne.'0123456789AB') call abort()
+      if (s(45).ne.'            ') call abort()
+      if (s(46).ne.'0123456789AB') call abort()
+ 
+      k = i
+      i = 0
+      read(r(1:4:2,2:4:1,3:4:2),'(3(2x,i4/)/3(3x,i6/))') i
+      if (any(i.ne.k)) call abort()
+      
+      end program arrayio_6
diff --git a/gcc/testsuite/gfortran.dg/arrayio_7.f90 b/gcc/testsuite/gfortran.dg/arrayio_7.f90
new file mode 100644
index 000000000..68d1fbf97
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_7.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR24224 Test formatted input/output to/from character arrays with strides
+! other than 1.  Test that reading stops at the end of the current record.
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+program arrayio_7
+  character*4, dimension(8) :: abuf = (/"0123","4567","89AB","CDEF", &
+                                        "0123","4567","89AB","CDEF"/)
+  character*4, dimension(2,4) :: buf
+  character*8 :: a
+  equivalence (buf,abuf)
+  read(buf(2, 1:3:2), '(a8)') a
+  if (a.ne."4567") call abort()
+end program arrayio_7
diff --git a/gcc/testsuite/gfortran.dg/arrayio_8.f90 b/gcc/testsuite/gfortran.dg/arrayio_8.f90
new file mode 100644
index 000000000..7b609bd06
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_8.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR28339, This test checks that internal unit array I/O handles a full record
+! and advances to the next record properly.  Test case derived from PR
+! Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+      program main
+      integer          i
+      character*8      rec(3)
+      rec = ""
+      write (rec,fmt=99999)
+      if (rec(1).ne.'12345678') call abort()
+      if (rec(2).ne.'record2') call abort()
+      if (rec(3).ne.'record3') call abort()
+99999 format ('12345678',/'record2',/'record3')
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/arrayio_9.f90 b/gcc/testsuite/gfortran.dg/arrayio_9.f90
new file mode 100644
index 000000000..f8efdf19d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_9.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! PR29563 Internal read loses data.
+! Test from test case. Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+! Without patch, last value in array was being skipped in the read.
+program pr29563
+  character(len=10), dimension(3)::arraydata = (/' 1 2 3',' 4 5 6',' 7 8 9'/)
+  real(kind=8), dimension(3,3) :: tmp
+  tmp = 0.0
+  read(arraydata,*,iostat=iostat)((tmp(i,j),j=1,3),i=1,3)
+  if (tmp(3,3)-9.0.gt.0.0000001) call abort()
+end program pr29563
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/arrayio_derived_1.f90 b/gcc/testsuite/gfortran.dg/arrayio_derived_1.f90
new file mode 100644
index 000000000..dd12561b7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_derived_1.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! PR 24862: IO for arrays of derived type handled incorrectly.
+program arrayio_derived_1
+  implicit none
+  type tp
+     integer :: i
+     character(len=1) :: c
+  end type tp
+  type(tp) :: x(5)
+  character(len=500) :: a
+  integer :: i, b(5)
+
+  x%i = 256
+  x%c = "q"
+
+  write(a, *) x%i
+  read(a, *) b
+  do i = 1, 5
+     if (b(i) /= 256) then
+        call abort ()
+     end if
+  end do
+  write(a, *) x ! Just test that the library doesn't abort.
+  write(a, *) x(:)%i
+  b = 0
+  read(a, *) b
+  do i = 1, 5
+     if (b(i) /= 256) then
+        call abort ()
+     end if
+  end do
+
+end program arrayio_derived_1
diff --git a/gcc/testsuite/gfortran.dg/arrayio_derived_2.f90 b/gcc/testsuite/gfortran.dg/arrayio_derived_2.f90
new file mode 100644
index 000000000..5ebe602fd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_derived_2.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! PR 24266: IO to/from arrays that are components of derived types.
+program main
+  implicit none
+
+  type ice
+    character(len=80) :: mess(3)
+  end type ice
+  type(ice) :: tp
+  integer :: i
+  character(len=80) :: mess
+
+  write(tp%mess,*) "message"
+  read(tp%mess,*) mess
+  print *, mess
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/assign-debug.f90 b/gcc/testsuite/gfortran.dg/assign-debug.f90
new file mode 100644
index 000000000..bd4412112
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign-debug.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! { dg-options "-fcompare-debug -O2" }
+      program test
+      integer i
+      common i
+      assign 2000 to i  ! { dg-warning "Deleted feature: ASSIGN statement" }
+2000  continue
+      end
diff --git a/gcc/testsuite/gfortran.dg/assign.f90 b/gcc/testsuite/gfortran.dg/assign.f90
new file mode 100644
index 000000000..2d9e497fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+! Program to test ASSIGNing a label to common variable. PR18827.
+      program test
+      integer i
+      common i
+      assign 2000 to i  ! { dg-warning "Deleted feature: ASSIGN statement" }
+2000  continue
+      end
diff --git a/gcc/testsuite/gfortran.dg/assign_1.f90 b/gcc/testsuite/gfortran.dg/assign_1.f90
new file mode 100644
index 000000000..81aaeff2d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign_1.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! Option passed to avoid excess errors from obsolete warning
+! { dg-options "-w" }
+      integer i(5)
+      assign 1000 to i   ! { dg-error "scalar default INTEGER" }
+ 1000 continue
+      end
diff --git a/gcc/testsuite/gfortran.dg/assign_10.f90 b/gcc/testsuite/gfortran.dg/assign_10.f90
new file mode 100644
index 000000000..e52302556
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign_10.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-options "-O3 -fdump-tree-original" }
+! Tests the fix for PR33850, in which one of the two assignments
+! below would produce an unnecessary temporary for the index
+! expression, following the fix for PR33749.
+!
+! Contributed by Dick Hendrickson on comp.lang.fortran,
+! " Most elegant syntax for inverting a permutation?" 20071006
+!
+  integer(4) :: p4(4) = (/2,4,1,3/)
+  integer(4) :: q4(4) = (/2,4,1,3/)
+  integer(8) :: p8(4) = (/2,4,1,3/)
+  integer(8) :: q8(4) = (/2,4,1,3/)
+  p4(q4) = (/(i, i = 1, 4)/)
+  q4(q4) = (/(i, i = 1, 4)/)
+  p8(q8) = (/(i, i = 1, 4)/)
+  q8(q8) = (/(i, i = 1, 4)/)
+  if (any(p4 .ne. q4)) call abort ()
+  if (any(p8 .ne. q8)) call abort ()
+end
+! Whichever is the default length for array indices will yield
+! parm 18 times, because a temporary is not necessary.  The other
+! cases will all yield a temporary, so that atmp appears 18 times.
+! Note that it is the kind conversion that generates the temp.
+!
+! { dg-final { scan-tree-dump-times "parm" 18 "original" } }
+! { dg-final { scan-tree-dump-times "atmp" 18 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/assign_2.f90 b/gcc/testsuite/gfortran.dg/assign_2.f90
new file mode 100644
index 000000000..6db1f2fe8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign_2.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! Option passed to avoid excess errors from obsolete warning
+! { dg-options "-w" }
+! PR18827
+      integer i,j
+      common /foo/ i,j
+      assign 1000 to j
+      j = 5
+      goto j
+ 1000 continue
+      end
diff --git a/gcc/testsuite/gfortran.dg/assign_3.f90 b/gcc/testsuite/gfortran.dg/assign_3.f90
new file mode 100644
index 000000000..a43b10c11
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign_3.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! Option passed to avoid excess errors from obsolete warning
+! { dg-options "-w" }
+! PR18827
+      integer i,j
+      equivalence (i,j)
+      assign 1000 to i
+      write (*, j) ! { dg-error "not been assigned a format label" }
+      goto j   ! { dg-error "not been assigned a target label" }
+ 1000 continue
+      end
diff --git a/gcc/testsuite/gfortran.dg/assign_4.f b/gcc/testsuite/gfortran.dg/assign_4.f
new file mode 100644
index 000000000..3277f7c74
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign_4.f
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! Option passed to avoid excess errors from obsolete warning
+! { dg-options "-w" }
+! PR17423
+      program testit
+c
+      assign 12 to i
+      write(*, i) 
+ 0012 format (" **** ASSIGN FORMAT NUMBER TO INTEGER VARIABLE ****" )
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/assign_5.f90 b/gcc/testsuite/gfortran.dg/assign_5.f90
new file mode 100644
index 000000000..632bd0917
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign_5.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! Assign a label to a dummy argument.
+! Option passed to avoid excess errors from obsolete warning
+! { dg-options "-w" }
+
+subroutine s1 (a)
+integer a
+assign 777 to a
+go to a
+777 continue
+end
+program test
+call s1 (1)
+end
+
diff --git a/gcc/testsuite/gfortran.dg/assign_6.f b/gcc/testsuite/gfortran.dg/assign_6.f
new file mode 100644
index 000000000..135546b14
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign_6.f
@@ -0,0 +1,10 @@
+C { dg-do run }
+C Option passed to avoid excess errors from obsolete warning
+C { dg-options "-w" }
+C PR22290
+
+      integer nz
+      assign 93 to nz
+      go to nz,(93)
+  93  continue
+      end
diff --git a/gcc/testsuite/gfortran.dg/assign_7.f b/gcc/testsuite/gfortran.dg/assign_7.f
new file mode 100644
index 000000000..cb6b8258b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign_7.f
@@ -0,0 +1,16 @@
+C { dg-do compile }
+C Option passed to avoid excess errors from obsolete warning
+C { dg-options "-w" }
+
+      PROGRAM FM013
+      IF (ICZERO) 31270, 1270, 31270
+ 1270 CONTINUE
+ 1272 ASSIGN 1273 TO J
+ 1273 ASSIGN 1274 TO J
+ 1274 ASSIGN 1275 TO J
+      GOTO 1276
+ 1275 continue
+ 1276 GOTO J, ( 1272, 1273, 1274, 1275 )
+31270 IVDELE = IVDELE + 1
+      END
+
diff --git a/gcc/testsuite/gfortran.dg/assign_8.f90 b/gcc/testsuite/gfortran.dg/assign_8.f90
new file mode 100644
index 000000000..f958e9859
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign_8.f90
@@ -0,0 +1,4 @@
+! { dg-do compile }
+! PR fortran/20883
+      write (*, a) b ! { dg-error "must be of type CHARACTER or INTEGER" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/assign_9.f90 b/gcc/testsuite/gfortran.dg/assign_9.f90
new file mode 100644
index 000000000..2c2337ec0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign_9.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! Tests the fix for PR33749, in which one of the two assignments
+! below would not produce a temporary for the index expression.
+!
+! Contributed by Dick Hendrickson on comp.lang.fortran,
+! " Most elegant syntax for inverting a permutation?" 20071006
+!
+  integer(4) :: p(4) = (/2,4,1,3/)
+  integer(8) :: q(4) = (/2,4,1,3/)
+  p(p) = (/(i, i = 1, 4)/)
+  q(q) = (/(i, i = 1, 4)/)
+  if (any(p .ne. q)) call abort ()
+end
+
diff --git a/gcc/testsuite/gfortran.dg/assign_func_dtcomp_1.f90 b/gcc/testsuite/gfortran.dg/assign_func_dtcomp_1.f90
new file mode 100644
index 000000000..385eb2715
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assign_func_dtcomp_1.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! { dg-options "-O0" }
+!
+! Test fix for PR18022.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+program assign_func_dtcomp
+ implicit none
+ type                         ::  mytype
+   real                       ::  x
+   real                       ::  y
+ end type mytype
+ type (mytype), dimension (4) ::  z
+
+ type                         ::  thytype
+   real                       ::  x(4)
+ end type thytype
+ type (thytype)               ::  w
+ real, dimension (4)          ::  a = (/1.,2.,3.,4./)
+ real, dimension (4)          ::  b = (/5.,6.,7.,8./)
+
+
+! Test the original problem is fixed.
+ z(:)%x = foo (a)
+ z(:)%y = foo (b)
+
+
+ if (any(z%x.ne.a).or.any(z%y.ne.b)) call abort ()
+
+! Make sure we did not break anything on the way.
+ w%x(:) = foo (b)
+ a = foo (b)
+
+ if (any(w%x.ne.b).or.any(a.ne.b)) call abort ()
+
+contains
+
+ function foo (v) result (ans)
+   real, dimension (:), intent(in)   ::  v
+   real, dimension (size(v))  ::  ans
+   ans = v
+ end function foo
+
+
+end program assign_func_dtcomp
+
diff --git a/gcc/testsuite/gfortran.dg/assignment_1.f90 b/gcc/testsuite/gfortran.dg/assignment_1.f90
new file mode 100644
index 000000000..c8018a3d4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assignment_1.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! { dg-options -Wsurprising }
+integer, pointer :: p
+integer, target :: t, s
+
+! The tests for character pointers are currently commented out,
+! because they don't yet work correctly.
+! This is PR 17192
+!!$character*5, pointer :: d
+!!$character*5, target :: c, e
+
+t = 1
+p => s
+! We didn't dereference the pointer in the following line.
+p = f() ! { dg-warning "POINTER valued function" "" }
+p = p+1
+if (p.ne.2) call abort()
+if (p.ne.s) call abort()
+
+!!$! verify that we also dereference correctly the result of a function 
+!!$! which returns its result by reference
+!!$c = "Hallo"
+!!$d => e
+!!$d = g() !  dg-warning "POINTER valued function" "" 
+!!$if (d.ne."Hallo") call abort()
+
+contains
+function f()
+integer, pointer :: f
+f => t
+end function f
+!!$function g()
+!!$character, pointer :: g
+!!$g => c
+!!$end function g
+end
diff --git a/gcc/testsuite/gfortran.dg/assignment_2.f90 b/gcc/testsuite/gfortran.dg/assignment_2.f90
new file mode 100644
index 000000000..18f303b36
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assignment_2.f90
@@ -0,0 +1,50 @@
+! { dg-do compile }
+!
+! PR fortran/35033
+!
+! The checks for assignments were too strict.
+!
+MODULE m1
+          INTERFACE ASSIGNMENT(=)
+             SUBROUTINE s(a,b)
+                 REAL,INTENT(OUT) :: a(1,*)
+                 REAL,INTENT(IN) :: b(:)
+             END SUBROUTINE
+          END Interface
+contains
+  subroutine test1()
+          REAL,POINTER :: p(:,:),q(:)
+          CALL s(p,q) 
+          p = q
+  end subroutine test1
+end module m1
+
+MODULE m2
+          INTERFACE ASSIGNMENT(=)
+             SUBROUTINE s(a,b)
+                 REAL,INTENT(OUT),VOLATILE :: a(1,*)
+                 REAL,INTENT(IN) :: b(:)
+             END SUBROUTINE
+          END Interface
+contains
+  subroutine test1()
+          REAL,POINTER :: p(:,:),q(:)
+          CALL s(p,q) ! { dg-error "requires an assumed-shape or pointer-array dummy" }
+!TODO: The following is rightly rejected but the error message is misleading.
+! The actual reason is the mismatch between pointer array and VOLATILE
+          p = q ! { dg-error "Incompatible ranks" }
+  end subroutine test1
+end module m2
+
+MODULE m3
+          INTERFACE ASSIGNMENT(=)
+             module procedure s
+          END Interface
+contains
+             SUBROUTINE s(a,b) ! { dg-error "must not redefine an INTRINSIC type" }
+                 REAL,INTENT(OUT),VOLATILE :: a(1,*)
+                 REAL,INTENT(IN) :: b(:,:)
+             END SUBROUTINE
+end module m3
+
+! { dg-final { cleanup-modules "m1 m2 m3" } }
diff --git a/gcc/testsuite/gfortran.dg/assignment_3.f90 b/gcc/testsuite/gfortran.dg/assignment_3.f90
new file mode 100644
index 000000000..cdaaa8c5a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assignment_3.f90
@@ -0,0 +1,63 @@
+! { dg-do compile }
+! PR fortran/36316
+!
+! gfortran generated a mismatching tree ("type mismatch in binary expression")
+! for array bounds (mixing integer kind=4/kind=8 without fold_convert).
+!
+MODULE YOMCAIN
+
+IMPLICIT NONE
+SAVE
+
+TYPE distributed_vector
+REAL, pointer :: local(:)
+INTEGER(4)       :: global_length,local_start
+INTEGER(8)       :: local_end
+END TYPE distributed_vector
+
+INTERFACE ASSIGNMENT (=)
+MODULE PROCEDURE assign_ar_dv
+END INTERFACE
+
+INTERFACE OPERATOR (*)
+MODULE PROCEDURE multiply_dv_dv
+END INTERFACE
+
+CONTAINS
+
+SUBROUTINE assign_ar_dv (handle,pvec)
+
+!         copy array to the distributed_vector
+
+REAL,                      INTENT(IN)    :: pvec(:)
+TYPE (distributed_vector), INTENT(INOUT) :: handle
+
+handle%local(:) = pvec(:)
+
+RETURN
+END SUBROUTINE assign_ar_dv
+
+FUNCTION multiply_dv_dv (handle1,handle2)
+
+!         multiply two distributed_vectors
+
+TYPE (distributed_vector), INTENT(IN) :: handle2
+TYPE (distributed_vector), INTENT(IN) :: handle1
+REAL :: multiply_dv_dv(handle1%local_start:handle1%local_end)
+
+multiply_dv_dv = handle1%local(:) * handle2%local(:)
+
+RETURN
+END FUNCTION multiply_dv_dv
+
+
+SUBROUTINE CAININAD_SCALE_DISTVEC ()
+TYPE (distributed_vector) :: PVAZG
+TYPE (distributed_vector) :: ZTEMP
+TYPE (distributed_vector) :: SCALP_DV
+
+ZTEMP = PVAZG * SCALP_DV
+END SUBROUTINE CAININAD_SCALE_DISTVEC
+END MODULE YOMCAIN
+
+! { dg-final { cleanup-modules "yomcain" } }
diff --git a/gcc/testsuite/gfortran.dg/associate_1.f03 b/gcc/testsuite/gfortran.dg/associate_1.f03
new file mode 100644
index 000000000..d7b14aebe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_1.f03
@@ -0,0 +1,114 @@
+! { dg-do run }
+! { dg-options "-std=f2003 -fall-intrinsics -cpp" }
+
+! PR fortran/38936
+! Check the basic semantics of the ASSOCIATE construct.
+
+PROGRAM main
+  IMPLICIT NONE
+  REAL :: a, b, c
+  INTEGER, ALLOCATABLE :: arr(:)
+  INTEGER :: mat(3, 3)
+
+  TYPE :: myt
+    INTEGER :: comp
+  END TYPE myt
+
+  TYPE(myt) :: tp
+
+  a = -2.0
+  b = 3.0
+  c = 4.0
+
+  ! Simple association to expressions.
+  ASSOCIATE (r => SQRT (a**2 + b**2 + c**2), t => a + b)
+    PRINT *, t, a, b
+    IF (ABS (r - SQRT (4.0 + 9.0 + 16.0)) > 1.0e-3) CALL abort ()
+    IF (ABS (t - a - b) > 1.0e-3) CALL abort ()
+  END ASSOCIATE
+
+  ! Test association to arrays.
+  ALLOCATE (arr(3))
+  arr = (/ 1, 2, 3 /)
+  ASSOCIATE (doubled => 2 * arr, xyz => func ())
+    IF (SIZE (doubled) /= SIZE (arr)) CALL abort ()
+    IF (doubled(1) /= 2 .OR. doubled(2) /= 4 .OR. doubled(3) /= 6) &
+      CALL abort ()
+
+    IF (ANY (xyz /= (/ 1, 3, 5 /))) CALL abort ()
+  END ASSOCIATE
+
+  ! Target is vector-indexed.
+  ASSOCIATE (foo => arr((/ 3, 1 /)))
+    IF (LBOUND (foo, 1) /= 1 .OR. UBOUND (foo, 1) /= 2) CALL abort ()
+    IF (foo(1) /= 3 .OR. foo(2) /= 1) CALL abort ()
+  END ASSOCIATE
+
+  ! Named and nested associate.
+  myname: ASSOCIATE (x => a - b * c)
+    ASSOCIATE (y => 2.0 * x)
+      IF (ABS (y - 2.0 * (a - b * c)) > 1.0e-3) CALL abort ()
+    END ASSOCIATE
+  END ASSOCIATE myname ! Matching end-label.
+
+  ! Correct behaviour when shadowing already existing names.
+  ASSOCIATE (a => 1 * b, b => 1 * a, x => 1, y => 2)
+    IF (ABS (a - 3.0) > 1.0e-3 .OR. ABS (b + 2.0) > 1.0e-3) CALL abort ()
+    ASSOCIATE (x => 1 * y, y => 1 * x)
+      IF (x /= 2 .OR. y /= 1) CALL abort ()
+    END ASSOCIATE
+  END ASSOCIATE
+
+  ! Association to variables.
+  mat = 0
+  mat(2, 2) = 5;
+  ASSOCIATE (x => arr(2), y => mat(2:3, 1:2))
+    IF (x /= 2) CALL abort ()
+    IF (ANY (LBOUND (y) /= (/ 1, 1 /) .OR. UBOUND (y) /= (/ 2, 2 /))) &
+      CALL abort ()
+    IF (y(1, 2) /= 5) CALL abort ()
+
+    x = 7
+    y = 8
+  END ASSOCIATE
+  IF (arr(2) /= 7 .OR. ANY (mat(2:3, 1:2) /= 8)) CALL abort ()
+
+  ! Association to derived type and component.
+  tp = myt (1)
+  ASSOCIATE (x => tp, y => tp%comp)
+    IF (x%comp /= 1) CALL abort ()
+    IF (y /= 1) CALL abort ()
+    y = 5
+    IF (x%comp /= 5) CALL abort ()
+  END ASSOCIATE
+  IF (tp%comp /= 5) CALL abort ()
+
+  ! Association to character variables.
+  ! FIXME: Enable character test, once this works.
+  !CALL test_char (5)
+
+CONTAINS
+
+  FUNCTION func ()
+    INTEGER :: func(3)
+    func = (/ 1, 3, 5 /)
+  END FUNCTION func
+
+#if 0
+  ! Test association to character variable with automatic length.
+  SUBROUTINE test_char (n)
+    INTEGER, INTENT(IN) :: n
+
+    CHARACTER(LEN=n) :: str
+
+    str = "foobar"
+    ASSOCIATE (my => str)
+      IF (LEN (my) /= n) CALL abort ()
+      IF (my /= "fooba") CALL abort ()
+      my = "abcdef"
+    END ASSOCIATE
+    IF (str /= "abcde") CALL abort ()
+  END SUBROUTINE test_char
+#endif
+
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/associate_2.f95 b/gcc/testsuite/gfortran.dg/associate_2.f95
new file mode 100644
index 000000000..a41398d78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_2.f95
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! PR fortran/38936
+! Test that F95 rejects ASSOCIATE.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  ASSOCIATE (a => 5) ! { dg-error "Fortran 2003" }
+  END ASSOCIATE
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/associate_3.f03 b/gcc/testsuite/gfortran.dg/associate_3.f03
new file mode 100644
index 000000000..20a375dcf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_3.f03
@@ -0,0 +1,37 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! PR fortran/38936
+! Check for errors with ASSOCIATE during parsing.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  ASSOCIATE ! { dg-error "Expected association list" }
+
+  ASSOCIATE () ! { dg-error "Expected association" }
+
+  ASSOCIATE (a => 1) 5 ! { dg-error "Junk after ASSOCIATE" }
+
+  ASSOCIATE (x =>) ! { dg-error "Expected association" }
+
+  ASSOCIATE (=> 5) ! { dg-error "Expected association" }
+
+  ASSOCIATE (x => 5, ) ! { dg-error "Expected association" }
+
+  myname: ASSOCIATE (a => 1)
+  END ASSOCIATE ! { dg-error "Expected block name of 'myname'" }
+
+  ASSOCIATE (b => 2)
+  END ASSOCIATE myname ! { dg-error "Syntax error in END ASSOCIATE" }
+
+  myname2: ASSOCIATE (c => 3)
+  END ASSOCIATE myname3 ! { dg-error "Expected label 'myname2'" }
+
+  ASSOCIATE (a => 1, b => 2, a => 3) ! { dg-error "Duplicate name 'a'" }
+
+  ASSOCIATE (a => 5)
+    INTEGER :: b ! { dg-error "Unexpected data declaration statement" }
+  END ASSOCIATE
+END PROGRAM main ! { dg-error "Expecting END ASSOCIATE" }
+! { dg-excess-errors "Unexpected end of file" }
diff --git a/gcc/testsuite/gfortran.dg/associate_4.f08 b/gcc/testsuite/gfortran.dg/associate_4.f08
new file mode 100644
index 000000000..c336af2ab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_4.f08
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=f2008 -fcoarray=single" }
+
+! PR fortran/38936
+! Check for error with coindexed target.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER :: a[*]
+
+  ASSOCIATE (x => a[1]) ! { dg-error "must not be coindexed" }
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/associate_5.f03 b/gcc/testsuite/gfortran.dg/associate_5.f03
new file mode 100644
index 000000000..64345d323
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_5.f03
@@ -0,0 +1,43 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! PR fortran/38936
+! Check for errors with ASSOCIATE during resolution.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER :: nontarget
+  INTEGER :: arr(3)
+  INTEGER, POINTER :: ptr
+
+  ASSOCIATE (a => 5) ! { dg-error "is used as array" }
+    PRINT *, a(3)
+  END ASSOCIATE
+
+  ASSOCIATE (a => nontarget)
+    ptr => a ! { dg-error "neither TARGET nor POINTER" }
+  END ASSOCIATE
+
+  ASSOCIATE (a => 5, b => arr((/ 1, 3 /)))
+    a = 4 ! { dg-error "variable definition context" }
+    b = 7 ! { dg-error "variable definition context" }
+    CALL test2 (a) ! { dg-error "variable definition context" }
+    CALL test2 (b) ! { dg-error "variable definition context" }
+  END ASSOCIATE
+
+CONTAINS
+
+  SUBROUTINE test (x)
+    INTEGER, INTENT(IN) :: x
+    ASSOCIATE (y => x) ! { dg-error "variable definition context" }
+      y = 5 ! { dg-error "variable definition context" }
+      CALL test2 (x) ! { dg-error "variable definition context" }
+    END ASSOCIATE
+  END SUBROUTINE test
+
+  ELEMENTAL SUBROUTINE test2 (x)
+    INTEGER, INTENT(OUT) :: x
+    x = 5
+  END SUBROUTINE test2
+
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/associate_6.f03 b/gcc/testsuite/gfortran.dg/associate_6.f03
new file mode 100644
index 000000000..ba0e5c098
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_6.f03
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! { dg-options "-std=f2003 -fdump-tree-original" }
+
+! PR fortran/38936
+! Check that array expression association (with correct bounds) works for
+! complicated expressions.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+MODULE m
+  IMPLICIT NONE
+
+CONTAINS
+
+  PURE FUNCTION func (n)
+    INTEGER, INTENT(IN) :: n
+    INTEGER :: func(2 : n+1)
+
+    INTEGER :: i
+
+    func = (/ (i, i = 1, n) /)
+  END FUNCTION func
+
+END MODULE m
+
+PROGRAM main
+  USE :: m
+  IMPLICIT NONE
+
+  ASSOCIATE (arr => func (4))
+    ! func should only be called once here, not again for the bounds!
+
+    IF (LBOUND (arr, 1) /= 1 .OR. UBOUND (arr, 1) /= 4) CALL abort ()
+    IF (arr(1) /= 1 .OR. arr(4) /= 4) CALL abort ()
+  END ASSOCIATE
+END PROGRAM main
+! { dg-final { cleanup-modules "m" } }
+! { dg-final { scan-tree-dump-times "func" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/associate_7.f03 b/gcc/testsuite/gfortran.dg/associate_7.f03
new file mode 100644
index 000000000..6fd3f343d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_7.f03
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+
+! PR fortran/38936
+! Check association and pointers.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER, TARGET :: tgt
+  INTEGER, POINTER :: ptr
+
+  tgt = 1
+  ASSOCIATE (x => tgt)
+    ptr => x
+    IF (ptr /= 1) CALL abort ()
+    ptr = 2
+  END ASSOCIATE
+  IF (tgt /= 2) CALL abort ()
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/associate_8.f03 b/gcc/testsuite/gfortran.dg/associate_8.f03
new file mode 100644
index 000000000..a6f9938f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_8.f03
@@ -0,0 +1,37 @@
+! { dg-do run }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+
+! PR fortran/38936
+! Check associate to polymorphic entities.
+
+! Contributed by Tobias Burnus, burnus@gcc.gnu.org.
+
+type t
+end type t
+
+type, extends(t) :: t2
+end type t2
+
+class(t), allocatable :: a, b
+allocate( t :: a)
+allocate( t2 :: b)
+
+associate ( one => a, two => b)
+  select type(two)
+    type is (t)
+      call abort ()
+    type is (t2)
+      print *, 'OK', two
+    class default
+      call abort ()
+  end select
+  select type(one)
+    type is (t2)
+      call abort ()
+    type is (t)
+      print *, 'OK', one
+    class default
+      call abort ()
+  end select
+end associate
+end
diff --git a/gcc/testsuite/gfortran.dg/associate_9.f03 b/gcc/testsuite/gfortran.dg/associate_9.f03
new file mode 100644
index 000000000..13a10fc0d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_9.f03
@@ -0,0 +1,51 @@
+! { dg-do compile }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+
+! FIXME: Change into run test and remove excess error expectation.
+
+! PR fortran/38936
+! Association to derived-type, where the target type is not know
+! during parsing (only resolution).
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE :: mynum
+    INTEGER :: comp
+  END TYPE mynum
+
+  INTERFACE OPERATOR(+)
+    MODULE PROCEDURE add
+  END INTERFACE OPERATOR(+)
+
+CONTAINS
+
+  PURE FUNCTION add (a, b)
+    TYPE(mynum), INTENT(IN) :: a, b
+    TYPE(mynum) :: add
+
+    add%comp = a%comp + b%comp
+  END FUNCTION add
+
+END MODULE m
+
+PROGRAM main
+  USE :: m
+  IMPLICIT NONE
+
+  TYPE(mynum) :: a
+  a = mynum (5)
+
+  ASSOCIATE (x => add (a, a))
+    IF (x%comp /= 10) CALL abort ()
+  END ASSOCIATE
+
+  ASSOCIATE (x => a + a)
+    IF (x%comp /= 10) CALL abort ()
+  END ASSOCIATE
+END PROGRAM main
+
+! { dg-excess-errors "Syntex error in IF" }
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/associated_1.f90 b/gcc/testsuite/gfortran.dg/associated_1.f90
new file mode 100644
index 000000000..e214fe272
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_1.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! PR 25292: Check that the intrinsic associated works with functions returning
+! pointers as arguments
+program test
+   real, pointer :: a, b
+
+   nullify(a,b)
+   if(associated(a,b).or.associated(a,a)) call abort()
+   allocate(a)
+   if(associated(b,a)) call abort()
+   if (.not.associated(x(a))) call abort ()
+   if (.not.associated(a, x(a))) call abort ()
+
+   nullify(b)
+   if (associated(x(b))) call abort ()
+   allocate(b)
+   if (associated(x(b), x(a))) call abort ()
+
+contains
+
+  function x(a) RESULT(b)
+    real, pointer :: a,b
+    b => a
+  end function x
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/associated_2.f90 b/gcc/testsuite/gfortran.dg/associated_2.f90
new file mode 100644
index 000000000..1ff8006de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_2.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+! Tests the implementation of 13.14.13 of the f95 standard
+! in respect of zero character and zero array length.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+  call test1 ()
+  call test2 ()
+  call test3 (0)
+  call test3 (1)
+contains
+  subroutine test1 ()
+    integer, pointer, dimension(:, :, :)  :: a, b
+    allocate (a(2,0,2))
+    b => a
+! Even though b is zero length, associated returns true because
+! the target argument is not present (case (i))
+    if (.not. associated (b)) call abort ()
+    deallocate (a)
+    nullify(a)
+    if(associated(a,a)) call abort()
+    allocate (a(2,1,2))
+    b => a
+    if (.not.associated (b)) call abort ()
+    deallocate (a)
+  end subroutine test1
+  subroutine test2 ()
+    integer, pointer, dimension(:, :, :)  :: a, b
+    allocate (a(2,0,2))
+    b => a
+! Associated returns false because target is present (case(iii)).
+    if (associated (b, a)) call abort ()
+    deallocate (a)
+    allocate (a(2,1,2))
+    b => a
+    if (.not.associated (b, a)) call abort ()
+    deallocate (a)
+  end subroutine test2
+  subroutine test3 (n)
+    integer :: n
+    character(len=n), pointer, dimension(:)  :: a, b
+    allocate (a(2))
+    b => a
+! Again, with zero character length associated returns false
+! if target is present.
+    if (associated (b, a) .and. (n .eq. 0)) call abort ()
+!
+    if ((.not.associated (b, a))  .and. (n .ne. 0)) call abort ()
+    deallocate (a)
+  end subroutine test3
+end
diff --git a/gcc/testsuite/gfortran.dg/associated_3.f90 b/gcc/testsuite/gfortran.dg/associated_3.f90
new file mode 100644
index 000000000..c0a7f9a26
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_3.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! Test for fix of PR27655
+!
+!Contributed by Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org> 
+  integer, pointer :: i
+  print *, associated(NULL(),i) ! { dg-error "not permitted as actual argument" }
+  print *, associated(i,NULL()) ! { dg-error "not permitted as actual argument" }
+end
diff --git a/gcc/testsuite/gfortran.dg/associated_4.f90 b/gcc/testsuite/gfortran.dg/associated_4.f90
new file mode 100644
index 000000000..dd4490b82
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_4.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! PR fortran/26801
+  implicit none
+
+  integer :: i
+  integer,target :: u
+  logical :: l
+  character(len=8) :: A
+  type dt
+    integer, pointer :: a => NULL()
+  end type dt
+  type(dt) :: obj(2)
+
+  i = 2
+  l = associated(obj(i)%a)
+  write(A,*) l
+  l = associated(obj(i)%a,u)
+  print *, l
+  write(A,*) l
+end
diff --git a/gcc/testsuite/gfortran.dg/associated_5.f90 b/gcc/testsuite/gfortran.dg/associated_5.f90
new file mode 100644
index 000000000..a2007752f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_5.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! PR 35719 - associated used to fail with zero-sized automatic arrays
+! Test case contributed by Dick Hendrickson
+
+      program try_mf1053
+
+      call       mf1053 (  1,   2,   3,   4)
+      end
+
+      SUBROUTINE MF1053 (nf1, nf2, nf3, nf4)
+      INTEGER, pointer :: ptr(:,:)
+      INTEGER, target  :: ILA1(NF2,NF4:NF3)
+
+      ptr => ILA1
+
+      if (ASSOCIATED (ptr, ILA1(NF1:NF2,NF4:NF3) ) ) call abort
+      if ( .not. ASSOCIATED(ptr) )  call abort
+
+      END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/associated_target_1.f90 b/gcc/testsuite/gfortran.dg/associated_target_1.f90
new file mode 100644
index 000000000..13df47023
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_target_1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! This tests the patch for PR27584, where an ICE would ensue if
+! a bad argument was fed for the target in ASSOCIATED.
+!
+! Contributed by Tobias Burnus  <tobias.burnus@physik.fu-berlin.de>
+!
+program test
+   implicit none
+   real, pointer :: x
+   real, target :: y
+   if(ASSOCIATED(X,(Y))) print *, 'Hello' ! { dg-error "VARIABLE or FUNCTION" }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/associated_target_2.f90 b/gcc/testsuite/gfortran.dg/associated_target_2.f90
new file mode 100644
index 000000000..b1179bea3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_target_2.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+!
+! PR fortran/35721
+!
+! ASSOCIATED(ptr, trgt) should return true if
+! the same storage units (in the same order)
+! gfortran was returning false if the strips
+! were different but only one (the same!) element
+! was present.
+!
+! Contributed by Dick Hendrickson
+!
+      program try_mg0028
+      implicit none
+      real  tda2r(2,3)
+
+      call       mg0028(tda2r,  1,  2,  3)
+
+      CONTAINS
+
+      SUBROUTINE MG0028(TDA2R,nf1,nf2,nf3)
+      integer        ::  nf1,nf2,nf3
+      real, target   ::  TDA2R(NF2,NF3)
+      real, pointer  ::  TLA2L(:,:),TLA2L1(:,:)
+      logical LL(4)
+      TLA2L => TDA2R(NF2:NF1:-NF2,NF3:NF1:-NF2)
+      TLA2L1 => TLA2L
+      LL(1) = ASSOCIATED(TLA2L)
+      LL(2) = ASSOCIATED(TLA2L,TLA2L1)
+      LL(3) = ASSOCIATED(TLA2L,TDA2R)
+      LL(4) = ASSOCIATED(TLA2L1,TDA2R(2:2,3:1:-2))  !should be true
+
+      if (any(LL .neqv. (/ .true., .true., .false., .true./))) then
+        print *, LL
+        print *, shape(TLA2L1)
+        print *, shape(TDA2R(2:2,3:1:-2))
+        stop
+      endif
+
+      END SUBROUTINE
+      END PROGRAM
diff --git a/gcc/testsuite/gfortran.dg/associated_target_3.f90 b/gcc/testsuite/gfortran.dg/associated_target_3.f90
new file mode 100644
index 000000000..e6a1d0f0a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_target_3.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+!
+! PR fortran/41777
+!
+module m
+type t2
+ integer :: i
+end type t2
+interface f
+ module procedure f2
+end interface f
+contains
+function f2(a)
+  type(t2), pointer :: f2,a
+  f2 => a
+end function f2
+end module m
+
+use m
+implicit none
+type(t2), pointer :: a
+allocate(a)
+if (.not. associated(a,f(a))) call abort()
+call cmpPtr(a,f2(a))
+call cmpPtr(a,f(a))
+deallocate(a)
+contains
+  subroutine cmpPtr(a,b)
+    type(t2), pointer :: a,b
+!    print *, associated(a,b)
+    if (.not. associated (a, b)) call abort()
+  end subroutine cmpPtr
+end
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/associated_target_4.f90 b/gcc/testsuite/gfortran.dg/associated_target_4.f90
new file mode 100644
index 000000000..24f331785
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_target_4.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+!
+! PR 44696: [OOP] ASSOCIATED fails on polymorphic variables
+!
+! Original test case by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+program rte1
+  implicit none
+  type::node_type
+     class(node_type),pointer::parent,child
+     integer::id
+  end type node_type
+  class(node_type),pointer::root
+  allocate(root)
+  allocate(root%child)
+  root%child%parent=>root
+  root%id=1
+  root%child%id=2
+  print *,root%child%id," is child of ",root%id,":"
+  print *,root%child%parent%id,root%id
+  if (.not. associated(root%child%parent,root)) call abort()
+end program rte1
diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_arg_1.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_arg_1.f90
new file mode 100644
index 000000000..4fc0efdec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_charlen_arg_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! From PR 33881
+  call create_watch_ss(" ")
+contains
+  subroutine create_watch_actual(name)
+    character(len=1) :: name(1)
+  end subroutine create_watch_actual
+
+  subroutine create_watch_ss(name,clock)
+    character(len=*) :: name
+    integer, optional :: clock
+    if (present(clock)) then
+      call create_watch_actual((/name/))
+    else
+      call create_watch_actual((/name/))
+    end if
+  end subroutine create_watch_ss
+end
diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_arg_2.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_arg_2.f90
new file mode 100644
index 000000000..e9481d8ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_charlen_arg_2.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! PR 50585: [4.6/4.7 Regression] ICE with assumed length character array argument
+!
+! Contributed by Stuart Mentzer <sgm@objexx.com>
+
+SUBROUTINE SUB1( str )
+  IMPLICIT NONE
+  CHARACTER(len=*) :: str(2)
+  CALL SUB2( str(1)(:3) )
+END SUBROUTINE
+
+SUBROUTINE SUB2( str )
+  IMPLICIT NONE
+  CHARACTER(*) :: str
+END SUBROUTINE 
diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_dummy.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_dummy.f90
new file mode 100644
index 000000000..04f0b9faa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_charlen_dummy.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! Test the fix for PR fortran/39893.
+! Original testcase provided by Deji Akingunola.
+! Reduced testcase provided by Dominique d'Humieres.
+!
+      SUBROUTINE XAUTOGET()
+      CHARACTER*(*) DICBA    ! { dg-error "Entity with assumed character" }
+      DATA DICBA /"CLIP" /
+      RETURN
+      END
diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_function_1.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_function_1.f90
new file mode 100644
index 000000000..a28934e25
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_charlen_function_1.f90
@@ -0,0 +1,80 @@
+! { dg-do compile }

+! { dg-options "-std=legacy" }

+! Tests the patch for PRs 25084, 20852, 25085 and 25086, all of

+! which involve assumed character length functions.

+! Compiled from original PR testcases, which were all contributed

+! by Joost VandeVondele  <jv244@cam.ac.uk>

+!

+! PR25084 - the error is not here but in any use of .IN.

+! It is OK to define an assumed character length function

+! in an interface but it cannot be invoked (5.1.1.5).

+

+MODULE M1

+ TYPE  SET

+  INTEGER  CARD

+ END  TYPE  SET

+END MODULE M1

+

+MODULE  INTEGER_SETS

+ INTERFACE  OPERATOR  (.IN.)

+  FUNCTION ELEMENT(X,A) ! { dg-error "cannot be assumed character length" }

+     USE M1

+     CHARACTER(LEN=*)      :: ELEMENT

+     INTEGER, INTENT(IN)   ::  X

+     TYPE(SET), INTENT(IN) ::   A

+  END FUNCTION ELEMENT

+ END  INTERFACE

+END MODULE

+

+! 5.1.1.5 of the Standard: A function name declared with an asterisk

+! char-len-param shall not be array-valued, pointer-valued, recursive

+! or pure

+! 

+! PR20852

+RECURSIVE FUNCTION TEST() ! { dg-error "cannot be recursive" }

+ CHARACTER(LEN=*) :: TEST

+ TEST = ""

+END FUNCTION

+

+!PR25085

+FUNCTION F1()             ! { dg-error "cannot be array-valued" }

+  CHARACTER(LEN=*), DIMENSION(10) :: F1

+  F1 = ""

+END FUNCTION F1

+

+!PR25086

+FUNCTION F2() result(f4)  ! { dg-error "cannot be pointer-valued" }

+  CHARACTER(LEN=*), POINTER  :: f4

+  f4 = ""

+END FUNCTION F2

+

+!PR?????

+pure FUNCTION F3()        ! { dg-error "cannot be pure" }

+  CHARACTER(LEN=*)  :: F3

+  F3 = ""

+END FUNCTION F3

+

+function not_OK (ch)

+  character(*) not_OK, ch ! OK in an external function

+  not_OK = ch

+end function not_OK

+

+  use m1

+

+  character(4) :: answer

+  character(*), external :: not_OK

+  integer :: i

+  type (set) :: z

+

+  interface

+    function ext (i)

+      character(*) :: ext

+      integer :: i

+    end function ext

+  end interface

+

+  answer = not_OK ("unOK") ! { dg-error "since it is not a dummy" }

+

+END

+

+! { dg-final { cleanup-modules "M1" } }

diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_function_2.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_function_2.f90
new file mode 100644
index 000000000..bd7d713f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_charlen_function_2.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }

+! Tests the fix for PR25416, which ICED in gfc_conv_function_call, when

+! treating SPREAD in the statement below.

+!

+! Contributed by Ulrich Weigand  <uweigand@gcc.gnu.org>

+function bug(self,strvec) result(res)

+  character(*) :: self

+  character(*), dimension(:), intent(in) :: strvec

+  logical(kind=kind(.true.)) :: res

+

+  res = any(index(strvec,spread(self,1,size(strvec))) /= 0)

+end function

+

diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_function_3.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_function_3.f90
new file mode 100644
index 000000000..912126fe7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_charlen_function_3.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }

+! Tests the patch for PRs 25084, 20852, 25085 and 25086, all of

+! which involve assumed character length functions.

+! This test checks the things that should not emit errors.

+!

+! Contributed by Paul Thomas  <pault@gcc.gnu.org>

+!

+function is_OK (ch)                ! { dg-warning "Obsolescent feature" }

+  character(*) is_OK, ch           ! OK in an external function

+  is_OK = ch

+end function is_OK

+

+! The warning occurs twice for the next line; for 'more_OK' and for 'fcn';

+function more_OK (ch, fcn)         ! { dg-warning "Obsolescent feature" }

+  character(*) more_OK, ch

+  character (*), external :: fcn   ! OK as a dummy argument

+  more_OK = fcn (ch)

+end function more_OK

+

+  character(4) :: answer

+  character(4), external :: is_OK, more_OK

+

+  answer = is_OK ("isOK")          ! LEN defined in calling scope

+  print *, answer

+

+  answer = more_OK ("okay", is_OK) ! Actual arg has defined LEN

+  print *, answer

+

+  answer = also_OK ("OKOK")

+  print *, answer

+

+contains

+  function also_OK (ch)

+    character(4) also_OK

+    character(*) ch

+    also_OK = is_OK (ch)            ! LEN obtained by host association

+  end function also_OK

+END

+

diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_function_4.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_function_4.f90
new file mode 100644
index 000000000..c8f804465
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_charlen_function_4.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! Tests the fix for PR28600 in which the declaration for the
+! character length n, would be given the DECL_CONTEXT of 'gee'
+! thus causing an ICE.
+!
+! Contributed by Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+!
+subroutine bar(s, n)
+ integer n
+ character s*(n)
+ character*3, dimension(:), pointer :: m
+ s = ""
+contains
+ subroutine gee
+    m(1) = s(1:3)
+ end subroutine gee
+end subroutine bar
diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_function_5.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_function_5.f90
new file mode 100644
index 000000000..8a0788978
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_charlen_function_5.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+! Tests the patch for PR28890, in which a reference to a legal reference
+! to an assumed character length function, passed as a dummy, would
+! cause an ICE.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+character(*) function charrext (n)  ! { dg-warning "Obsolescent feature" }
+  character(26) :: alpha ="abcdefghijklmnopqrstuvwxyz"
+  charrext = alpha (1:n)
+end function charrext
+
+  character(26), external :: charrext
+  interface
+    integer(4) function test(charr, i)  ! { dg-warning "Obsolescent feature" }
+     character(*), external :: charr
+     integer :: i
+    end function test
+  end interface
+
+  do j = 1 , 26
+    m = test (charrext, j)
+    m = ctest (charrext, 27 - j)
+  end do
+contains
+  integer(4) function ctest(charr, i)  ! { dg-warning "Obsolescent feature" }
+    character(*) :: charr
+    integer :: i
+    print *, charr(i)
+    ctest = 1
+  end function ctest
+end
+
+integer(4) function test(charr, i)  ! { dg-warning "Obsolescent feature" }
+  character(*) :: charr
+  integer :: i
+  print *, charr(i)
+  test = 1
+end function test
+
diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_function_6.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_function_6.f90
new file mode 100644
index 000000000..49d1a2e55
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_charlen_function_6.f90
@@ -0,0 +1,37 @@
+! { dg-do compile }
+
+! PR fortran/41615
+! Output nicer error message for invalid assumed-len character function result
+! depending on what kind of contained procedure it is.
+
+module funcs
+   implicit none
+contains
+      function assumed_len(x) ! { dg-error "module procedure" }
+         character(*) assumed_len
+         integer, intent(in) :: x
+      end function assumed_len
+end module funcs
+
+module mod2
+  implicit none
+contains
+  subroutine mysub ()
+    contains
+      function assumed_len(x) ! { dg-error "internal function" }
+         character(*) assumed_len
+         integer, intent(in) :: x
+      end function assumed_len
+  end subroutine
+end module mod2
+
+program main
+  implicit none
+contains
+      function assumed_len(x) ! { dg-error "internal function" }
+         character(*) assumed_len
+         integer, intent(in) :: x
+      end function assumed_len
+end program main
+
+! { dg-final { cleanup-modules "funcs mod2" } }
diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_in_main.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_in_main.f90
new file mode 100644
index 000000000..f4bb70154
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_charlen_in_main.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! Tests the fix for PR28771 in which an assumed character length variable with an initializer could
+! survive in the main program without causing an error.
+!
+! Contributed by Martin Reinecke  <martin@mpa-garching.mpg.de>
+! Modified to test fix of regression reported by P.Schaffnit@access.rwth-aachen.de
+
+subroutine poobar ()
+  ! The regression caused an ICE here
+  CHARACTER ( LEN = * ), PARAMETER ::   Markers(5) = (/ "Error ", &
+      &                                                 "Fehler", &
+      &                                                 "Erreur", &
+      &                                                 "Stop  ", &
+      &                                                 "Arret "  /)
+  character(6) :: recepteur (5)
+  recepteur = Markers
+end subroutine poobar
+
+! If the regression persisted, the compilation would stop before getting here
+program test
+  character(len=*), parameter :: foo = 'test'     ! Parameters must work.
+  character(len=4) :: bar = foo
+  character(len=*) :: foobar = 'This should fail' ! {  dg-error "must be a dummy" }
+  print *, bar
+  call poobar ()
+end
+
diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_needed_1.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_needed_1.f90
new file mode 100644
index 000000000..759e3e780
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_charlen_needed_1.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! Tests the fix for PR24557 in which the return of a
+! temporary character(*) array would cause an ICE.
+!
+! Test case provided by Erik Edelmann  <eedelmann@gcc.gnu.org>
+!
+  character(4) :: a(2)
+  print *, fun (a)
+contains
+  function fun (arg)
+    character (*) :: arg (10)
+    integer :: fun(size(arg))
+    fun = 1
+  end function fun
+end
diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_sharing.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_sharing.f90
new file mode 100644
index 000000000..0c1c38a87
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_charlen_sharing.f90
@@ -0,0 +1,29 @@
+! This testcase was miscompiled, because ts.cl
+! in function bar was initially shared between both
+! dummy arguments.  Although it was later unshared,
+! all expressions which copied ts.cl from bar2
+! before that used incorrectly bar1's length
+! instead of bar2.
+! { dg-do run }
+
+subroutine foo (foo1, foo2)
+  implicit none
+  integer, intent(in) :: foo2
+  character(*), intent(in) :: foo1(foo2)
+end subroutine foo
+
+subroutine bar (bar1, bar2)
+  implicit none
+  character(*), intent(in) :: bar1, bar2
+
+  call foo ((/ bar2 /), 1)
+end subroutine bar
+
+program test
+  character(80) :: str1
+  character(5) :: str2
+
+  str1 = 'String'
+  str2 = 'Strng'
+  call bar (str2, str1)
+end program test
diff --git a/gcc/testsuite/gfortran.dg/assumed_dummy_1.f90 b/gcc/testsuite/gfortran.dg/assumed_dummy_1.f90
new file mode 100644
index 000000000..f8d7fea31
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_dummy_1.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+! Tests the fix for PRs 19358, 19477, 21211 and 21622.
+!
+! Note that this tests only the valid cases with explicit interfaces.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module global
+contains
+  SUBROUTINE goo (x, i)
+    REAL, DIMENSION(i:)     :: x
+    integer                 :: i
+    x (3) = 99.0
+  END SUBROUTINE goo
+end module global
+
+SUBROUTINE foo (x, i)
+  REAL, DIMENSION(i:)       :: x
+  integer                   :: i
+  x (4) = 42.0
+END SUBROUTINE foo
+
+program test
+  use global
+  real, dimension(3)        :: y = 0
+  integer                   :: j = 2
+
+interface
+  SUBROUTINE foo (x, i)
+    REAL, DIMENSION(i:)     :: x
+    integer                 :: i
+  END SUBROUTINE foo
+end interface
+  call foo (y, j)
+  call goo (y, j)
+  call roo (y, j)
+  if (any(y.ne.(/21.0, 99.0, 42.0/))) call abort ()
+contains
+  SUBROUTINE roo (x, i)
+    REAL, DIMENSION(i:)     :: x
+    integer                 :: i
+    x (2) = 21.0
+  END SUBROUTINE roo
+end program test
+
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/assumed_dummy_2.f90 b/gcc/testsuite/gfortran.dg/assumed_dummy_2.f90
new file mode 100644
index 000000000..092941db9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_dummy_2.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+
+  double precision :: arr(5, 8)
+  call bar (arr)
+contains
+  subroutine foo (arr)
+    double precision :: arr(:,:)
+    arr(3, 4) = 24
+  end subroutine foo
+  subroutine bar (arr)
+    double precision :: arr(5,*)
+    call foo (arr)   ! { dg-error "cannot be an assumed-size array" }
+    call foo (arr (:, :8))
+  end subroutine
+end
diff --git a/gcc/testsuite/gfortran.dg/assumed_len.f90 b/gcc/testsuite/gfortran.dg/assumed_len.f90
new file mode 100644
index 000000000..5895e2145
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_len.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! Test of the patch for PR29941, in which LEN threw an error with
+! an assumed size argument.
+! 
+! Contributed by William Mitchell <william.mitchell@nist.gov>
+!
+subroutine whatever(str)
+character(len=*), dimension(*) :: str
+integer :: i
+i = len(str)
+end subroutine whatever
diff --git a/gcc/testsuite/gfortran.dg/assumed_present.f90 b/gcc/testsuite/gfortran.dg/assumed_present.f90
new file mode 100644
index 000000000..dd9f85ca8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_present.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! This tests the fix for the regression PR25785, where line 7 started
+! generating an assumed size error.
+! Contributed by Dale Ranta  <dir@lanl.gov>
+      subroutine my_sio_file_write_common(data_c1)
+        character,   intent(in), optional :: data_c1(*)
+        if (present(data_c1)) then
+        endif
+      end subroutine my_sio_file_write_common
diff --git a/gcc/testsuite/gfortran.dg/assumed_shape_ranks_1.f90 b/gcc/testsuite/gfortran.dg/assumed_shape_ranks_1.f90
new file mode 100644
index 000000000..e24414ad3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_shape_ranks_1.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! Tests fix for PR25070; was no error for actual and assumed shape
+! dummy ranks not matching.
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+
+module addon
+  interface extra
+    function foo (y)
+      integer :: foo (2), y (:)
+    end function foo
+  end interface extra
+end module addon
+
+  use addon
+  INTEGER :: I(2,2)
+  I=RESHAPE((/1,2,3,4/),(/2,2/))
+  CALL TST(I)   ! { dg-error "Rank mismatch in argument" }
+  i = foo (i)   ! { dg-error "Rank mismatch|Incompatible ranks" }
+CONTAINS
+  SUBROUTINE TST(I)
+    INTEGER :: I(:)
+    write(6,*) I
+  END SUBROUTINE TST
+END
+
+! { dg-final { cleanup-modules "addon" } }
diff --git a/gcc/testsuite/gfortran.dg/assumed_shape_ranks_2.f90 b/gcc/testsuite/gfortran.dg/assumed_shape_ranks_2.f90
new file mode 100644
index 000000000..da59213d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_shape_ranks_2.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! Tests the fix for the regression PR26716.
+! Test contributed by Martin Reinecke  <martin@mpa-garching.mpg.de>
+!
+module mod1
+  implicit none
+
+  interface foo
+     module procedure foo1, foo2
+  end interface
+
+contains
+
+  subroutine foo1(bar, i)
+    real bar
+    integer i
+    i = 1
+   end subroutine
+
+  subroutine foo2(bar, i)
+    real bar(3)
+    integer i
+    i = 2
+  end subroutine
+
+end module mod1
+
+  use mod1
+  implicit none
+
+  real bar(3)
+  integer i
+
+  i = 0
+  call foo (1e0, i)
+  if (i .ne. 1) call abort ()
+
+  i = 0
+  call foo (bar(1), i)
+  if (i .ne. 1) call abort ()
+
+  i = 0
+  call foo (bar, i)
+  if (i .ne. 2) call abort ()
+end
+
+! { dg-final { cleanup-modules "mod1" } }
diff --git a/gcc/testsuite/gfortran.dg/assumed_size_dt_dummy.f90 b/gcc/testsuite/gfortran.dg/assumed_size_dt_dummy.f90
new file mode 100644
index 000000000..1f45f24ed
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_size_dt_dummy.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! PR20853 - No array size information for initializer.
+! PR24440 - patch for PR20853 caused a segfault at line 12.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+MODULE TEST
+  TYPE init
+    INTEGER :: I=0
+  END TYPE init
+CONTAINS
+  SUBROUTINE try (A, B) ! { dg-error "cannot have a default initializer" }
+    TYPE(init), DIMENSION(*), INTENT(OUT) :: A
+    TYPE(init)              , INTENT(OUT) :: B ! PR24440 => segfault
+  END SUBROUTINE try
+END MODULE TEST
+
+end
+
+! { dg-final { cleanup-modules "TEST" } }
diff --git a/gcc/testsuite/gfortran.dg/assumed_size_refs_1.f90 b/gcc/testsuite/gfortran.dg/assumed_size_refs_1.f90
new file mode 100644
index 000000000..1adfd3d5c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_size_refs_1.f90
@@ -0,0 +1,64 @@
+!==================assumed_size_refs_1.f90==================
+! { dg-do compile }
+! Test the fix for PR25029, PR21256 in which references to
+! assumed size arrays without an upper bound to the last
+! dimension were generating no error. The first version of
+! the patch failed in DHSEQR, as pointed out by Toon Moene
+! in http://gcc.gnu.org/ml/fortran/2005-12/msg00466.html
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+program assumed_size_test_1
+  implicit none
+  real a(2, 4)
+
+  a = 1.0
+  call foo (a)
+
+contains
+  subroutine foo(m)
+    real, target :: m(1:2, *)
+    real x(2,2,2)
+    real, external :: bar
+    real, pointer :: p(:,:), q(:,:)
+    allocate (q(2,2))
+
+! PR25029
+    p => m                     ! { dg-error "upper bound in the last dimension" }
+    q = m                      ! { dg-error "upper bound in the last dimension" }
+
+! PR21256( and PR25060)
+    m = 1                      ! { dg-error "upper bound in the last dimension" }
+
+    m(1,1) = 2.0
+    x = bar (m)
+    x = fcn (m)                ! { dg-error "upper bound in the last dimension" }
+    m(:, 1:2) = fcn (q)
+    call sub (m, x)            ! { dg-error "upper bound in the last dimension" }
+    call sub (m(1:2, 1:2), x)  ! { dg-error "Incompatible ranks in elemental procedure" }
+    print *, p
+
+    call DHSEQR(x)
+
+  end subroutine foo
+
+  elemental function fcn (a) result (b)
+    real, intent(in) :: a
+    real :: b
+    b = 2.0 * a
+  end function fcn
+
+  elemental subroutine sub (a, b)
+    real, intent(inout) :: a, b
+    b = 2.0 * a
+  end subroutine sub
+  
+  SUBROUTINE DHSEQR( WORK )
+    REAL WORK( * )
+    EXTERNAL           DLARFX
+    INTRINSIC          MIN
+    WORK( 1 ) = 1.0
+    CALL DLARFX( MIN( 1, 8 ), WORK )
+  END SUBROUTINE DHSEQR
+
+end program assumed_size_test_1
diff --git a/gcc/testsuite/gfortran.dg/assumed_size_refs_2.f90 b/gcc/testsuite/gfortran.dg/assumed_size_refs_2.f90
new file mode 100644
index 000000000..8eb708d49
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_size_refs_2.f90
@@ -0,0 +1,44 @@
+!==================assumed_size_refs_1.f90==================
+! { dg-do compile }
+! Test the fix for PR20868 & PR20870 in which references to
+! assumed size arrays without an upper bound to the last
+! dimension were generating no error.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+program assumed_size_test_2
+  implicit none
+  real a(2, 4)
+
+  a = 1.0
+  call foo (a)
+
+contains
+  subroutine foo(m)
+    real, target :: m(1:2, *)
+    real x(2,2,2)
+    real, pointer :: q(:,:)
+    integer :: i
+    allocate (q(2,2))
+
+    q = cos (1.0 + abs(m))     ! { dg-error "upper bound in the last dimension" }
+
+    x = reshape (m, (/2,2,2/)) ! { dg-error "upper bound in the last dimension" }
+
+! PR20868
+    print *, ubound (m)        ! { dg-error "upper bound in the last dimension" }
+    print *, lbound (m)
+
+! PR20870
+    print *, size (m)          ! { dg-error "upper bound in the last dimension" }
+
+! Check non-array valued intrinsics
+    print *, ubound (m, 1)
+    print *, ubound (m, 2)     ! { dg-error "not a valid dimension index" }
+    
+    i = 2
+    print *, size (m, i)
+
+  end subroutine foo
+
+end program assumed_size_test_2
diff --git a/gcc/testsuite/gfortran.dg/assumed_size_refs_3.f90 b/gcc/testsuite/gfortran.dg/assumed_size_refs_3.f90
new file mode 100644
index 000000000..b8aa44b78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_size_refs_3.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! Tests the fix for PR25951, a regression caused by the assumed
+! size patch.
+! Test case provided by Mark Hesselink  <mhesseli@caltech.edu>
+PROGRAM loc_1
+  integer i(10)
+  call f (i)
+CONTAINS
+   SUBROUTINE f (x)
+      INTEGER, DIMENSION(*)   :: x
+      INTEGER                 :: address
+! The next line would cause:
+! Error: The upper bound in the last dimension must appear in the
+! reference to the assumed size array 'x' at (1)
+      address=LOC(x)
+   END SUBROUTINE f
+END PROGRAM loc_1
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/assumed_size_refs_4.f90 b/gcc/testsuite/gfortran.dg/assumed_size_refs_4.f90
new file mode 100644
index 000000000..830ff0849
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_size_refs_4.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+! PR fortran/34759
+! gfortran was before rejecting passing an assumed-size array
+! where the last dimension was specified.
+!
+! Test case provided by Dick Hendickson.
+!
+       subroutine j_assumed_size(A,N)
+       dimension A(10,11,12,*), k(3), l(3), m(4)
+       m = shape(A(:,:,:,:N)) ! OK
+       l = shape(A(:,:,:,3))  ! OK
+       m = shape(A(:,:,:,:))  ! { dg-error "upper bound of assumed size array" }
+       m = shape(A) ! { dg-error "must not be an assumed size array" }
+       end
diff --git a/gcc/testsuite/gfortran.dg/asynchronous_1.f90 b/gcc/testsuite/gfortran.dg/asynchronous_1.f90
new file mode 100644
index 000000000..bc8821453
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asynchronous_1.f90
@@ -0,0 +1,42 @@
+! { dg-do compile }
+!
+! PR/fortran 25829
+!
+! Check parsing and checking of ASYNCHRONOUS
+!
+type(t) function func0()
+  asynchronous :: a
+  integer, asynchronous:: b
+  allocatable :: c
+  volatile :: d
+  type t
+    sequence
+    integer :: i = 5
+  end type t
+end function func0
+
+integer function func()
+  asynchronous :: func
+  integer, asynchronous:: b
+  allocatable :: c
+  volatile :: func
+  type t
+    sequence
+    integer :: i = 5
+  end type t
+end function func
+
+function func2() result(res)
+  volatile res
+  asynchronous res
+end function func2
+
+subroutine sub()
+  asynchronous sub ! { dg-error "SUBROUTINE attribute conflicts with ASYNCHRONOUS" }
+  volatile sub     ! { dg-error "SUBROUTINE attribute conflicts with VOLATILE" }
+end subroutine sub
+
+program main
+  asynchronous main ! { dg-error "PROGRAM attribute conflicts with ASYNCHRONOUS" }
+  volatile main     ! { dg-error "PROGRAM attribute conflicts with VOLATILE" }
+end program main
diff --git a/gcc/testsuite/gfortran.dg/asynchronous_2.f90 b/gcc/testsuite/gfortran.dg/asynchronous_2.f90
new file mode 100644
index 000000000..939c9e2f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asynchronous_2.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR/fortran 25829
+!
+! Check parsing ASYNCHRONOUS
+!
+function func2() result(res)
+  asynchronous res ! { dg-error "Fortran 2003: ASYNCHRONOUS" }
+end function func2
diff --git a/gcc/testsuite/gfortran.dg/asynchronous_3.f03 b/gcc/testsuite/gfortran.dg/asynchronous_3.f03
new file mode 100644
index 000000000..dfc5e6ea9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asynchronous_3.f03
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+! PR fortran/44457 - no array-subscript actual argument
+!                    for an asynchronous dummy
+!
+
+  integer :: a(10), sect(3)
+  sect = [1,2,3]
+  call f(a(sect))    ! { dg-error "incompatible" }
+  call f(a(::2))
+contains
+  subroutine f(x)
+    integer, asynchronous :: x(:)
+  end subroutine f
+end
diff --git a/gcc/testsuite/gfortran.dg/atan2_1.f90 b/gcc/testsuite/gfortran.dg/atan2_1.f90
new file mode 100644
index 000000000..65da63cd2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/atan2_1.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+! { dg-options "-ffloat-store" }
+!
+! PR fortran/33197
+!
+! Check for Fortran 2008's ATAN(Y,X) - which is equivalent
+! to Fortran 77's ATAN2(Y,X).
+!
+integer :: i
+real, parameter :: pi4 = 2*acos(0.0)
+real, parameter :: pi8 = 2*acos(0.0d0)
+do i = 1, 10
+  if(atan(1.0,  i/10.0)  -atan2(1.0,  i/10.)    /= 0.0)   call abort()
+  if(atan(1.0d0,i/10.0d0)-atan2(1.0d0,i/10.0d0) /= 0.0d0) call abort()
+end do
+
+! Atan(1,1) = Pi/4
+if (abs(atan(1.0,1.0)    -pi4/4.0)   > epsilon(pi4)) call abort()
+if (abs(atan(1.0d0,1.0d0)-pi8/4.0d0) > epsilon(pi8)) call abort()
+
+! Atan(-1,1) = -Pi/4
+if (abs(atan(-1.0,1.0)    +pi4/4.0)   > epsilon(pi4)) call abort()
+if (abs(atan(-1.0d0,1.0d0)+pi8/4.0d0) > epsilon(pi8)) call abort()
+
+! Atan(1,-1) = 3/4*Pi
+if (abs(atan(1.0,-1.0)    -3.0*pi4/4.0)     > epsilon(pi4)) call abort()
+if (abs(atan(1.0d0,-1.0d0)-3.0d0*pi8/4.0d0) > epsilon(pi8)) call abort()
+
+! Atan(-1,-1) = -3/4*Pi
+if (abs(atan(-1.0,-1.0)    +3.0*pi4/4.0)     > epsilon(pi4)) call abort()
+if (abs(atan(-1.0d0,-1.0d0)+3.0d0*pi8/4.0d0) > epsilon(pi8)) call abort()
+
+! Atan(3,-5) = 2.60117315331920908301906501867... = Pi - 3/2 atan(3/5)
+if (abs(atan(3.0,-5.0)    -2.60117315331920908301906501867) > epsilon(pi4)) call abort()
+if (abs(atan(3.0d0,-5.0d0)-2.60117315331920908301906501867d0) > epsilon(pi8)) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/atan2_2.f90 b/gcc/testsuite/gfortran.dg/atan2_2.f90
new file mode 100644
index 000000000..407e83a70
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/atan2_2.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/33197
+!
+! Check for Fortran 2008's ATAN(Y,X) - which is equivalent
+! to Fortran 77's ATAN2(Y,X).
+!
+real(4)    :: r4
+real(8)    :: r8
+complex(4) :: c4
+complex(8) :: c8
+
+r4 = atan2(r4,r4)
+r8 = atan2(r8,r8)
+
+r4 = atan(r4,r4) ! { dg-error "Too many arguments in call to 'atan'" }
+r8 = atan(r8,r8) ! { dg-error "Too many arguments in call to 'atan'" }
+
+r4 = atan2(r4,r8) ! { dg-error "same type and kind" }
+r4 = atan2(r8,r4) ! { dg-error "same type and kind" }
+
+r4 = atan2(c4,r8) ! { dg-error "must be REAL" }
+r4 = atan2(c8,r4) ! { dg-error "must be REAL" }
+r4 = atan2(r4,c8) ! { dg-error "same type and kind" }
+r4 = atan2(r8,c4) ! { dg-error "same type and kind" }
+
+r4 = atan2(c4,c8) ! { dg-error "must be REAL" }
+r4 = atan2(c8,c4) ! { dg-error "must be REAL" }
+end
diff --git a/gcc/testsuite/gfortran.dg/auto_array_1.f90 b/gcc/testsuite/gfortran.dg/auto_array_1.f90
new file mode 100644
index 000000000..64cc113f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_array_1.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! PR fortran/17077.
+! Automatic arrays are allocated on the heap.  When used as an actual argument
+! we were passing the address of the pointer, not the pointer itself.
+
+program p
+   implicit none
+   integer:: n,m
+
+   n = 3
+   call foo(n)
+contains
+
+   subroutine foo(m)
+      integer:: m,i
+      integer:: z(m,m)
+    
+      z = 0
+
+      call foo1(m,z)
+    
+      ! Check it worked.
+      if (any (z .ne. reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)))) &
+        call abort
+    end subroutine foo
+
+    subroutine foo1(n,x)
+       integer:: n,i,j
+       integer:: x(n,n)
+    
+       ! Assign values to x.
+       do i=1,n
+          do j=1,n
+             x(j,i)=j+(i-1)*n
+          enddo
+       enddo
+    end subroutine foo1
+end program    
diff --git a/gcc/testsuite/gfortran.dg/auto_char_dummy_array_1.f90 b/gcc/testsuite/gfortran.dg/auto_char_dummy_array_1.f90
new file mode 100644
index 000000000..6ed6f4576
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_char_dummy_array_1.f90
@@ -0,0 +1,57 @@
+! { dg-do run }
+! This tests the fix for pr15809 in which automatic character length,
+! dummy, pointer arrays were broken.
+!
+! contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module global
+  character(12), dimension(2), target :: t
+end module global
+
+program oh_no_not_pr15908_again
+  character(12), dimension(:), pointer :: ptr
+
+  call a (ptr, 12)
+  if (.not.associated (ptr) ) call abort ()
+  if (any (ptr.ne."abc")) call abort ()
+
+  ptr => null ()              ! ptr points to 't' here.
+  allocate (ptr(3))
+  ptr = "xyz"
+  call a (ptr, 12)
+
+  if (.not.associated (ptr)) call abort ()
+  if (any (ptr.ne."lmn")) call abort ()
+
+  call a (ptr, 0)
+
+  if (associated (ptr)) call abort ()
+
+contains
+
+  subroutine a (p, l)
+    use global
+    character(l), dimension(:), pointer :: p
+    character(l), dimension(3)          :: s
+
+    s = "lmn"
+
+    if (l.ne.12) then
+      deallocate (p)           ! ptr was allocated in main.
+      p => null ()
+      return
+    end if
+
+    if (.not.associated (p)) then
+      t = "abc"
+      p => t
+    else
+      if (size (p,1).ne.3) call abort ()
+      if (any (p.ne."xyz")) call abort ()
+      p = s
+    end if
+  end subroutine a
+
+end program oh_no_not_pr15908_again
+
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/auto_char_dummy_array_2.f90 b/gcc/testsuite/gfortran.dg/auto_char_dummy_array_2.f90
new file mode 100644
index 000000000..666418301
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_char_dummy_array_2.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! Test fix for pr24789 - would segfault on the assignment
+! because the array descriptor size was not set.
+!
+! This is the example submitted by Martin Reineke  <martin@mpa-garching.mpg.de>
+
+subroutine foo(vals)
+  character(len = *), pointer :: vals(:)
+  vals = ''
+end subroutine
+
diff --git a/gcc/testsuite/gfortran.dg/auto_char_dummy_array_3.f90 b/gcc/testsuite/gfortran.dg/auto_char_dummy_array_3.f90
new file mode 100644
index 000000000..053956cab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_char_dummy_array_3.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+
+! PR fortran/49885
+! Check that character arrays with non-constant char-length are handled
+! correctly.
+
+! Contributed by Daniel Kraft <d@domob.eu>,
+! based on original test case and variant by Tobias Burnus in comment 2.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  CALL s (10)
+      
+CONTAINS
+
+  SUBROUTINE s (nb)
+    INTEGER :: nb
+    CHARACTER(MAX (80, nb)) :: bad_rec(1)
+
+    bad_rec(1)(1:2) = 'abc'
+    IF (bad_rec(1)(1:2) /= 'ab') CALL abort ()
+  END SUBROUTINE s
+
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/auto_char_len_1.f90 b/gcc/testsuite/gfortran.dg/auto_char_len_1.f90
new file mode 100644
index 000000000..628e6e914
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_char_len_1.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "" }
+! [option to disable -pedantic as assumed character length
+!  functions are obsolescent]
+!
+! PR fortran/41235
+!
+
+character(len=*) function func()
+  func = 'ABC'
+end function func
+
+subroutine test(i)
+  integer :: i
+  character(len=i), external :: func
+  print *, func()
+end subroutine test
+
+subroutine test2(i)
+  integer :: i
+  character(len=i) :: func
+  print *, func()
+end subroutine test2
+
+call test(2)
+call test2(2)
+end
diff --git a/gcc/testsuite/gfortran.dg/auto_char_len_2.f90 b/gcc/testsuite/gfortran.dg/auto_char_len_2.f90
new file mode 100644
index 000000000..95825c420
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_char_len_2.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file" }
+!
+! PR fortran/41235
+!
+
+character(len=*) function func()
+  func = 'ABC'
+end function func
+
+subroutine test(i)
+  integer :: i
+  character(len=i), external :: func
+  print *, func()
+end subroutine test
+
+subroutine test2(i)
+  integer :: i
+  character(len=i) :: func
+  print *, func()
+end subroutine test2
+
+call test(2)
+call test2(2)
+end
diff --git a/gcc/testsuite/gfortran.dg/auto_char_len_3.f90 b/gcc/testsuite/gfortran.dg/auto_char_len_3.f90
new file mode 100644
index 000000000..da8cf5e4e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_char_len_3.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! Test the fix for PR26257, in which the implicit reference to
+! chararray in the main program call of chararray2string would
+! cause a segfault in gfc_build_addr_expr.
+!
+! Based on the reduced testcase in the PR.
+module chtest
+contains
+  function chararray2string(chararray) result(text)
+    character(len=1), dimension(:) :: chararray    ! input
+    character(len=size(chararray, 1)) :: text      ! output
+    do i = 1,size(chararray,1)
+      text(i:i) = chararray (i)
+    end do
+  end function chararray2string
+end module chtest
+program TestStringTools
+  use chtest
+  character(len=52)               :: txt
+  character(len=1), dimension(52) :: chararr = &
+        (/(char(i+64),char(i+96), i = 1,26)/)
+  txt = chararray2string(chararr)
+  if (txt .ne. "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz") &
+        call abort ()
+end program TestStringTools
+
+! { dg-final { cleanup-modules "chtest" } }
diff --git a/gcc/testsuite/gfortran.dg/auto_char_len_4.f90 b/gcc/testsuite/gfortran.dg/auto_char_len_4.f90
new file mode 100644
index 000000000..6b4e26e6b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_char_len_4.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file" }
+!
+! Tests the fix for PR25087, in which the following invalid code
+! was not detected.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+! Modified by Tobias Burnus to fix PR fortran/41235.
+!
+FUNCTION a()
+  CHARACTER(len=10) :: a
+  a = ''
+END FUNCTION a
+
+SUBROUTINE s(n)
+  CHARACTER(LEN=n), EXTERNAL :: a ! { dg-error "must have an explicit interface" }
+  CHARACTER(LEN=n), EXTERNAL :: d ! { dg-error "must have an explicit interface" }
+  interface
+    function b (m)                ! This is OK
+      CHARACTER(LEN=m) :: b
+      integer :: m
+    end function b
+  end interface
+  write(6,*) a()
+  write(6,*) b(n)
+  write(6,*) c()
+  write(6,*) d()
+contains
+    function c ()                ! This is OK
+      CHARACTER(LEN=n):: c
+      c = ""
+    end function c
+END SUBROUTINE s
+
+FUNCTION d()
+  CHARACTER(len=99) :: d
+  d = ''
+END FUNCTION d
diff --git a/gcc/testsuite/gfortran.dg/auto_char_pointer_array_result_1.f90 b/gcc/testsuite/gfortran.dg/auto_char_pointer_array_result_1.f90
new file mode 100644
index 000000000..8e3eb94c2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_char_pointer_array_result_1.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! Tests the fixes for PR25597 and PR27096.
+!
+! This test combines the PR testcases.
+!
+  character(10), dimension (2) :: implicit_result
+  character(10), dimension (2) :: explicit_result
+  character(10), dimension (2) :: source
+  source = "abcdefghij"
+  explicit_result = join_1(source)
+  if (any (explicit_result .ne. source)) call abort () 
+
+  implicit_result = reallocate_hnv (source, size(source, 1), LEN (source))
+  if (any (implicit_result .ne. source)) call abort () 
+
+contains
+
+! This function would cause an ICE in gfc_trans_deferred_array.
+  function join_1(self) result(res)
+    character(len=*), dimension(:) :: self
+    character(len=len(self)), dimension(:), pointer :: res
+    allocate (res(2))
+    res = self
+  end function
+
+! This function originally ICEd and latterly caused a runtime error.
+  FUNCTION reallocate_hnv(p, n, LEN)
+    CHARACTER(LEN=LEN), DIMENSION(:), POINTER :: reallocate_hnv
+    character(*), dimension(:) :: p
+    ALLOCATE (reallocate_hnv(n))
+    reallocate_hnv = p
+  END FUNCTION reallocate_hnv
+
+end
+
+ 
diff --git a/gcc/testsuite/gfortran.dg/auto_dealloc_1.f90 b/gcc/testsuite/gfortran.dg/auto_dealloc_1.f90
new file mode 100644
index 000000000..95a71609d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_dealloc_1.f90
@@ -0,0 +1,59 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR 41586: Allocatable _scalars_ are never auto-deallocated
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+module automatic_deallocation
+
+  type t0
+    integer :: i
+  end type
+
+  type t1
+    real :: pi = 3.14
+    integer, allocatable :: j
+  end type
+
+  type t2
+    class(t0), allocatable :: k
+  end type t2
+
+contains
+
+  ! (1) simple allocatable scalars
+  subroutine a
+    integer, allocatable :: m
+    allocate (m)
+    m = 42
+  end subroutine
+
+  ! (2) allocatable scalar CLASS variables
+  subroutine b
+    class(t0), allocatable :: m
+    allocate (t0 :: m)
+    m%i = 43
+  end subroutine
+
+  ! (3) allocatable scalar components
+  subroutine c
+    type(t1) :: m
+    allocate (m%j)
+    m%j = 44
+  end subroutine
+
+  ! (4) allocatable scalar CLASS components
+  subroutine d
+    type(t2) :: m
+    allocate (t0 :: m%k)
+    m%k%i = 45
+  end subroutine
+
+end module 
+
+
+! { dg-final { scan-tree-dump-times "__builtin_free" 4 "original" } }
+
+! { dg-final { cleanup-modules "automatic_deallocation" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90 b/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90
new file mode 100644
index 000000000..4cbda8288
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_dealloc_2.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR 47637: [OOP] Memory leak involving INTENT(OUT) CLASS argument w/ allocatable components
+!
+! Contributed by Rich Townsend <townsend@astro.wisc.edu>
+
+program test
+
+type :: t
+  integer, allocatable :: i(:)
+end type
+
+type(t) :: a
+
+call init(a)
+call init(a)
+
+contains
+
+  subroutine init(x)
+    class(t), intent(out) :: x
+    allocate(x%i(1000))
+  end subroutine
+
+end program 
+
+! { dg-final { scan-tree-dump-times "__builtin_free" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/auto_internal_assumed.f90 b/gcc/testsuite/gfortran.dg/auto_internal_assumed.f90
new file mode 100644
index 000000000..ec0ea7f15
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_internal_assumed.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! Test fix of PR24705 - ICE on assumed character length
+! internal function.
+!
+character (6) :: c
+  c = f1 ()
+  if (c .ne. 'abcdef') call abort
+contains
+  function f1 () ! { dg-error "must not be assumed length" }
+    character (*) :: f1
+    f1 = 'abcdef'
+  end function f1
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/auto_pointer_array_result_1.f90 b/gcc/testsuite/gfortran.dg/auto_pointer_array_result_1.f90
new file mode 100644
index 000000000..7e7cde5fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_pointer_array_result_1.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! Tests the fixes for PR25597 and PR27096.
+!
+! This test combines the PR testcases.
+!
+  character(10), dimension (2) :: implicit_result
+  character(10), dimension (2) :: explicit_result
+  character(10), dimension (2) :: source
+  source = "abcdefghij"
+  explicit_result = join_1(source)
+  if (any (explicit_result .ne. source)) call abort () 
+
+  implicit_result = reallocate_hnv (source, size(source, 1), LEN (source))
+  if (any (implicit_result .ne. source)) call abort () 
+
+contains
+
+! This function would cause an ICE in gfc_trans_deferred_array.
+  function join_1(self) result(res)
+    character(len=*), dimension(:) :: self
+    character(len=len(self)), dimension(:), pointer :: res
+    allocate (res(2))
+    res = self
+  end function
+
+! This function originally ICEd and latterly caused a runtime error.
+  FUNCTION reallocate_hnv(p, n, LEN)
+    CHARACTER(LEN=LEN), DIMENSION(:), POINTER :: reallocate_hnv
+    character(*), dimension(:) :: p
+    ALLOCATE (reallocate_hnv(n))
+    reallocate_hnv = p
+  END FUNCTION reallocate_hnv
+
+end
+
+
diff --git a/gcc/testsuite/gfortran.dg/auto_save_1.f90 b/gcc/testsuite/gfortran.dg/auto_save_1.f90
new file mode 100644
index 000000000..b4571d2ba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/auto_save_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! Check that automatic objects work properly in the presence of a save
+! statement.
+! PR21034
+subroutine test(n)
+  implicit none
+  integer n
+  real dte(n)
+  character(len=n) :: s
+  save
+  dte = 0
+  s = ""
+end
+
+program prog
+  call test(4)
+  call test(10)
+end program
diff --git a/gcc/testsuite/gfortran.dg/automatic_char_len_1.f90 b/gcc/testsuite/gfortran.dg/automatic_char_len_1.f90
new file mode 100644
index 000000000..3ccfcb70d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/automatic_char_len_1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! PR18082 - Compiler would get stuck in loop, whilst treating
+! the assignments.
+! Test is one of PR cases.
+subroutine snafu (i)
+character*(i) :: c1, c2
+c1 = ""
+c2 = ""
+end subroutine snafu
+
+
diff --git a/gcc/testsuite/gfortran.dg/automatic_char_len_2.f90 b/gcc/testsuite/gfortran.dg/automatic_char_len_2.f90
new file mode 100644
index 000000000..18bb8d12d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/automatic_char_len_2.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-O0" }
+!
+! Tests fix for PR21459 - This is the original example.
+!
+program format_string
+  implicit none
+  character(len=*), parameter :: rform='(F15.5)', &
+  cform="(' (', F15.5, ',' F15.5, ') ')"
+  call print_a_number(cform)
+contains
+subroutine print_a_number(style)
+  character(len=*) :: style
+  write(*, style) cmplx(42.0, 99.0) ! { dg-output "99.00000" }
+end subroutine print_a_number
+end program format_string
diff --git a/gcc/testsuite/gfortran.dg/automatic_default_init_1.f90 b/gcc/testsuite/gfortran.dg/automatic_default_init_1.f90
new file mode 100644
index 000000000..525632b36
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/automatic_default_init_1.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-O" }
+! Test the fix for PR29394 in which automatic arrays did not
+! get default initialization.
+! Contributed by Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org> 
+!
+MODULE M1
+  TYPE T1 
+    INTEGER :: I=7 
+  END TYPE T1 
+CONTAINS 
+  SUBROUTINE S1(I) 
+    INTEGER, INTENT(IN) :: I 
+    TYPE(T1) :: D(1:I)
+    IF (any (D(:)%I.NE.7)) CALL ABORT() 
+  END SUBROUTINE S1 
+END MODULE M1
+  USE M1 
+  CALL S1(2) 
+END 
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/automatic_module_variable.f90 b/gcc/testsuite/gfortran.dg/automatic_module_variable.f90
new file mode 100644
index 000000000..c88b355b2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/automatic_module_variable.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! Tests fix for PR15976
+!
+module sd
+  integer, parameter :: n = 20
+  integer :: i(n)
+  integer :: j(m) ! { dg-error "must have constant shape" }
+  integer, pointer :: p(:)
+  integer, allocatable :: q(:)
+contains
+  function init (x, l)
+    integer :: x(l)
+    integer :: init(l)
+    init = x
+  end function init
+end module sd
+
+! { dg-final { cleanup-modules "sd" } }
diff --git a/gcc/testsuite/gfortran.dg/backslash_1.f90 b/gcc/testsuite/gfortran.dg/backslash_1.f90
new file mode 100644
index 000000000..b9851342b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/backslash_1.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+      character(len=4) a
+      open (10, status='scratch')
+      write (10,'(A)') '1\n2'
+      rewind (10)
+      read (10,'(A)') a
+      if (a /= '1\n2') call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/backslash_2.f90 b/gcc/testsuite/gfortran.dg/backslash_2.f90
new file mode 100644
index 000000000..2f954d539
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/backslash_2.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+      integer :: i, e
+      open (10, status='scratch')
+      write (10,'(A)') '1\n2'
+      rewind (10)
+      read (10,*,iostat=e) i
+      if (e /= 0 .or. i /= 1) call abort
+      read (10,*,iostat=e) i
+      if (e /= 0 .or. i /= 2) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/backslash_3.f b/gcc/testsuite/gfortran.dg/backslash_3.f
new file mode 100644
index 000000000..8625b3724
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/backslash_3.f
@@ -0,0 +1,26 @@
+C { dg-do run { target fd_truncate } }
+C { dg-options "-fbackslash" }
+C PR fortran/30278
+      program a
+      character(len=1), parameter  :: c1 = char(8), c2 = char(92)
+      character(len=35) str1, str2
+      character(len=37) :: str4, str3
+
+      open(10, status='scratch')
+      write(10, 100)
+      rewind(10)
+      read(10,'(A34)') str1
+      str2 = 'Does ' // c1 // 'ackslash result in ' // c1 // 'ackslash'
+      if (str1 .ne. str2) call abort
+
+      rewind(10)
+      write (10, 200)
+      rewind(10)
+      read(10,'(A37)') str3
+      str4 = 'Does ' //c2// 'backslash result in ' //c2// 'backslash'
+      if (str3 .ne. str4) call abort
+
+      stop
+ 100  format ('Does \backslash result in \backslash')
+ 200  format ('Does \\backslash result in \\backslash')
+      end
diff --git a/gcc/testsuite/gfortran.dg/backspace_1.f b/gcc/testsuite/gfortran.dg/backspace_1.f
new file mode 100644
index 000000000..4cfc9c132
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/backspace_1.f
@@ -0,0 +1,82 @@
+! This file is all about BACKSPACE
+! { dg-do run { target fd_truncate } }
+
+      integer i, n, nr
+      real x(10), y(10)
+
+! PR libfortran/20068
+      open (20, status='scratch')
+      write (20,*) 1
+      write (20,*) 2
+      write (20,*) 3
+      rewind (20)
+      read (20,*) i
+      if (i .ne. 1) call abort
+      write (*,*) ' '
+      backspace (20)
+      read (20,*) i
+      if (i .ne. 1) call abort
+      close (20)
+
+! PR libfortran/20125
+      open (20, status='scratch')
+      write (20,*) 7
+      backspace (20)
+      read (20,*) i
+      if (i .ne. 7) call abort
+      close (20)
+
+      open (20, status='scratch', form='unformatted')
+      write (20) 8
+      backspace (20)
+      read (20) i
+      if (i .ne. 8) call abort
+      close (20)
+
+! PR libfortran/20471
+      do n = 1, 10
+        x(n) = sqrt(real(n))
+      end do
+      open (3, form='unformatted', status='scratch')
+      write (3) (x(n),n=1,10)
+      backspace (3)
+      rewind (3)
+      read (3) (y(n),n=1,10)
+
+      do n = 1, 10
+        if (abs(x(n)-y(n)) > 0.00001) call abort
+      end do
+      close (3)
+
+! PR libfortran/20156
+      open (3, form='unformatted', status='scratch')
+      do i = 1, 5
+        x(1) = i
+        write (3) n, (x(n),n=1,10)
+      end do
+      nr = 0
+      rewind (3)
+  20  continue
+      read (3,end=30,err=90) n, (x(n),n=1,10)
+      nr = nr + 1
+      goto 20
+  30  continue
+      if (nr .ne. 5) call abort
+
+      do i = 1, nr+1
+        backspace (3)
+      end do
+
+      do i = 1, nr
+        read(3,end=70,err=90) n, (x(n),n=1,10)
+        if (abs(x(1) - i) .gt. 0.001) call abort
+      end do
+      close (3)
+      stop
+
+  70  continue
+      call abort
+  90  continue
+      call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/backspace_10.f90 b/gcc/testsuite/gfortran.dg/backspace_10.f90
new file mode 100644
index 000000000..574d464c4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/backspace_10.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+! PR33307 I/O read/positioning problem - in BACKSPACE
+! Test case devloped from test in PR by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program gfcbug69b
+  ! Modified example program
+  implicit none
+  integer, parameter :: iunit = 63
+  integer            :: istat, k, ios
+  character(len=20) :: line, message
+
+  open (iunit)
+  write (iunit, '(a)') "! ***Remove this line***"
+  write (iunit, '(a)') "&FOO        file='foo' /"
+  write (iunit, '(a)', advance="no") "&BAR        file='bar' /"
+  close (iunit)
+! Note: Failure occurred only when ACTION="read" was specified
+  open (iunit, action="read", status="old")
+  
+  read (iunit,'(a)',iostat=ios) line
+  if (ios /= 0) call abort
+  read (iunit,'(a)',iostat=ios) line
+  if (ios /= 0) call abort
+  read (iunit,'(a)',iostat=ios) line
+  if (ios /= 0) call abort
+  read (iunit,'(a)',iostat=ios) line
+  if (ios /= 0) backspace (iunit)
+  rewind (iunit)
+  read (iunit,'(a)',iostat=ios) line
+  if (ios /= 0) call abort
+  read (iunit,'(a)',iostat=ios) line
+  if (ios /= 0) call abort
+  read (iunit,'(a)',iostat=ios) line
+  if (ios /= 0) call abort
+  read (iunit,'(a)',iostat=ios) line
+  if (ios /= -1) call abort
+  close (iunit, status="delete")
+end program gfcbug69b
diff --git a/gcc/testsuite/gfortran.dg/backspace_11.f90 b/gcc/testsuite/gfortran.dg/backspace_11.f90
new file mode 100644
index 000000000..e369b75f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/backspace_11.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! PR 40334 backspace regression
+program backspace_11
+ implicit none
+ character(len=5) :: str
+ open(10, access='sequential', status='scratch')
+ write(10,'(A)')'HELLO'
+ rewind(10)
+
+ do
+    read(10,'(A)',end=1) str
+ enddo
+1 backspace 10
+ !the file pointer is now at EOF
+
+ read(10,*,end=2) str
+ call abort
+2 backspace 10
+ !the file pointer is now at EOF
+
+ read(10,'(A)',end=3) str
+ call abort
+3 continue
+end program backspace_11
diff --git a/gcc/testsuite/gfortran.dg/backspace_2.f b/gcc/testsuite/gfortran.dg/backspace_2.f
new file mode 100644
index 000000000..3b633355b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/backspace_2.f
@@ -0,0 +1,22 @@
+! { dg-do run { target fd_truncate } }
+! PR25139 Repeated backspaces and reads.
+! Derived from example given in PR by Dale Ranta and FX Coudert
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org> 
+      integer dat(5)
+      dat = (/ 0, 0, 0, 0, 1 /)
+      write(11) dat,dat,dat,dat
+      rewind 11
+      write(11) dat
+      read(11,end=1008) dat
+      call abort()
+ 1008 continue
+      backspace 11
+      write(11) dat
+      read(11,end=1011) dat
+      call abort()
+ 1011 continue
+      backspace 11
+      backspace 11
+      close(11, status='delete')
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/backspace_3.f b/gcc/testsuite/gfortran.dg/backspace_3.f
new file mode 100644
index 000000000..419063b94
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/backspace_3.f
@@ -0,0 +1,20 @@
+! { dg-do run }
+! PR25598 Error on repeated backspaces.
+! Derived from example given in PR by Dale Ranta
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org> 
+       integer data
+       data=-1
+       open(unit=11,status='scratch',form='unformatted')
+       write(11)data
+       read(11,end=        1000 )data
+       call abort()
+ 1000  continue
+       backspace 11
+       backspace 11
+       backspace 11
+       read(11,end=        1001 )data
+ 1001  continue
+       if (data.ne.-1) call abort
+       close(11)
+       end
+
diff --git a/gcc/testsuite/gfortran.dg/backspace_4.f b/gcc/testsuite/gfortran.dg/backspace_4.f
new file mode 100644
index 000000000..69e0f40c7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/backspace_4.f
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR25598 Error on repeated backspaces.
+! Derived from example given in PR by Dale Ranta
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org> 
+       integer data
+       data=-1
+       open(unit=11,status='scratch',form='unformatted')
+       write(11)data
+       read(11,end=        1000 )data
+       call abort()
+ 1000  continue
+       backspace 11
+       backspace 11
+       read(11,end=        1001 )data
+ 1001  continue
+       if (data.ne.-1) call abort
+       close(11)
+       end
diff --git a/gcc/testsuite/gfortran.dg/backspace_5.f b/gcc/testsuite/gfortran.dg/backspace_5.f
new file mode 100644
index 000000000..4cd657a78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/backspace_5.f
@@ -0,0 +1,35 @@
+!{ dg-do run }
+! PR26464 File I/O error related to buffering and BACKSPACE
+! Test case derived from case by Dale Ranta.
+! Submitted  by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+      program test
+      integer,parameter :: datasize = 1000
+      dimension idata(datasize)
+      idata = -42
+      open (11, status="scratch", form="unformatted")
+        idata(1)   =  -1
+        idata(  datasize)   =  -2
+       write(11)idata
+        idata(1)   =  -2
+        idata(  datasize)   =  -3
+       write(11)idata
+        idata(1)   =  -3
+        idata(  datasize)   =  -4
+       write(11)idata
+        idata(1)   =  -4
+        idata(  datasize)   =  -5
+       write(11)idata
+       read(11,end=        1000 )idata
+       call abort()
+ 1000  continue
+       backspace 11
+       backspace 11
+       backspace 11
+       read(11,end=        1001 )idata
+       if(idata(1).ne.-3 .or. idata(datasize).ne.-4) call abort()
+       stop
+ 1001  continue
+       call abort()
+ 1010  stop
+       end
+
diff --git a/gcc/testsuite/gfortran.dg/backspace_6.f b/gcc/testsuite/gfortran.dg/backspace_6.f
new file mode 100644
index 000000000..90affdc77
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/backspace_6.f
@@ -0,0 +1,34 @@
+!{ dg-do run { target fd_truncate } }
+! PR26464 File I/O error related to buffering and BACKSPACE
+! Test case derived from case by Dale Ranta.
+! Submitted  by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+      program test
+      integer,parameter :: datasize = 5000
+      dimension idata(datasize)
+      idata = -42
+      open (11, status="scratch", form="unformatted")
+        idata(1)   =  -1
+        idata(datasize)   =  -2
+       write(11)idata
+        idata(1)   =  -2
+        idata(datasize)   =  -3
+       write(11)idata
+        idata(1)   =  -3
+        idata(datasize)   =  -4
+       write(11)idata
+       backspace 11
+       backspace 11
+        idata(1)   =  -2
+        idata(datasize)   =  -3
+       write(11)idata
+       read(11,end=        1003 )idata
+       call abort()
+ 1003  continue
+       backspace 11
+       backspace 11
+       read(11,end=        1004 )idata
+       if(idata(1).ne.-2 .or.idata(datasize).ne.-3) call abort()
+       stop
+ 1004  continue
+       end
+       
diff --git a/gcc/testsuite/gfortran.dg/backspace_7.f90 b/gcc/testsuite/gfortran.dg/backspace_7.f90
new file mode 100644
index 000000000..09cce731a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/backspace_7.f90
@@ -0,0 +1,11 @@
+! { dg-do run { target fd_truncate } }
+!pr18284 BACKSPACE broken
+       open(unit=10,access='SEQUENTIAL',status='SCRATCH')
+       do I = 1,200
+         write(10,*)I
+       end do
+       backspace(10)
+       backspace(10)
+       read(10,*)I
+       if (I.NE.199) call abort
+       end
diff --git a/gcc/testsuite/gfortran.dg/backspace_8.f b/gcc/testsuite/gfortran.dg/backspace_8.f
new file mode 100644
index 000000000..2dd6b72e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/backspace_8.f
@@ -0,0 +1,20 @@
+C { dg-do run }
+C { dg-options "-std=legacy" }
+C
+C PR libfortran/31618 - backspace after an error didn't work.
+      program main
+      character*78 msg
+      open (21, file="backspace_7.dat", form="unformatted")
+      write (21) 42, 43
+      write (21) 4711, 4712
+      write (21) -1, -4
+      rewind (21)
+      read (21) i,j
+      read (21,err=100,end=100) i,j,k
+      call abort
+ 100  continue
+      backspace 21
+      read (21) i,j
+      if (i .ne. 4711 .or. j .ne. 4712) call abort
+      close (21,status="delete")
+      end
diff --git a/gcc/testsuite/gfortran.dg/backspace_9.f b/gcc/testsuite/gfortran.dg/backspace_9.f
new file mode 100644
index 000000000..851f518a2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/backspace_9.f
@@ -0,0 +1,57 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR32235 incorrectly position text file after backspace
+! Test case from PR, prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+      program main
+      character*10 a
+      ncards=2
+      input=10
+      write(10,"(a)") "One"
+      write(10,"(a)") "Two"
+      write(10,"(a)") "Three"
+      rewind(10)
+      read(input,1000)a
+      read(input,1000)a
+
+      call inlist(ncards)
+
+      read(input,1000)a
+      if (a.ne."Three") call abort
+      close(10,status="delete")
+      stop
+ 1000 format(a10)
+ 2000 format('read =',a10)
+      end
+
+      subroutine inlist(ncards)
+      character*4 data(20)
+      input=10
+c
+      if (ncards.eq.0) go to 20
+      do 15 i=1,ncards
+      backspace input
+   15 continue
+c
+   20 continue
+      kard  = 0
+   30 read(input,1000,end=60)   data
+   40 kard=kard + 1
+   50 continue
+      if ((kard .eq. 1) .and. (DATA(1) .ne. "One")) call abort
+      if ((kard .eq. 2) .and. (DATA(1) .ne. "Two")) call abort
+      if ((kard .eq. 3) .and. (DATA(1) .ne. "Thre")) call abort
+
+      go to 30
+   60 continue
+      kard=kard - ncards + 1
+      do 70   i=1,kard
+      backspace input
+   70 continue
+c
+      return
+c
+ 1000 format (20a4)
+ 2020 format (8x,i15,8x,20a4)
+c
+      end
diff --git a/gcc/testsuite/gfortran.dg/bad_automatic_objects_1.f90 b/gcc/testsuite/gfortran.dg/bad_automatic_objects_1.f90
new file mode 100644
index 000000000..c4c1f2cb0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bad_automatic_objects_1.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! Tests the fix for 25103, in which the presence of automatic objects
+! in the main program and the specification part of a module was not
+! detected.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+module foo
+  integer    ::  i
+end module foo
+module bar
+  use foo
+  integer, dimension (i) :: j ! { dg-error "must have constant shape" }
+  character (len = i) :: c1   ! { dg-error "must have constant character length" }
+end module bar
+program foobar
+  use foo
+  integer, dimension (i) :: k ! { dg-error "must have constant shape" }
+  character (len = i) :: c2   ! { dg-error "must have constant character length" }
+end program foobar
+
+! { dg-final { cleanup-modules "foo bar" } }
diff --git a/gcc/testsuite/gfortran.dg/badline.f b/gcc/testsuite/gfortran.dg/badline.f
new file mode 100644
index 000000000..59f22e7c3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/badline.f
@@ -0,0 +1,4 @@
+        subroutine foo 
+# 18 "src/badline.F" 2
+        end
+! { dg-warning "left but not entered" "" { target *-*-* } 2 }
diff --git a/gcc/testsuite/gfortran.dg/bessel_1.f90 b/gcc/testsuite/gfortran.dg/bessel_1.f90
new file mode 100644
index 000000000..fb1e19bee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bessel_1.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+
+program test
+  implicit none
+
+  interface check
+    procedure check_r4
+    procedure check_r8
+  end interface check
+
+  real(kind=4) :: x4
+  real(kind=8) :: x8
+
+  x8 = 1.9_8 ; x4 = 1.9_4
+  call check(bessel_j0 (x8), bessel_j0 (1.9_8))
+  call check(bessel_j0 (x4), bessel_j0 (1.9_4))
+  call check(bessel_j1 (x8), bessel_j1 (1.9_8))
+  call check(bessel_j1 (x4), bessel_j1 (1.9_4))
+  call check(bessel_jn (3,x8), bessel_jn (3,1.9_8))
+  call check(bessel_jn (3,x4), bessel_jn (3,1.9_4))
+  call check(bessel_y0 (x8), bessel_y0 (1.9_8))
+  call check(bessel_y0 (x4), bessel_y0 (1.9_4))
+  call check(bessel_y1 (x8), bessel_y1 (1.9_8))
+  call check(bessel_y1 (x4), bessel_y1 (1.9_4))
+  call check(bessel_yn (3,x8), bessel_yn (3,1.9_8))
+  call check(bessel_yn (3,x4), bessel_yn (3,1.9_4))
+
+contains
+  subroutine check_r4 (a, b) ! { dg-warning "Extension: Internal procedure" }
+    real(kind=4), intent(in) :: a, b
+    if (abs(a - b) > 1.e-5 * abs(b)) call abort
+  end subroutine
+  subroutine check_r8 (a, b) ! { dg-warning "Extension: Internal procedure" }
+    real(kind=8), intent(in) :: a, b
+    if (abs(a - b) > 1.e-7 * abs(b)) call abort
+  end subroutine
+end program test
diff --git a/gcc/testsuite/gfortran.dg/bessel_2.f90 b/gcc/testsuite/gfortran.dg/bessel_2.f90
new file mode 100644
index 000000000..3b4c2e2e4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bessel_2.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! PR fortran/36117
+!
+! This program will fail for MPFR < 2.3.0
+!
+! Based on a test by James Van Buskirk.
+!
+program bug3
+   implicit none
+   real, parameter :: Qarg1 = 1.7
+   integer, parameter :: k2 = kind(BESJ0(Qarg1))
+   integer, parameter :: is_int = 1-1/(2+0*BESJ0(Qarg1))*2
+   integer, parameter :: kind_if_real = &
+      (1-is_int)*k2+is_int*kind(1.0)
+   complex :: z = cmplx(0,1,kind_if_real) ! FAILS
+   if (kind_if_real /= kind(Qarg1)) call abort ()
+end program bug3
diff --git a/gcc/testsuite/gfortran.dg/bessel_3.f90 b/gcc/testsuite/gfortran.dg/bessel_3.f90
new file mode 100644
index 000000000..271768dd8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bessel_3.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-std=f2003 -Wimplicit-procedure" }
+!
+! PR fortran/36158 - Transformational BESSEL_JN/YN
+! PR fortran/33197 - F2008 math functions
+!
+IMPLICIT NONE
+print *, SIN (1.0)
+print *, BESSEL_J0(1.0) ! { dg-error "has no IMPLICIT type" })
+print *, BESSEL_J1(1.0) ! { dg-error "has no IMPLICIT type" }
+print *, BESSEL_JN(1,1.0) ! { dg-error "has no IMPLICIT type" }
+print *, BESSEL_JN(1,2,1.0) ! { dg-error "has no IMPLICIT type" }
+
+print *, BESSEL_Y0(1.0) ! { dg-error "has no IMPLICIT type" }
+print *, BESSEL_Y1(1.0) ! { dg-error "has no IMPLICIT type" }
+print *, BESSEL_YN(1,1.0) ! { dg-error "has no IMPLICIT type" }
+print *, BESSEL_YN(1,2,1.0) ! { dg-error "has no IMPLICIT type" }
+end
diff --git a/gcc/testsuite/gfortran.dg/bessel_4.f90 b/gcc/testsuite/gfortran.dg/bessel_4.f90
new file mode 100644
index 000000000..7da1bf9aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bessel_4.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
+! PR fortran/36158 - Transformational BESSEL_JN/YN
+! PR fortran/33197 - F2008 math functions
+!
+implicit none
+! OK, elemental function:
+ print *, bessel_yn(1, [1.0, 2.0])
+ print *, bessel_yn([1, 2], 2.0)
+
+! Wrong, transformational function:
+! Does not pass check.c -- thus regarded as wrong generic function
+! and thus rejected with a slightly misleading error message
+ print *, bessel_yn(1, 2, [2.0, 3.0]) ! { dg-error "Too many arguments" }
+
+! Wrong in F2008: Negative argument, ok as GNU extension
+ print *, bessel_yn(-1, 3.0) ! { dg-error "Extension: Negative argument N " }
+
+! Wrong in F2008: Negative argument -- and no need for a GNU extension
+! Does not pass check.c -- thus regarded as wrong generic function
+! and thus rejected with a slightly misleading error message
+ print *, bessel_yn(-1, 2, 3.0) ! { dg-error "Too many arguments" }
+end
diff --git a/gcc/testsuite/gfortran.dg/bessel_5.f90 b/gcc/testsuite/gfortran.dg/bessel_5.f90
new file mode 100644
index 000000000..aab45cafe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bessel_5.f90
@@ -0,0 +1,86 @@
+! { dg-do run }
+! { dg-options "-Wall -fno-range-check" }
+!
+! PR fortran/36158 - Transformational BESSEL_JN/YN
+! PR fortran/33197 - F2008 math functions
+!
+! This is a dg-do run test as the middle end cannot simplify the
+! the scalarization of the elemental function (cf. PR 45305).
+!
+! -Wall has been specified to disabled -pedantic, which warns about the
+! negative order (GNU extension) to the order of the Bessel functions of
+! first and second kind.
+!
+
+implicit none
+integer :: i
+
+
+! Difference to mpfr_jn <= 1 epsilon
+
+if (any (abs (BESSEL_JN(2, 5, 2.457) - [(BESSEL_JN(i, 2.457), i = 2, 5)]) &
+          > epsilon(0.0))) then
+  print *, 'FAIL 1'
+  call abort()
+end if
+
+
+! Difference to mpfr_yn <= 4 epsilon
+
+if (any (abs (BESSEL_YN(2, 5, 2.457) - [(BESSEL_YN(i, 2.457), i = 2, 5)]) &
+         > epsilon(0.0)*4)) then
+  call abort()
+end if
+
+
+! Difference to mpfr_jn <= 1 epsilon
+
+if (any (abs (BESSEL_JN(0, 10, 4.457) &
+              - [ (BESSEL_JN(i, 4.457), i = 0, 10) ]) &
+         > epsilon(0.0))) then
+  call abort()
+end if
+
+
+! Difference to mpfr_yn <= 192 epsilon
+
+if (any (abs (BESSEL_YN(0, 10, 4.457) &
+              - [ (BESSEL_YN(i, 4.457), i = 0, 10) ]) &
+         > epsilon(0.0)*192)) then
+  call abort()
+end if
+
+
+! Difference to mpfr_jn: None.  (Special case: X = 0.0)
+
+if (any (BESSEL_JN(0, 10, 0.0) /= [ (BESSEL_JN(i, 0.0), i = 0, 10) ])) &
+then
+  call abort()
+end if
+
+
+! Difference to mpfr_yn: None.  (Special case: X = 0.0)
+
+if (any (BESSEL_YN(0, 10, 0.0) /= [ (BESSEL_YN(i, 0.0), i = 0, 10) ])) &
+then
+  call abort()
+end if
+
+
+! Difference to mpfr_jn <= 1 epsilon
+
+if (any (abs (BESSEL_JN(0, 10, 1.0) &
+              - [ (BESSEL_JN(i, 1.0), i = 0, 10) ]) &
+         > epsilon(0.0)*1)) then
+ call abort()
+end if
+
+! Difference to mpfr_yn <= 32 epsilon
+
+if (any (abs (BESSEL_YN(0, 10, 1.0) &
+              - [ (BESSEL_YN(i, 1.0), i = 0, 10) ]) &
+         > epsilon(0.0)*32)) then
+  call abort()
+end if
+
+end
diff --git a/gcc/testsuite/gfortran.dg/bessel_6.f90 b/gcc/testsuite/gfortran.dg/bessel_6.f90
new file mode 100644
index 000000000..1671d1118
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bessel_6.f90
@@ -0,0 +1,49 @@
+! { dg-do run { xfail spu-*-* } }
+! { dg-add-options ieee }
+!
+! PR fortran/36158
+! PR fortran/33197
+!
+! XFAILed for SPU targets since we don't have an accurate library
+! implementation of the single-precision Bessel functions.
+!
+! Run-time tests for transformations BESSEL_JN
+!
+implicit none
+real,parameter :: values(*) = [0.0, 0.5, 1.0, 0.9, 1.8,2.0,3.0,4.0,4.25,8.0,34.53, 475.78] 
+real,parameter :: myeps(size(values)) = epsilon(0.0) &
+                  * [2, 7, 5, 6, 9, 12, 12, 7, 7, 8, 92, 15 ]
+! The following is sufficient for me - the values above are a bit
+! more tolerant
+!                  * [0, 5, 3, 4, 6, 7, 7, 5, 5, 6, 66, 4 ]
+integer,parameter :: mymax(size(values)) =  &
+                 [100, 17, 23, 21, 27, 28, 32, 35, 36, 41, 47, 37 ]
+integer, parameter :: Nmax = 100
+real :: rec(0:Nmax), lib(0:Nmax)
+integer :: i
+
+do i = 1, ubound(values,dim=1)
+  call compare(mymax(i), values(i), myeps(i))
+end do
+
+contains
+
+subroutine compare(mymax, X, myeps)
+
+integer :: i, nit, mymax
+real X, myeps, myeps2
+
+rec(0:mymax) = BESSEL_JN(0, mymax, X)
+lib(0:mymax) = [ (BESSEL_JN(i, X), i=0,mymax) ]
+
+!print *, 'YN for X = ', X, ' -- Epsilon = ',epsilon(x)
+do i = 0, mymax
+!  print '(i2,2e17.9,e12.2,f18.10,2l3)', i, rec(i), lib(i), &
+!        rec(i)-lib(i),           ((rec(i)-lib(i))/rec(i))/epsilon(x), &
+!        rec(i) == lib(i) .or. abs((rec(i)-lib(i))/rec(i)) < myeps
+if (.not. (rec(i) == lib(i) .or. abs((rec(i)-lib(i))/rec(i)) < myeps)) &
+  call abort()
+end do
+
+end
+end
diff --git a/gcc/testsuite/gfortran.dg/bessel_7.f90 b/gcc/testsuite/gfortran.dg/bessel_7.f90
new file mode 100644
index 000000000..78f1ff251
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bessel_7.f90
@@ -0,0 +1,58 @@
+! { dg-do run { xfail *-*-mingw* spu-*-* } }
+! { dg-add-options ieee }
+!
+! PR fortran/36158
+! PR fortran/33197
+!
+! For mingw targets this test is disabled as the MS implementation
+! of BESSEL_YN(n,x) has different results.  It returns NAN rather than
+! -INF for "x=0.0" and all "n".
+!
+! XFAILed for SPU targets since we don't have an accurate library
+! implementation of the single-precision Bessel functions.
+!
+! Run-time tests for transformations BESSEL_YN
+!
+implicit none
+real,parameter :: values(*) = [0.0, 0.5, 1.0, 0.9, 1.8,2.0,3.0,4.0,4.25,8.0,34.53, 475.78] 
+real,parameter :: myeps(size(values)) = epsilon(0.0) &
+                  * [2, 3, 4, 5, 8, 2, 12, 6, 7, 6, 31, 168 ]
+! The following is sufficient for me - the values above are a bit
+! more tolerant
+!                  * [0, 0, 0, 3, 3, 0, 9, 0, 2, 1, 22, 130 ]
+integer,parameter :: nit(size(values)) =  &
+                 [100, 100, 100, 25, 15, 100, 10, 31, 7, 100, 7, 25 ]
+integer, parameter :: Nmax = 100
+real :: rec(0:Nmax), lib(0:Nmax)
+integer :: i
+
+do i = 1, ubound(values,dim=1)
+  call compare(values(i), myeps(i), nit(i), 6*epsilon(0.0))
+end do
+
+contains
+
+subroutine compare(X, myeps, nit, myeps2)
+
+integer :: i, nit
+real X, myeps, myeps2
+
+rec = BESSEL_YN(0, Nmax, X)
+lib = [ (BESSEL_YN(i, X), i=0,Nmax) ]
+
+!print *, 'YN for X = ', X, ' -- Epsilon = ',epsilon(x)
+do i = 0, Nmax
+!  print '(i2,2e17.9,e12.2,f14.10,2l3)', i, rec(i), lib(i), &
+!        rec(i)-lib(i), ((rec(i)-lib(i))/rec(i))/epsilon(x), &
+!        i > nit .or. rec(i) == lib(i) &
+!                .or. abs((rec(i)-lib(i))/rec(i)) < myeps2, &
+!        rec(i) == lib(i) .or. abs((rec(i)-lib(i))/rec(i)) < myeps
+if (.not. (i > nit .or. rec(i) == lib(i) &
+                   .or. abs((rec(i)-lib(i))/rec(i)) < myeps2)) &
+  call abort ()
+if (.not. (rec(i) == lib(i) .or. abs((rec(i)-lib(i))/rec(i)) < myeps)) &
+  call abort ()
+end do
+
+end
+end
diff --git a/gcc/testsuite/gfortran.dg/besxy.f90 b/gcc/testsuite/gfortran.dg/besxy.f90
new file mode 100644
index 000000000..5cd5c8a96
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/besxy.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+!
+! Check whether BESXY functions take scalars and
+! arrays as arguments (PR31760).
+!
+PROGRAM test_erf
+  REAL :: r = 0.0, ra(2) = (/ 0.0, 1.0 /)
+
+  r  = BESJ0(r)
+  r  = BESJ1(r)
+  r  = BESJN(0, r)
+
+  r  = BESY0(r)
+  r  = BESY1(r)
+  r  = BESYN(0, r)
+
+  ra = BESJ0(ra)
+  ra = BESJ1(ra)
+  ra = BESJN(0, ra)
+
+  ra = BESY0(ra)
+  ra = BESY1(ra)
+  ra = BESYN(0, ra)
+
+  r  = BESSEL_J0(r)
+  r  = BESSEL_J1(r)
+  r  = BESSEL_JN(0, r)
+
+  r  = BESSEL_Y0(r)
+  r  = BESSEL_Y1(r)
+  r  = BESSEL_YN(0, r)
+
+  ra = BESSEL_J0(ra)
+  ra = BESSEL_J1(ra)
+  ra = BESSEL_JN(0, ra)
+
+  ra = BESSEL_Y0(ra)
+  ra = BESSEL_Y1(ra)
+  ra = BESSEL_YN(0, ra)
+
+END PROGRAM
diff --git a/gcc/testsuite/gfortran.dg/bind_c_18.f90 b/gcc/testsuite/gfortran.dg/bind_c_18.f90
new file mode 100644
index 000000000..6360f01aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_18.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! PR fortran/37201
+!
+! Before character arrays were allowed as bind(C) return value.
+!
+implicit none
+  INTERFACE 
+    FUNCTION my() BIND(C,name="my") RESULT(r) ! { dg-error "cannot be an array" }
+      USE iso_c_binding
+      CHARACTER(kind=C_CHAR) :: r(10)
+    END FUNCTION
+  END INTERFACE
+  INTERFACE 
+    FUNCTION two() BIND(C,name="two") RESULT(r) ! { dg-error "cannot be a character string" }
+      USE iso_c_binding
+      CHARACTER(kind=C_CHAR,len=2) :: r
+    END FUNCTION
+  END INTERFACE
+END
diff --git a/gcc/testsuite/gfortran.dg/bind_c_array_params.f03 b/gcc/testsuite/gfortran.dg/bind_c_array_params.f03
new file mode 100644
index 000000000..6590db1d1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_array_params.f03
@@ -0,0 +1,14 @@
+! { dg-do compile }
+module bind_c_array_params
+use, intrinsic :: iso_c_binding
+implicit none
+
+contains
+  subroutine sub0(assumed_array) bind(c) ! { dg-error "cannot be an argument" }
+    integer(c_int), dimension(:) :: assumed_array
+  end subroutine sub0
+
+  subroutine sub1(deferred_array) bind(c) ! { dg-error "cannot" } 
+    integer(c_int), pointer :: deferred_array(:)
+  end subroutine sub1
+end module bind_c_array_params
diff --git a/gcc/testsuite/gfortran.dg/bind_c_coms.f90 b/gcc/testsuite/gfortran.dg/bind_c_coms.f90
new file mode 100644
index 000000000..e88d56d18
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_coms.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+! { dg-additional-sources bind_c_coms_driver.c }
+! { dg-options "-w" }
+! the -w option is to prevent the warning about long long ints
+module bind_c_coms
+  use, intrinsic :: iso_c_binding
+  implicit none
+
+  common /COM/ R, S
+  real(c_double) :: r
+  real(c_double) :: t 
+  real(c_double) :: s 
+  bind(c) :: /COM/, /SINGLE/, /MYCOM/
+  common /SINGLE/ T
+  common /MYCOM/ LONG_INTS
+  integer(c_long) :: LONG_INTS
+  common /MYCOM2/ LONG_LONG_INTS
+  integer(c_long_long) :: long_long_ints
+  bind(c) :: /mycom2/
+
+  common /com2/ i, j
+  integer(c_int) :: i, j
+  bind(c, name="f03_com2") /com2/
+
+  common /com3/ m, n
+  integer(c_int) :: m, n
+  bind(c, name="") /com3/
+
+contains
+  subroutine test_coms() bind(c)
+    r = r + .1d0;
+    s = s + .1d0;
+    t = t + .1d0;
+    long_ints = long_ints + 1
+    long_long_ints = long_long_ints + 1
+    i = i + 1
+    j = j + 1
+
+    m = 1
+    n = 1
+  end subroutine test_coms
+end module bind_c_coms
+
+module bind_c_coms_2
+  use, intrinsic :: iso_c_binding, only: c_int
+  common /com3/ m, n
+  integer(c_int) :: m, n
+  bind(c, name="") /com3/
+end module bind_c_coms_2
+
+! { dg-final { cleanup-modules "bind_c_coms bind_c_coms_2" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_coms_driver.c b/gcc/testsuite/gfortran.dg/bind_c_coms_driver.c
new file mode 100644
index 000000000..c83f22d83
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_coms_driver.c
@@ -0,0 +1,42 @@
+double fabs(double);
+
+void test_coms(void);
+
+extern void abort(void);
+
+struct {double r, s; } com;     /* refers to the common block "com" */
+double single;                  /* refers to the common block "single" */
+long int mycom;                 /* refers to the common block "MYCOM" */
+long long int mycom2;           /* refers to the common block "MYCOM2" */
+struct {int i, j; } f03_com2;   /* refers to the common block "com2" */
+
+int main(int argc, char **argv)
+{
+  com.r = 1.0;
+  com.s = 2.0;
+  single = 1.0;
+  mycom = 1;
+  mycom2 = 2;
+  f03_com2.i = 1;
+  f03_com2.j = 2;
+
+  /* change the common block variables in F90 */
+  test_coms();
+
+  if(fabs(com.r - 1.1) > 0.00000000)
+    abort();
+  if(fabs(com.s - 2.1) > 0.00000000)
+    abort();
+  if(fabs(single - 1.1) > 0.00000000)
+    abort();
+  if(mycom != 2)
+    abort();
+  if(mycom2 != 3)
+    abort();
+  if(f03_com2.i != 2)
+    abort();
+  if(f03_com2.j != 3)
+    abort();
+  
+  return 0;
+}/* end main() */
diff --git a/gcc/testsuite/gfortran.dg/bind_c_dts.f90 b/gcc/testsuite/gfortran.dg/bind_c_dts.f90
new file mode 100644
index 000000000..f0a31e540
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_dts.f90
@@ -0,0 +1,43 @@
+! { dg-do run }
+! { dg-additional-sources bind_c_dts_driver.c }
+module bind_c_dts
+  use, intrinsic :: iso_c_binding
+  implicit none
+
+  type, bind(c) :: MYFTYPE_1
+     integer(c_int) :: i, j
+     real(c_float) :: s
+  end type MYFTYPE_1
+
+  TYPE, BIND(C) :: particle
+     REAL(C_DOUBLE) :: x,vx
+     REAL(C_DOUBLE) :: y,vy
+     REAL(C_DOUBLE) :: z,vz
+     REAL(C_DOUBLE) :: m
+  END TYPE particle
+
+  type(myftype_1), bind(c, name="myDerived") :: myDerived
+
+contains
+  subroutine types_test(my_particles, num_particles) bind(c)
+    integer(c_int), value :: num_particles
+    type(particle), dimension(num_particles) :: my_particles
+    integer :: i
+
+    ! going to set the particle in the middle of the list
+    i = num_particles / 2;
+    my_particles(i)%x = my_particles(i)%x + .2d0
+    my_particles(i)%vx = my_particles(i)%vx + .2d0
+    my_particles(i)%y = my_particles(i)%y + .2d0
+    my_particles(i)%vy = my_particles(i)%vy + .2d0
+    my_particles(i)%z = my_particles(i)%z + .2d0
+    my_particles(i)%vz = my_particles(i)%vz + .2d0
+    my_particles(i)%m = my_particles(i)%m + .2d0
+
+    myDerived%i = myDerived%i + 1
+    myDerived%j = myDerived%j + 1
+    myDerived%s = myDerived%s + 1.0;
+  end subroutine types_test
+end module bind_c_dts
+
+! { dg-final { cleanup-modules "bind_c_dts" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_dts_2.f03 b/gcc/testsuite/gfortran.dg/bind_c_dts_2.f03
new file mode 100644
index 000000000..4b423e53d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_dts_2.f03
@@ -0,0 +1,63 @@
+! { dg-do run }
+! { dg-additional-sources bind_c_dts_2_driver.c }
+module bind_c_dts_2
+use, intrinsic :: iso_c_binding
+implicit none
+
+type, bind(c) :: my_c_type_0
+   integer(c_int) :: i
+   type(c_ptr) :: nested_c_address
+   integer(c_int) :: array(3)
+end type my_c_type_0
+
+type, bind(c) :: my_c_type_1
+   type(my_c_type_0) :: my_nested_type
+   type(c_ptr) :: c_address
+   integer(c_int) :: j
+end type my_c_type_1
+
+contains
+  subroutine sub0(my_type, expected_i, expected_nested_c_address, &
+       expected_array_1, expected_array_2, expected_array_3, &
+       expected_c_address, expected_j) bind(c)
+    type(my_c_type_1) :: my_type
+    integer(c_int), value :: expected_i
+    type(c_ptr), value :: expected_nested_c_address
+    integer(c_int), value :: expected_array_1
+    integer(c_int), value :: expected_array_2
+    integer(c_int), value :: expected_array_3
+    type(c_ptr), value :: expected_c_address
+    integer(c_int), value :: expected_j
+
+    if (my_type%my_nested_type%i .ne. expected_i) then
+       call abort ()
+    end if
+
+    if (.not. c_associated(my_type%my_nested_type%nested_c_address, &
+         expected_nested_c_address)) then
+       call abort ()
+    end if
+
+    if (my_type%my_nested_type%array(1) .ne. expected_array_1) then
+       call abort ()
+    end if
+
+    if (my_type%my_nested_type%array(2) .ne. expected_array_2) then
+       call abort ()
+    end if
+
+    if (my_type%my_nested_type%array(3) .ne. expected_array_3) then
+       call abort ()
+    end if
+
+    if (.not. c_associated(my_type%c_address, expected_c_address)) then
+       call abort ()
+    end if
+
+    if (my_type%j .ne. expected_j) then
+       call abort ()
+    end if
+  end subroutine sub0
+end module bind_c_dts_2
+
+! { dg-final { cleanup-modules "bind_c_dts_2" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_dts_2_driver.c b/gcc/testsuite/gfortran.dg/bind_c_dts_2_driver.c
new file mode 100644
index 000000000..53d26794e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_dts_2_driver.c
@@ -0,0 +1,37 @@
+typedef struct c_type_0
+{
+  int i;
+  int *ptr;
+  int array[3];
+}c_type_0_t;
+
+typedef struct c_type_1
+{
+  c_type_0_t nested_type;
+  int *ptr;
+  int j;
+}c_type_1_t;
+
+void sub0(c_type_1_t *c_type, int expected_i, int *expected_nested_ptr,
+          int array_0, int array_1, int array_2, 
+          int *expected_ptr, int expected_j);
+
+int main(int argc, char **argv)
+{
+  c_type_1_t c_type;
+
+  c_type.nested_type.i = 10;
+  c_type.nested_type.ptr = &(c_type.nested_type.i);
+  c_type.nested_type.array[0] = 1;
+  c_type.nested_type.array[1] = 2;
+  c_type.nested_type.array[2] = 3;
+  c_type.ptr = &(c_type.j);
+  c_type.j = 11;
+  
+  sub0(&c_type, c_type.nested_type.i, c_type.nested_type.ptr, 
+       c_type.nested_type.array[0],
+       c_type.nested_type.array[1], c_type.nested_type.array[2], 
+       c_type.ptr, c_type.j);
+  
+  return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/bind_c_dts_3.f03 b/gcc/testsuite/gfortran.dg/bind_c_dts_3.f03
new file mode 100644
index 000000000..fa54fb761
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_dts_3.f03
@@ -0,0 +1,39 @@
+! { dg-do compile }
+module bind_c_dts_3
+use, intrinsic :: iso_c_binding
+implicit none
+
+TYPE, bind(c) :: t
+  integer(c_int) :: i
+end type t
+
+type :: my_c_type_0 ! { dg-error "must have the BIND attribute" }
+   integer(c_int) :: i
+end type my_c_type_0
+
+type, bind(c) :: my_c_type_1 ! { dg-error "BIND.C. derived type" }
+   type(my_c_type_0) :: my_nested_type
+   type(c_ptr) :: c_address
+   integer(c_int), pointer :: j ! { dg-error "cannot have the POINTER" }
+end type my_c_type_1
+
+type, bind(c) :: t2 ! { dg-error "BIND.C. derived type" }
+   type (t2), pointer :: next ! { dg-error "cannot have the POINTER" }
+end type t2
+
+type, bind(c):: t3 ! { dg-error "BIND.C. derived type" }
+  type(t), allocatable :: c(:) ! { dg-error "cannot have the ALLOCATABLE" }
+end type t3
+
+contains
+  subroutine sub0(my_type, expected_value) bind(c)
+    type(my_c_type_1) :: my_type
+    integer(c_int), value :: expected_value
+
+    if (my_type%my_nested_type%i .ne. expected_value) then
+       call abort ()
+    end if
+  end subroutine sub0
+end module bind_c_dts_3
+
+! { dg-final { cleanup-modules "bind_c_dts_3" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_dts_4.f03 b/gcc/testsuite/gfortran.dg/bind_c_dts_4.f03
new file mode 100644
index 000000000..b2eb5694f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_dts_4.f03
@@ -0,0 +1,10 @@
+! { dg-do compile }
+module test
+use iso_c_binding, only: c_int
+    type, bind(c) ::  foo
+      integer :: p ! { dg-warning "may not be C interoperable" }
+    end type
+    type(foo), bind(c) :: cp
+end module test
+
+! { dg-final { cleanup-modules "test" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_dts_driver.c b/gcc/testsuite/gfortran.dg/bind_c_dts_driver.c
new file mode 100644
index 000000000..bf076ce4a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_dts_driver.c
@@ -0,0 +1,66 @@
+double fabs (double);
+
+/* interops with myftype_1 */
+typedef struct {
+   int m, n;
+   float r;
+} myctype_t;
+
+/* interops with particle in f90 */
+typedef struct particle
+{
+   double x;  /* x position */
+   double vx; /* velocity in x direction */
+   double y;  /* y position */
+   double vy; /* velocity in y direction */
+   double z;  /* z position */
+   double vz; /* velocity in z direction */
+   double m;  /* mass */
+}particle_t;
+
+extern void abort(void);
+void types_test(particle_t *my_particles, int num_particles);
+/* declared in the fortran module bind_c_dts */
+extern myctype_t myDerived;
+
+int main(int argc, char **argv)
+{
+   particle_t my_particles[100];
+
+   /* the fortran code will modify the middle particle */
+   my_particles[49].x = 1.0;
+   my_particles[49].vx = 1.0;
+   my_particles[49].y = 1.0;
+   my_particles[49].vy = 1.0;
+   my_particles[49].z = 1.0;
+   my_particles[49].vz = 1.0;
+   my_particles[49].m = 1.0;
+
+   myDerived.m = 1;
+   myDerived.n = 2;
+   myDerived.r = 3.0;
+
+   types_test(&(my_particles[0]), 100);
+
+   if(fabs(my_particles[49].x - 1.2) > 0.00000000)
+      abort();
+   if(fabs(my_particles[49].vx - 1.2) > 0.00000000)
+      abort();
+   if(fabs(my_particles[49].y - 1.2) > 0.00000000)
+      abort();
+   if(fabs(my_particles[49].vy - 1.2) > 0.00000000)
+      abort();
+   if(fabs(my_particles[49].z - 1.2) > 0.00000000)
+      abort();
+   if(fabs(my_particles[49].vz - 1.2) > 0.00000000)
+      abort();
+   if(fabs(my_particles[49].m - 1.2) > 0.00000000)
+      abort();
+   if(myDerived.m != 2)
+      abort();
+   if(myDerived.n != 3)
+      abort();
+   if(fabs(myDerived.r - 4.0) > 0.00000000)
+      abort();
+   return 0;
+}/* end main() */
diff --git a/gcc/testsuite/gfortran.dg/bind_c_implicit_vars.f03 b/gcc/testsuite/gfortran.dg/bind_c_implicit_vars.f03
new file mode 100644
index 000000000..d6b4b6d61
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_implicit_vars.f03
@@ -0,0 +1,12 @@
+! { dg-do compile }
+module bind_c_implicit_vars
+
+bind(c) :: j ! { dg-warning "may not be C interoperable" }
+
+contains
+  subroutine sub0(i) bind(c) ! { dg-warning "may not be C interoperable" }
+    i = 0
+  end subroutine sub0
+end module bind_c_implicit_vars
+
+! { dg-final { cleanup-modules "bind_c_implicit_vars" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_module.f90 b/gcc/testsuite/gfortran.dg/bind_c_module.f90
new file mode 100644
index 000000000..a17f5d0b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_module.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! See PR fortran/36251.
+module a
+  implicit none
+  integer :: i = 42
+end module a
+
+! Causes ICE
+module b
+  use iso_c_binding
+  use a
+  implicit none
+  bind(c) :: a  ! { dg-error "applied to" }
+end module b
+
+! Causes ICE
+module d
+  use a
+  implicit none
+  bind(c) :: a  ! { dg-error "applied to" }
+end module d
+! { dg-final { cleanup-modules "a" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_procs.f03 b/gcc/testsuite/gfortran.dg/bind_c_procs.f03
new file mode 100644
index 000000000..718042baf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_procs.f03
@@ -0,0 +1,39 @@
+! { dg-do compile }
+module bind_c_procs
+  use, intrinsic :: iso_c_binding, only: c_int
+
+  interface
+     ! warning for my_param possibly not being C interoperable
+     subroutine my_c_sub(my_param) bind(c) ! { dg-warning "may not be C interoperable" }
+       integer, value :: my_param
+     end subroutine my_c_sub
+
+     ! warning for my_c_func possibly not being a C interoperable kind
+     ! warning for my_param possibly not being C interoperable
+     ! error message truncated to provide an expression that both warnings
+     ! should match.
+     function my_c_func(my_param) bind(c) ! { dg-warning "may not be" }
+       integer, value :: my_param
+       integer :: my_c_func
+     end function my_c_func
+  end interface
+
+contains
+  ! warning for my_param possibly not being C interoperable
+  subroutine my_f03_sub(my_param) bind(c) ! { dg-warning "may not be" }
+    integer, value :: my_param
+  end subroutine my_f03_sub
+
+  ! warning for my_f03_func possibly not being a C interoperable kind
+  ! warning for my_param possibly not being C interoperable
+  ! error message truncated to provide an expression that both warnings
+  ! should match.
+  function my_f03_func(my_param) bind(c) ! { dg-warning "may not be" }
+    integer, value :: my_param
+    integer :: my_f03_func
+    my_f03_func = 1
+  end function my_f03_func
+
+end module bind_c_procs
+
+! { dg-final { cleanup-modules "bind_c_procs" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_10.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_10.f03
new file mode 100644
index 000000000..4f2268aee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_10.f03
@@ -0,0 +1,75 @@
+! { dg-do run }
+! { dg-additional-sources bind_c_usage_10_c.c }
+!
+! PR fortran/34079
+!
+! Check BIND(C) for ENTRY
+!
+module mod
+ use iso_c_binding
+ implicit none
+contains
+  subroutine sub1(j) bind(c, name="mySub1")
+    integer(c_int) :: j
+    real(c_float)  :: x
+    j = 5
+    return
+   entry sub1ent(x)
+     x = 55.0
+  end subroutine sub1
+  subroutine sub2(j)
+    integer(c_int) :: j
+    real(c_float)  :: x
+    j = 6
+    return
+   entry sub2ent(x) bind(c, name="mySubEnt2")
+    x = 66.0
+  end subroutine sub2
+  subroutine sub3(j) bind(c, name="mySub3")
+    integer(c_int) :: j
+    real(c_float)  :: x
+    j = 7
+    return
+   entry sub3ent(x) bind(c, name="mySubEnt3")
+     x = 77.0
+  end subroutine sub3
+  subroutine sub4(j)
+    integer(c_int) :: j
+    real(c_float)  :: x
+    j = 8
+    return
+   entry sub4ent(x) bind(c)
+     x = 88.0
+  end subroutine sub4
+
+  integer(c_int) function func1() bind(c, name="myFunc1")
+    real(c_float) :: func1ent
+    func1 = -5
+    return
+   entry func1ent()
+    func1ent = -55.0
+  end function func1
+  integer(c_int) function func2()
+    real(c_float) :: func2ent
+    func2 = -6
+    return
+   entry func2ent() bind(c, name="myFuncEnt2")
+    func2ent = -66.0
+  end function func2
+  integer(c_int) function func3() bind(c, name="myFunc3")
+    real(c_float) :: func3ent
+    func3 = -7
+    return
+   entry func3ent() bind(c, name="myFuncEnt3")
+    func3ent = -77.0
+  end function func3
+  integer(c_int) function func4()
+    real(c_float) :: func4ent
+    func4 = -8
+    return
+   entry func4ent() bind(c)
+    func4ent = -88.0
+  end function func4
+end module mod
+
+! { dg-final { cleanup-modules "mod" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_10_c.c b/gcc/testsuite/gfortran.dg/bind_c_usage_10_c.c
new file mode 100644
index 000000000..ec64c41b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_10_c.c
@@ -0,0 +1,48 @@
+/* Check BIND(C) for ENTRY
+   PR fortran/34079
+   To be linked with bind_c_usage_10.f03
+*/
+
+void mySub1(int *);
+void mySub3(int *);
+void mySubEnt2(float *);
+void mySubEnt3(float *);
+void sub4ent(float *);
+
+int myFunc1(void);
+int myFunc3(void);
+float myFuncEnt2(void);
+float myFuncEnt3(void);
+float func4ent(void);
+
+extern void abort(void);
+
+int main()
+{
+  int i = -1;
+  float r = -3.0f;
+
+  mySub1(&i);
+  if(i != 5) abort();
+  mySub3(&i);
+  if(i != 7) abort();
+  mySubEnt2(&r);
+  if(r != 66.0f) abort();
+  mySubEnt3(&r);
+  if(r != 77.0f) abort();
+  sub4ent(&r);
+  if(r != 88.0f) abort();
+
+  i = myFunc1();
+  if(i != -5) abort();
+  i = myFunc3();
+  if(i != -7) abort();
+  r = myFuncEnt2();
+  if(r != -66.0f) abort();
+  r = myFuncEnt3();
+  if(r != -77.0f) abort();
+  r = func4ent();
+  if(r != -88.0f) abort();
+
+  return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_11.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_11.f03
new file mode 100644
index 000000000..466b71e70
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_11.f03
@@ -0,0 +1,50 @@
+! { dg-do compile }
+! { dg-options "-std=gnu" }
+! PR fortran/34133
+!
+! The compiler should accept internal procedures with BIND(c) attribute
+! for STD GNU / Fortran 2008.
+!
+subroutine foo() bind(c)
+contains
+  subroutine bar() bind (c)
+  end subroutine bar
+end subroutine foo
+
+subroutine foo2() bind(c)
+  use iso_c_binding
+contains
+  integer(c_int) function barbar() bind (c)
+    barbar = 1
+  end function barbar
+end subroutine foo2
+
+function one() bind(c)
+  use iso_c_binding
+  integer(c_int) :: one
+  one = 1
+contains
+  integer(c_int) function two() bind (c)
+    two = 1
+  end function two
+end function one
+
+function one2() bind(c)
+  use iso_c_binding
+  integer(c_int) :: one2
+  one2 = 1
+contains
+  subroutine three() bind (c)
+  end subroutine three
+end function one2
+
+program main
+  use iso_c_binding
+  implicit none
+contains
+  subroutine test() bind(c)
+  end subroutine test
+  integer(c_int) function test2() bind (c)
+    test2 = 1
+  end function test2
+end program main
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_12.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_12.f03
new file mode 100644
index 000000000..8519c664e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_12.f03
@@ -0,0 +1,63 @@
+! { dg-do compile }
+! { dg-options "-std=gnu" }
+! PR fortran/34133
+!
+! bind(C,name="...") is invalid for dummy procedures
+! and for internal procedures.
+!
+subroutine dummy1(a,b)
+!  implicit none
+  interface
+    function b() bind(c,name="jakl") ! { dg-error "no binding name is allowed" }
+!     use iso_c_binding
+!     integer(c_int) :: b       
+    end function b ! { dg-error "Expecting END INTERFACE" }
+  end interface
+  interface
+    subroutine a() bind(c,name="") ! { dg-error "no binding name is allowed" }
+    end subroutine a ! { dg-error "Expecting END INTERFACE" }
+  end interface
+end subroutine dummy1
+
+subroutine internal()
+  implicit none
+contains
+  subroutine int1() bind(c, name="jj") ! { dg-error "No binding name is allowed" }
+  end subroutine int1 ! { dg-error "Expected label" }
+end subroutine internal
+
+subroutine internal1()
+  use iso_c_binding
+  implicit none
+contains
+  integer(c_int) function int2() bind(c, name="jjj") ! { dg-error "No binding name is allowed" }
+  end function int2 ! { dg-error "Expecting END SUBROUTINE" }
+end subroutine internal1
+
+integer(c_int) function internal2()
+  use iso_c_binding
+  implicit none
+  internal2 = 0
+contains
+  subroutine int1() bind(c, name="kk") ! { dg-error "No binding name is allowed" }
+  end subroutine int1 ! { dg-error "Expecting END FUNCTION" }
+end function internal2
+
+integer(c_int) function internal3()
+  use iso_c_binding
+  implicit none
+  internal3 = 0
+contains
+  integer(c_int) function int2() bind(c, name="kkk") ! { dg-error "No binding name is allowed" }
+  end function int2 ! { dg-error "Expected label" }
+end function internal3
+
+program internal_prog
+  use iso_c_binding
+  implicit none
+contains
+  subroutine int1() bind(c, name="mm") ! { dg-error "No binding name is allowed" }
+  end subroutine int1 ! { dg-error "Expecting END PROGRAM statement" }
+  integer(c_int) function int2() bind(c, name="mmm") ! { dg-error "No binding name is allowed" }
+  end function int2 ! { dg-error "Expecting END PROGRAM statement" } 
+end program
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_13.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_13.f03
new file mode 100644
index 000000000..d89963d8b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_13.f03
@@ -0,0 +1,151 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/34079
+! Character bind(c) arguments shall not pass the length as additional argument
+!
+
+subroutine multiArgTest()
+  implicit none
+interface ! Array
+  subroutine multiso_array(x,y) bind(c)
+    use iso_c_binding
+    character(kind=c_char,len=1), dimension(*) :: x,y
+  end subroutine multiso_array
+  subroutine multiso2_array(x,y) bind(c) ! { dg-warning "may not be C interoperable" }
+    character(len=1), dimension(*) :: x,y
+  end subroutine multiso2_array
+  subroutine mult_array(x,y)
+    use iso_c_binding
+    character(kind=c_char,len=1), dimension(*) :: x,y
+  end subroutine mult_array
+end interface
+
+interface ! Scalar: call by reference
+  subroutine multiso(x,y) bind(c)
+    use iso_c_binding
+    character(kind=c_char,len=1) :: x,y
+  end subroutine multiso
+  subroutine multiso2(x,y) bind(c) ! { dg-warning "may not be C interoperable" }
+    character(len=1) :: x,y
+  end subroutine multiso2
+  subroutine mult(x,y)
+    use iso_c_binding
+    character(kind=c_char,len=1) :: x,y
+  end subroutine mult
+end interface
+
+interface ! Scalar: call by VALUE
+  subroutine multiso_val(x,y) bind(c)
+    use iso_c_binding
+    character(kind=c_char,len=1), value :: x,y
+  end subroutine multiso_val
+  subroutine multiso2_val(x,y) bind(c) ! { dg-warning "may not be C interoperable" }
+    character(len=1), value :: x,y
+  end subroutine multiso2_val
+  subroutine mult_val(x,y)
+    use iso_c_binding
+    character(kind=c_char,len=1), value :: x,y
+  end subroutine mult_val
+end interface
+
+call mult_array    ("abc","ab")
+call multiso_array ("ABCDEF","ab")
+call multiso2_array("AbCdEfGhIj","ab")
+
+call mult    ("u","x")
+call multiso ("v","x")
+call multiso2("w","x")
+
+call mult_val    ("x","x")
+call multiso_val ("y","x")
+call multiso2_val("z","x")
+end subroutine multiArgTest
+
+program test
+implicit none
+
+interface ! Array
+  subroutine subiso_array(x) bind(c)
+    use iso_c_binding
+    character(kind=c_char,len=1), dimension(*) :: x
+  end subroutine subiso_array
+  subroutine subiso2_array(x) bind(c) ! { dg-warning "may not be C interoperable" }
+    character(len=1), dimension(*) :: x
+  end subroutine subiso2_array
+  subroutine sub_array(x)
+    use iso_c_binding
+    character(kind=c_char,len=1), dimension(*) :: x
+  end subroutine sub_array
+end interface
+
+interface ! Scalar: call by reference
+  subroutine subiso(x) bind(c)
+    use iso_c_binding
+    character(kind=c_char,len=1) :: x
+  end subroutine subiso
+  subroutine subiso2(x) bind(c) ! { dg-warning "may not be C interoperable" }
+    character(len=1) :: x
+  end subroutine subiso2
+  subroutine sub(x)
+    use iso_c_binding
+    character(kind=c_char,len=1) :: x
+  end subroutine sub
+end interface
+
+interface ! Scalar: call by VALUE
+  subroutine subiso_val(x) bind(c)
+    use iso_c_binding
+    character(kind=c_char,len=1), value :: x
+  end subroutine subiso_val
+  subroutine subiso2_val(x) bind(c) ! { dg-warning "may not be C interoperable" }
+    character(len=1), value :: x
+  end subroutine subiso2_val
+  subroutine sub_val(x)
+    use iso_c_binding
+    character(kind=c_char,len=1), value :: x
+  end subroutine sub_val
+end interface
+
+call sub_array    ("abc")
+call subiso_array ("ABCDEF")
+call subiso2_array("AbCdEfGhIj")
+
+call sub    ("u")
+call subiso ("v")
+call subiso2("w")
+
+call sub_val    ("x")
+call subiso_val ("y")
+call subiso2_val("z")
+end program test
+
+! Double argument dump:
+!
+! { dg-final { scan-tree-dump "mult_array .&.abc..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1., 3, 2.;" "original" } }
+! { dg-final { scan-tree-dump "multiso_array .&.ABCDEF..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1..;" "original" } }
+! { dg-final { scan-tree-dump "multiso2_array .&.AbCdEfGhIj..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1..;" "original" } }
+!
+! { dg-final { scan-tree-dump "mult .&.u..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1., 1, 1.;" "original" } }
+! { dg-final { scan-tree-dump "multiso .&.v..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1..;" "original" } }
+! { dg-final { scan-tree-dump "multiso2 .&.w..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1..;" "original" } }
+!
+! { dg-final { scan-tree-dump "mult_val ..x., .x., 1, 1.;" "original" } }
+! { dg-final { scan-tree-dump "multiso_val .121, 120.;" "original" } }
+! { dg-final { scan-tree-dump "multiso2_val ..z., .x..;" "original" } }
+!
+! Single argument dump:
+!
+! { dg-final { scan-tree-dump "sub_array .&.abc..1..lb: 1 sz: 1., 3.;" "original" } }
+! { dg-final { scan-tree-dump "subiso_array .&.ABCDEF..1..lb: 1 sz: 1..;" "original" } }
+! { dg-final { scan-tree-dump "subiso2_array .&.AbCdEfGhIj..1..lb: 1 sz: 1..;" "original" } }
+!
+! { dg-final { scan-tree-dump "sub .&.u..1..lb: 1 sz: 1., 1.;" "original" } }
+! { dg-final { scan-tree-dump "subiso .&.v..1..lb: 1 sz: 1..;" "original" } }
+! { dg-final { scan-tree-dump "subiso2 .&.w..1..lb: 1 sz: 1..;" "original" } }
+!
+! { dg-final { scan-tree-dump "sub_val ..x., 1.;" "original" } }
+! { dg-final { scan-tree-dump "subiso_val .121.;" "original" } }
+! { dg-final { scan-tree-dump "subiso2_val ..z..;" "original" } }
+!
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_14.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_14.f03
new file mode 100644
index 000000000..2d6726af8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_14.f03
@@ -0,0 +1,115 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/34079
+! Bind(C) procedures shall have no character length
+! dummy and actual arguments.
+!
+
+! SUBROUTINES
+
+subroutine sub1noiso(a, b)
+  use iso_c_binding
+  implicit none
+  character(len=1,kind=c_char) :: a(*), b
+  character(len=1,kind=c_char):: x,z
+  integer(c_int) :: y
+  value :: b
+  print *, a(1:2), b
+end subroutine sub1noiso
+
+subroutine sub2(a, b) bind(c)
+  use iso_c_binding
+  implicit none
+  character(len=1,kind=c_char) :: a(*), b
+  character(len=1,kind=c_char):: x,z
+  integer(c_int) :: y
+  value :: b
+  print *, a(1:2), b
+end subroutine sub2
+
+! SUBROUTINES with ENTRY
+
+subroutine sub3noiso(a, b)
+  use iso_c_binding
+  implicit none
+  character(len=1,kind=c_char) :: a(*), b
+  character(len=1,kind=c_char):: x,z
+  integer(c_int) :: y
+  value :: b
+  print *, a(1:2), b
+entry sub3noisoEntry(x,y,z)
+  x = 'd'
+end subroutine sub3noiso
+
+subroutine sub4iso(a, b) bind(c)
+  use iso_c_binding
+  implicit none
+  character(len=1,kind=c_char) :: a(*), b
+  character(len=1,kind=c_char):: x,z
+  integer(c_int) :: y
+  value :: b
+  print *, a(1:2), b
+entry sub4isoEntry(x,y,z)
+  x = 'd'
+end subroutine sub4iso
+
+subroutine sub5iso(a, b) bind(c)
+  use iso_c_binding
+  implicit none
+  character(len=1,kind=c_char) :: a(*), b
+  character(len=1,kind=c_char):: x,z
+  integer(c_int) :: y
+  value :: b
+  print *, a(1:2), b
+entry sub5noIsoEntry(x,y,z)
+  x = 'd'
+end subroutine sub5iso
+
+subroutine sub6NoIso(a, b)
+  use iso_c_binding
+  implicit none
+  character(len=1,kind=c_char) :: a(*), b
+  character(len=1,kind=c_char):: x,z
+  integer(c_int) :: y
+  value :: b
+  print *, a(1:2), b
+entry sub6isoEntry(x,y,z)
+  x = 'd'
+end subroutine sub6NoIso
+
+! The subroutines (including entry) should have
+! only a char-length parameter if they are not bind(C).
+!
+! { dg-final { scan-tree-dump "sub1noiso \\(\[^.\]*a, \[^.\]*b, \[^.\]*_a, \[^.\]*_b\\)" "original" } }
+! { dg-final { scan-tree-dump "sub2 \\(\[^.\]*a, \[^.\]*b\\)" "original" } }
+! { dg-final { scan-tree-dump "sub3noiso \\(\[^.\]*a, \[^.\]*b, \[^.\]*_a, \[^.\]*_b\\)" "original" } }
+! { dg-final { scan-tree-dump "sub3noisoentry \\(\[^.\]*x, \[^.\]*y, \[^.\]*z, \[^.\]*_x, \[^.\]*_z\\)" "original" } }
+! { dg-final { scan-tree-dump "sub4iso \\(\[^.\]*a, \[^.\]*b\\)" "original" } }
+! { dg-final { scan-tree-dump "sub4isoentry \\(\[^.\]*x, \[^.\]*y, \[^.\]*z, \[^.\]*_x, \[^.\]*_z\\)" "original" } }
+! { dg-final { scan-tree-dump "sub5iso \\(\[^.\]*a, \[^.\]*b\\)" "original" } }
+! { dg-final { scan-tree-dump "sub5noisoentry \\(\[^.\]*x, \[^.\]*y, \[^.\]*z, \[^.\]*_x, \[^.\]*_z\\)" "original" } }
+! { dg-final { scan-tree-dump "sub6noiso \\(\[^.\]*a, \[^.\]*b, \[^.\]*_a, \[^.\]*_b\\)" "original" } }
+! { dg-final { scan-tree-dump "sub6isoentry \\(\[^.\]*x, \[^.\]*y, \[^.\]*z, \[^.\]*_x, \[^.\]*_z\\)" "original" } }
+
+! The master functions should have always a length parameter
+! to ensure sharing a parameter between bind(C) and non-bind(C) works
+!
+! { dg-final { scan-tree-dump "master.0.sub3noiso \\(\[^.\]*__entry, \[^.\]*z, \[^.\]*y, \[^.\]*x, \[^.\]*b, \[^.\]*a, \[^.\]*_z, \[^.\]*_x, \[^.\]*_b, \[^.\]*_a\\)" "original" } }
+! { dg-final { scan-tree-dump "master.1.sub4iso \\(\[^.\]*__entry, \[^.\]*z, \[^.\]*y, \[^.\]*x, \[^.\]*b, \[^.\]*a, \[^.\]*_z, \[^.\]*_x, \[^.\]*_b, \[^.\]*_a\\)" "original" } }
+! { dg-final { scan-tree-dump "master.2.sub5iso \\(\[^.\]*__entry, \[^.\]*z, \[^.\]*y, \[^.\]*x, \[^.\]*b, \[^.\]*a, \[^.\]*_z, \[^.\]*_x, \[^.\]*_b, \[^.\]*_a\\)" "original" } }
+! { dg-final { scan-tree-dump "master.3.sub6noiso \\(\[^.\]*__entry, \[^.\]*z, \[^.\]*y, \[^.\]*x, \[^.\]*b, \[^.\]*a, \[^.\]*_z, \[^.\]*_x, \[^.\]*_b, \[^.\]*_a\\)" "original" } }
+
+! Thus, the master functions need to be called with length arguments
+! present
+!
+! { dg-final { scan-tree-dump "master.0.sub3noiso .0, 0B, 0B, 0B, b, a, 0, 0, 1, 1\\);" "original" } }
+! { dg-final { scan-tree-dump "master.0.sub3noiso .1, z, y, x, 0B, 0B, 1, 1, 0, 0\\);" "original" } }
+! { dg-final { scan-tree-dump "master.1.sub4iso .0, 0B, 0B, 0B, b, a, 0, 0, 1, 1\\);" "original" } }
+! { dg-final { scan-tree-dump "master.1.sub4iso .1, z, y, x, 0B, 0B, 1, 1, 0, 0\\);" "original" } }
+! { dg-final { scan-tree-dump "master.2.sub5iso .0, 0B, 0B, 0B, b, a, 0, 0, 1, 1\\);" "original" } }
+! { dg-final { scan-tree-dump "master.2.sub5iso .1, z, y, x, 0B, 0B, 1, 1, 0, 0\\);" "original" } }
+! { dg-final { scan-tree-dump "master.3.sub6noiso .0, 0B, 0B, 0B, b, a, 0, 0, 1, 1\\);" "original" } }
+! { dg-final { scan-tree-dump "master.3.sub6noiso .1, z, y, x, 0B, 0B, 1, 1, 0, 0\\);" "original" } }
+
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_15.f90 b/gcc/testsuite/gfortran.dg/bind_c_usage_15.f90
new file mode 100644
index 000000000..c5201a634
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_15.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+!
+! PR fortran/34187
+! The binding label was not exported for private procedures
+! with public generic interfaces.
+!
+module mod
+  use iso_c_binding, only: c_int
+  implicit none
+  private
+  public :: gen, c_int
+  interface gen
+    module procedure  test
+  end interface gen
+contains
+  subroutine test(a) bind(c, name="myFunc")
+    integer(c_int), intent(out) :: a 
+    a = 17
+  end subroutine test
+end module mod
+
+program main
+  use mod
+  implicit none
+  integer(c_int) :: x
+  x = -44
+  call gen(x)
+  if(x /= 17) call abort()
+end program main
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_16.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_16.f03
new file mode 100644
index 000000000..990918fcc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_16.f03
@@ -0,0 +1,57 @@
+! { dg-do run }
+! { dg-additional-sources bind_c_usage_16_c.c }
+!
+! PR fortran/34079
+!
+! Ensure character-returning, bind(C) function work.
+!
+module mod
+  use iso_c_binding
+  implicit none
+contains
+  function bar(x)  bind(c, name="returnA")
+    character(len=1,kind=c_char) :: bar, x
+    bar = x
+    bar = 'A'
+  end function bar
+  function foo()  bind(c, name="returnB")
+    character(len=1,kind=c_char) :: foo
+    foo = 'B'
+  end function foo
+end module mod
+
+subroutine test() bind(c)
+  use mod
+  implicit none
+  character(len=1,kind=c_char) :: a
+  character(len=3,kind=c_char) :: b
+  character(len=1,kind=c_char) :: c(3)
+  character(len=3,kind=c_char) :: d(3)
+  integer :: i
+
+  a = 'z'
+  b = 'fffff'
+  c = 'h'
+  d = 'uuuuu'
+
+  a = bar('x')
+  if (a /= 'A') call abort()
+  b = bar('y')
+  if (b /= 'A' .or. iachar(b(2:2))/=32 .or. iachar(b(3:3))/=32) call abort()
+  c = bar('x')
+  if (any(c /= 'A')) call abort()
+  d = bar('y')
+  if (any(d /= 'A')) call abort()
+
+  a = foo()
+  if (a /= 'B') call abort()
+  b = foo()
+  if (b /= 'B') call abort()
+  c = foo()
+  if (any(c /= 'B')) call abort()
+  d = foo()
+  if (any(d /= 'B')) call abort()
+  do i = 1,3
+    if(iachar(d(i)(2:2)) /=32 .or. iachar(d(i)(3:3)) /= 32) call abort()
+  end do
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_16_c.c b/gcc/testsuite/gfortran.dg/bind_c_usage_16_c.c
new file mode 100644
index 000000000..30ce25f8b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_16_c.c
@@ -0,0 +1,22 @@
+/* Check character-returning bind(C) functions
+   PR fortran/34079
+   To be linked with bind_c_usage_16.f03
+*/
+
+#include <stdlib.h>
+
+char returnA(char *);
+char returnB(void);
+void test(void);
+
+int main()
+{
+  char c;
+  c = 'z';
+  c = returnA(&c);
+  if (c != 'A') abort();
+  c = returnB();
+  if (c != 'B') abort();
+  test();
+  return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_17.f90 b/gcc/testsuite/gfortran.dg/bind_c_usage_17.f90
new file mode 100644
index 000000000..ba342755c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_17.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! { dg-additional-sources bind_c_usage_17_c.c }
+!
+! PR fortran/37201
+!
+! 
+!
+MODULE mod
+  INTERFACE
+    FUNCTION cdir() BIND(C,name="cdir") RESULT(r)
+      USE iso_c_binding
+      CHARACTER(kind=C_CHAR) :: r
+    END FUNCTION
+  END INTERFACE
+END MODULE
+
+PROGRAM test
+  USE mod
+  integer :: i = -43
+  character(len=1) :: str1
+  character(len=4) :: str4
+  str1 = 'x'
+  str4 = 'xyzz'
+  str1 = cdir()
+  if(str1 /= '/') call abort()
+  str4 = cdir()
+  if(str4 /= '/' .or. ichar(str4(2:2)) /= 32) call abort()
+  i   = ICHAR(cdir())
+  if (i /= 47) call abort()
+  str4 = 'xyzz'
+  WRITE(str4,'(a)') cdir()
+  if(str4 /= '/' .or. ichar(str4(2:2)) /= 32) call abort()
+  str4 = 'xyzz'
+  WRITE(str4,'(i0)') ICHAR(cdir())
+  if(str4 /= '47' .or. ichar(str4(3:3)) /= 32) call abort()
+END PROGRAM
+
+! { dg-final { cleanup-modules "mod" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_17_c.c b/gcc/testsuite/gfortran.dg/bind_c_usage_17_c.c
new file mode 100644
index 000000000..456d542af
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_17_c.c
@@ -0,0 +1,4 @@
+/* PR fortran/37201.
+   Linked with bind_c_usage_17.f90.  */
+
+char cdir(void){return '/';}
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_18.f90 b/gcc/testsuite/gfortran.dg/bind_c_usage_18.f90
new file mode 100644
index 000000000..2bce215af
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_18.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+!
+! PR fortran/38160
+!
+
+subroutine foo(x,y,z,a) bind(c) ! { dg-warning "but may not be C interoperable" }
+  use iso_c_binding
+  implicit none
+  integer(4) :: x
+  integer(c_float) :: y ! { dg-warning "C kind type parameter is for type REAL" }
+  complex(c_float) :: z ! OK, c_float == c_float_complex
+  real(c_float_complex) :: a ! OK, c_float == c_float_complex
+end subroutine foo
+
+use iso_c_binding
+implicit none
+integer, parameter :: it = c_int
+integer, parameter :: dt = c_double
+complex(c_int), target    :: z1  ! { dg-warning "C kind type parameter is for type INTEGER" }
+complex(it), target       :: z2  ! { dg-warning "C kind type parameter is for type INTEGER" }
+complex(c_double), target :: z3  ! OK
+complex(dt), target       :: z4  ! OK
+type(c_ptr) :: ptr
+
+ptr = c_loc(z1)
+ptr = c_loc(z2)
+ptr = c_loc(z3)
+ptr = c_loc(z4)
+end
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_19.f90 b/gcc/testsuite/gfortran.dg/bind_c_usage_19.f90
new file mode 100644
index 000000000..30f9f5ee1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_19.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+function return_char1(i) bind(c,name='return_char1')
+  use iso_c_binding
+  implicit none
+  integer(c_int) :: i
+  character(c_char) :: j
+  character(c_char) :: return_char1
+
+  j = achar(i)
+  return_char1 = j
+end function return_char1
+function return_char2(i) result(output) bind(c,name='return_char2')
+  use iso_c_binding
+  implicit none
+  integer(c_int) :: i
+  character(c_char) :: j
+  character(c_char) :: output
+
+  j = achar(i)
+  output = j
+end function return_char2
+function return_char3(i) bind(c,name='return_char3') result(output)
+  use iso_c_binding
+  implicit none
+  integer(c_int) :: i
+  character(c_char) :: j
+  character(c_char) :: output
+
+  j = achar(i)
+  output = j
+end function return_char3
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_2.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_2.f03
new file mode 100644
index 000000000..e76215e7f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_2.f03
@@ -0,0 +1,15 @@
+! { dg-do compile }
+use, intrinsic :: iso_c_binding
+type, bind(c) :: mytype
+  integer(c_int) :: j
+end type mytype
+
+type(mytype), bind(c) :: mytype_var ! { dg-error "cannot be BIND.C." }
+
+integer(c_int), bind(c) :: i ! { dg-error "cannot be declared with BIND.C." }
+integer(c_int), bind(c), dimension(10) :: my_array ! { dg-error "cannot be BIND.C." }
+
+common /COM/ i
+bind(c) :: /com/
+
+end
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_20.f90 b/gcc/testsuite/gfortran.dg/bind_c_usage_20.f90
new file mode 100644
index 000000000..0a6fa9e9a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_20.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-fcheck=bounds" }
+!
+! PR fortran/43015
+!
+! Contributed by Dennis Wassel
+!
+SUBROUTINE foo(msg) BIND(C, name = "Foo")
+  USE, INTRINSIC :: iso_c_binding
+  IMPLICIT NONE
+  CHARACTER (KIND=C_CHAR), INTENT (out) :: msg(*) 
+END SUBROUTINE foo
+
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_21.f90 b/gcc/testsuite/gfortran.dg/bind_c_usage_21.f90
new file mode 100644
index 000000000..10a86dbbb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_21.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+! PR fortran/45211
+!
+! Contributed by Scot Breitenfeld
+!
+module m
+contains
+  FUNCTION liter_cb(link_info) bind(C)
+    USE ISO_C_BINDING
+    IMPLICIT NONE
+
+    INTEGER(c_int) liter_cb
+
+    TYPE, bind(C) :: info_t
+       INTEGER(c_int) :: type
+    END TYPE info_t
+
+    TYPE(info_t) :: link_info
+
+    liter_cb = 0
+  END FUNCTION liter_cb
+end module m
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_3.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_3.f03
new file mode 100644
index 000000000..47f9d9a92
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_3.f03
@@ -0,0 +1,19 @@
+! { dg-do compile }
+module test
+  use, intrinsic :: iso_c_binding
+
+  type, bind(c) :: my_c_type ! { dg-error "BIND.C. derived type" }
+     integer(c_int), pointer :: ptr ! { dg-error "cannot have the POINTER attribute" }
+  end type my_c_type 
+  
+  type, bind(c) :: my_type ! { dg-error "BIND.C. derived type" }
+     integer(c_int), allocatable :: ptr(:) ! { dg-error "cannot have the ALLOCATABLE attribute" }
+  end type my_type
+
+  type foo ! { dg-error "must have the BIND attribute" }
+    integer(c_int) :: p 
+  end type foo 
+
+  type(foo), bind(c) :: cp ! { dg-error "is not C interoperable" }
+  real(c_double), pointer,bind(c) :: p ! { dg-error "cannot have both the POINTER and BIND.C." }
+end module test
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_5.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_5.f03
new file mode 100644
index 000000000..95afa010f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_5.f03
@@ -0,0 +1,8 @@
+! { dg-do compile }
+module bind_c_usage_5
+use, intrinsic :: iso_c_binding
+
+bind(c) c3, c4 
+integer(c_int), bind(c) :: c3 ! { dg-error "Duplicate BIND attribute" }
+integer(c_int) :: c4
+end module bind_c_usage_5
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_6.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_6.f03
new file mode 100644
index 000000000..924dd40bc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_6.f03
@@ -0,0 +1,48 @@
+! { dg-do compile }
+module x
+  use iso_c_binding
+  bind(c) :: test, sub1 ! { dg-error "only be used for variables or common blocks" }
+  bind(c) :: sub2 ! { dg-error "only be used for variables or common blocks" }
+contains
+  function foo() bind(c,name="xx")
+    integer(c_int),bind(c,name="xy") :: foo ! { dg-error "only be used for variables or common blocks" }
+    ! NAG f95: "BIND(C) for non-variable FOO"  
+    ! g95: "Duplicate BIND attribute specified"
+    ! gfortran: Accepted
+    foo = 5_c_int
+  end function foo
+
+  function test()
+    integer(c_int) :: test
+    bind(c,name="kk") :: test ! { dg-error "only be used for variables or common blocks" }
+    ! NAG f95: "BIND(C) for non-variable TEST"
+    ! gfortran, g95: Accepted
+    test = 5_c_int
+  end function test
+
+  function bar() bind(c)
+    integer(c_int) :: bar 
+    bind(c,name="zx") :: bar ! { dg-error "only be used for variables or common blocks" }
+    bar = 5_c_int
+  end function bar
+
+  subroutine sub0() bind(c)
+    bind(c) :: sub0 ! { dg-error "only be used for variables or common blocks" }
+  end subroutine sub0
+
+  subroutine sub1(i) bind(c)
+    use, intrinsic :: iso_c_binding, only: c_int
+    integer(c_int), value :: i
+  end subroutine sub1
+
+  subroutine sub2(i) 
+    use, intrinsic :: iso_c_binding, only: c_int
+    integer(c_int), value :: i
+  end subroutine sub2
+
+  subroutine sub3(i) 
+    use, intrinsic :: iso_c_binding, only: c_int
+    integer(c_int), value :: i
+    bind(c) :: sub3 ! { dg-error "only be used for variables or common blocks" }
+  end subroutine sub3
+end module x
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_7.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_7.f03
new file mode 100644
index 000000000..845aab953
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_7.f03
@@ -0,0 +1,16 @@
+! { dg-do compile }
+module x
+  use iso_c_binding
+  implicit none
+contains
+  function bar() bind(c) ! { dg-error "cannot be an array" }
+    integer(c_int) :: bar(5)
+  end function bar
+
+  function my_string_func() bind(c) ! { dg-error "cannot be a character string" }
+    character(kind=c_char, len=10) :: my_string_func
+    my_string_func = 'my_string' // C_NULL_CHAR
+  end function my_string_func
+end module x
+
+! { dg-final { cleanup-modules "x" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_8.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_8.f03
new file mode 100644
index 000000000..a94545cc5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_8.f03
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! This should compile, though there is a warning about the type of len
+! (return variable of strlen()) for being implicit.
+! PR fortran/32797
+!
+MODULE ISO_C_UTILITIES
+   USE ISO_C_BINDING
+   implicit none
+   CHARACTER(C_CHAR), DIMENSION(1), SAVE, TARGET, PRIVATE :: dummy_string="?"
+CONTAINS
+   FUNCTION C_F_STRING(CPTR) RESULT(FPTR)
+     use, intrinsic :: iso_c_binding
+      TYPE(C_PTR), INTENT(IN) :: CPTR ! The C address
+      CHARACTER(KIND=C_CHAR), DIMENSION(:), POINTER :: FPTR
+      INTERFACE
+         FUNCTION strlen(string) RESULT(len) BIND(C,NAME="strlen") ! { dg-warning "Implicitly declared" }
+            USE ISO_C_BINDING
+            TYPE(C_PTR), VALUE :: string ! A C pointer
+         END FUNCTION
+      END INTERFACE
+      CALL C_F_POINTER(FPTR=FPTR, CPTR=CPTR, SHAPE=[strlen(CPTR)])
+   END FUNCTION
+END MODULE ISO_C_UTILITIES
+! { dg-final { cleanup-modules "iso_c_utilities" } }
+
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_9.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_9.f03
new file mode 100644
index 000000000..086a1166a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_9.f03
@@ -0,0 +1,47 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! PR fortran/34133
+!
+! The compiler should reject internal procedures with BIND(c) attribute
+! for Fortran 2003.
+!
+subroutine foo() bind(c)
+contains
+  subroutine bar() bind (c) ! { dg-error "may not be specified for an internal" }
+  end subroutine bar ! { dg-error "Expected label" }
+end subroutine foo ! { dg-error "Fortran 2008: CONTAINS statement" }
+
+subroutine foo2() bind(c)
+  use iso_c_binding
+contains
+  integer(c_int) function barbar() bind (c) ! { dg-error "may not be specified for an internal" }
+  end function barbar ! { dg-error "Expecting END SUBROUTINE" }
+end subroutine foo2 ! { dg-error "Fortran 2008: CONTAINS statement" }
+
+function one() bind(c)
+  use iso_c_binding
+  integer(c_int) :: one
+  one = 1
+contains
+  integer(c_int) function two() bind (c) ! { dg-error "may not be specified for an internal" }
+  end function two ! { dg-error "Expected label" }
+end function one ! { dg-error "Fortran 2008: CONTAINS statement" }
+
+function one2() bind(c)
+  use iso_c_binding
+  integer(c_int) :: one2
+  one2 = 1
+contains
+  subroutine three() bind (c) ! { dg-error "may not be specified for an internal" }
+  end subroutine three ! { dg-error "Expecting END FUNCTION statement" }
+end function one2 ! { dg-error "Fortran 2008: CONTAINS statement" }
+
+program main
+  use iso_c_binding
+  implicit none
+contains
+  subroutine test() bind(c) ! { dg-error "may not be specified for an internal" }
+  end subroutine test ! { dg-error "Expecting END PROGRAM" }
+  integer(c_int) function test2() bind (c) ! { dg-error "may not be specified for an internal" }
+  end function test2  ! { dg-error "Expecting END PROGRAM" }
+end program main ! { dg-error "Fortran 2008: CONTAINS statement" }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_vars.f90 b/gcc/testsuite/gfortran.dg/bind_c_vars.f90
new file mode 100644
index 000000000..e57edf09d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_vars.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! { dg-additional-sources bind_c_vars_driver.c }
+module bind_c_vars
+  use, intrinsic :: iso_c_binding
+  implicit none
+
+  integer(c_int), bind(c) :: myF90Int
+  real(c_float), bind(c, name="myF90Real") :: f90_real
+  integer(c_int) :: c2
+  integer(c_int) :: c3
+  integer(c_int) :: c4
+  bind(c, name="myVariable") :: c2
+  bind(c) c3, c4 
+
+  integer(c_int), bind(c, name="myF90Array3D") :: A(18, 3:7, 10)
+  integer(c_int), bind(c, name="myF90Array2D") :: B(3, 2)
+
+contains
+  
+  subroutine changeF90Globals() bind(c, name='changeF90Globals')
+    implicit none
+    ! should make it 2
+    myF90Int = myF90Int + 1
+    ! should make it 3.0
+    f90_real = f90_real * 3.0;
+    ! should make it 4
+    c2 = c2 * 2;
+    ! should make it 6
+    c3 = c3 + 3;
+    ! should make it 2
+    c4 = c4 / 2;
+    ! should make it 2
+    A(5, 6, 3) = A(5, 6, 3) + 1
+    ! should make it 3
+    B(3, 2) = B(3, 2) + 1
+  end subroutine changeF90Globals
+
+end module bind_c_vars
+
+! { dg-final { cleanup-modules "bind_c_vars" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_vars_driver.c b/gcc/testsuite/gfortran.dg/bind_c_vars_driver.c
new file mode 100644
index 000000000..2af800a15
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_vars_driver.c
@@ -0,0 +1,46 @@
+double fabs (double);
+
+/* defined in fortran module bind_c_vars */
+void changeF90Globals(void);
+
+extern void abort(void);
+
+/* module level scope in bind_c_vars */
+extern int myf90int;         /* myf90int in bind_c_vars */
+float myF90Real;             /* f90_real in bind_c_vars */
+int myF90Array3D[10][5][18]; /* A in bind_c_vars */
+int myF90Array2D[2][3];      /* B in bind_c_vars */
+int myVariable;              /* c2 in bind_c_vars */
+int c3;                      /* c3 in bind_c_vars */
+int c4;                      /* c4 in bind_c_vars */
+
+int main(int argc, char **argv)
+{
+   myf90int = 1;
+   myF90Real = 1.0;
+   myVariable = 2;
+   c3 = 3;
+   c4 = 4;
+   myF90Array3D[2][3][4] = 1;
+   myF90Array2D[1][2] = 2;
+
+   /* will change the global vars initialized above */
+   changeF90Globals();
+
+   if(myf90int != 2)
+      abort();
+   if(fabs(myF90Real-3.0) > 0.00000000)
+      abort();
+   if(myVariable != 4)
+      abort();
+   if(c3 != 6)
+      abort();
+   if(c4 != 2)
+      abort();
+   if(myF90Array3D[2][3][4] != 2)
+      abort();
+   if(myF90Array2D[1][2] != 3)
+      abort();
+   
+   return 0;
+}/* end main() */
diff --git a/gcc/testsuite/gfortran.dg/binding_c_table_15_1.f03 b/gcc/testsuite/gfortran.dg/binding_c_table_15_1.f03
new file mode 100644
index 000000000..a5573092d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_c_table_15_1.f03
@@ -0,0 +1,14 @@
+! { dg-do run }
+! Test the named constants in Table 15.1.
+program a
+  use, intrinsic :: iso_c_binding
+  implicit none
+  if (C_NULL_CHAR       /=  CHAR(0) ) call abort
+  if (C_ALERT           /= ACHAR(7) ) call abort
+  if (C_BACKSPACE       /= ACHAR(8) ) call abort
+  if (C_FORM_FEED       /= ACHAR(12)) call abort
+  if (C_NEW_LINE        /= ACHAR(10)) call abort
+  if (C_CARRIAGE_RETURN /= ACHAR(13)) call abort
+  if (C_HORIZONTAL_TAB  /= ACHAR(9) ) call abort
+  if (C_VERTICAL_TAB    /= ACHAR(11)) call abort
+end program a
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests.f03
new file mode 100644
index 000000000..34986501e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests.f03
@@ -0,0 +1,77 @@
+! { dg-do compile }
+module binding_label_tests
+  use, intrinsic :: iso_c_binding
+  implicit none
+
+  contains
+
+  subroutine c_sub() BIND(c, name = "C_Sub")
+    print *, 'hello from c_sub'
+  end subroutine c_sub
+
+  integer(c_int) function c_func() bind(C, name="__C_funC")
+    print *, 'hello from c_func'
+    c_func = 1
+  end function c_func
+
+  real(c_float) function f90_func() 
+    print *, 'hello from f90_func'
+    f90_func = 1.0
+  end function f90_func
+
+  real(c_float) function c_real_func() bind(c)
+    print *, 'hello from c_real_func'
+    c_real_func = 1.5
+  end function c_real_func
+
+  integer function f90_func_0() result ( f90_func_0_result ) 
+    print *, 'hello from f90_func_0'
+    f90_func_0_result = 0
+  end function f90_func_0
+
+  integer(c_int) function f90_func_1() result ( f90_func_1_result ) bind(c, name="__F90_Func_1__")
+    print *, 'hello from f90_func_1'
+    f90_func_1_result = 1
+  end function f90_func_1
+
+  integer(c_int) function f90_func_3() result ( f90_func_3_result ) bind(c)
+    print *, 'hello from f90_func_3'
+    f90_func_3_result = 3
+  end function f90_func_3
+
+  integer(c_int) function F90_func_2() bind(c) result ( f90_func_2_result ) 
+    print *, 'hello from f90_func_2'
+    f90_func_2_result = 2
+  end function f90_func_2
+
+  integer(c_int) function F90_func_4() bind(c, name="F90_func_4") result ( f90_func_4_result ) 
+    print *, 'hello from f90_func_4'
+    f90_func_4_result = 4
+  end function f90_func_4
+
+  integer(c_int) function F90_func_5() bind(c, name="F90_func_5") result ( f90_func_5_result ) 
+    print *, 'hello from f90_func_5'
+    f90_func_5_result = 5
+  end function f90_func_5
+
+  subroutine c_sub_2() bind(c, name='c_sub_2')
+    print *, 'hello from c_sub_2'
+  end subroutine c_sub_2
+
+  subroutine c_sub_3() BIND(c, name = "  C_Sub_3  ")
+    print *, 'hello from c_sub_3'
+  end subroutine c_sub_3
+
+  subroutine c_sub_5() BIND(c, name = "C_Sub_5        ")
+    print *, 'hello from c_sub_5'
+  end subroutine c_sub_5
+
+  ! nothing between the quotes except spaces, so name="".
+  ! the name will get set to the regularly mangled version of the name.  
+  ! perhaps it should be marked with some characters that are invalid for 
+  ! C names so C can not call it?
+  subroutine sub4() BIND(c, name = "        ") 
+  end subroutine sub4 
+end module binding_label_tests
+
+! { dg-final { cleanup-modules "binding_label_tests" } }
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_10.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_10.f03
new file mode 100644
index 000000000..99c9c5276
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_10.f03
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! This file must be compiled BEFORE binding_label_tests_10_main.f03, which it 
+! should be because dejagnu will sort the files.
+module binding_label_tests_10
+  use iso_c_binding
+  implicit none
+  integer(c_int), bind(c,name="c_one") :: one
+end module binding_label_tests_10
+
+! Do not use dg-final to cleanup-modules
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03
new file mode 100644
index 000000000..aa24a6ac1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! This file must be compiled AFTER binding_label_tests_10.f03, which it 
+! should be because dejagnu will sort the files.
+module binding_label_tests_10_main
+  use iso_c_binding
+  implicit none
+  integer(c_int), bind(c,name="c_one") :: one ! { dg-error "collides" }
+end module binding_label_tests_10_main
+
+program main
+  use binding_label_tests_10 ! { dg-error "collides" }
+  use binding_label_tests_10_main
+end program main
+
+! { dg-final { cleanup-modules "binding_label_tests_10_main binding_label_tests_10" } }
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_11.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_11.f03
new file mode 100644
index 000000000..5e889a788
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_11.f03
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! This file must be compiled BEFORE binding_label_tests_11_main.f03, which it 
+! should be because dejagnu will sort the files.
+module binding_label_tests_11
+  use iso_c_binding, only: c_int
+  implicit none
+contains
+  function one() bind(c, name="c_one")
+    integer(c_int) one
+    one = 1
+  end function one
+end module binding_label_tests_11
+
+! Do not use dg-final to cleanup-modules
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03
new file mode 100644
index 000000000..53eac7cf5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! This file must be compiled AFTER binding_label_tests_11.f03, which it 
+! should be because dejagnu will sort the files.
+module binding_label_tests_11_main
+  use iso_c_binding, only: c_int
+  implicit none
+contains
+  function one() bind(c, name="c_one") ! { dg-error "collides" }
+    integer(c_int) one
+    one = 1
+  end function one
+end module binding_label_tests_11_main
+
+program main
+  use binding_label_tests_11 ! { dg-error "collides" }
+  use binding_label_tests_11_main
+end program main
+
+! { dg-final { cleanup-modules "binding_label_tests_11_main binding_label_tests_11" } }
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_12.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_12.f03
new file mode 100644
index 000000000..0a0006681
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_12.f03
@@ -0,0 +1,24 @@
+! { dg-do run }
+! This verifies that the compiler will correctly accpet the name="", write out
+! an empty string for the binding label to the module file, and then read it
+! back in.  Also, during gfc_verify_binding_labels, the name="" will prevent
+! any verification (since there is no label to verify).
+module one
+contains
+  subroutine foo() bind(c)
+  end subroutine foo
+end module one
+
+module two
+contains
+  ! This procedure is only used accessed in C
+  ! as procedural pointer
+  subroutine foo() bind(c, name="")
+  end subroutine foo
+end module two
+
+use one, only: foo_one => foo
+use two, only: foo_two => foo
+end
+
+! { dg-final { cleanup-modules "one two" } }
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_13.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_13.f03
new file mode 100644
index 000000000..786945d3a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_13.f03
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! This file must be compiled BEFORE binding_label_tests_13_main.f03, which it 
+! should be because dejagnu will sort the files.  
+module binding_label_tests_13
+ use, intrinsic :: iso_c_binding, only: c_int
+  integer(c_int) :: c3
+  bind(c) c3
+end module binding_label_tests_13
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03
new file mode 100644
index 000000000..1addc9c49
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! This file must be compiled AFTER binding_label_tests_13.f03, which it 
+! should be because dejagnu will sort the files.  The module file 
+! binding_label_tests_13.mod can not be removed until after this test is done.
+module binding_label_tests_13_main
+  use, intrinsic :: iso_c_binding, only: c_int
+  integer(c_int) :: c3 ! { dg-error "collides" }
+  bind(c) c3
+
+contains
+  subroutine c_sub() BIND(c, name = "C_Sub")
+    use binding_label_tests_13 ! { dg-error "collides" }
+  end subroutine c_sub
+end module binding_label_tests_13_main
+! { dg-final { cleanup-modules "binding_label_tests_13 binding_label_tests_13_main" } }
+
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_14.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_14.f03
new file mode 100644
index 000000000..041237bbe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_14.f03
@@ -0,0 +1,12 @@
+! { dg-do run }
+subroutine display() bind(c)
+  implicit none
+end subroutine display
+
+program main
+  implicit none
+  interface
+     subroutine display() bind(c)
+     end subroutine display
+  end interface
+end program main
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_15.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_15.f03
new file mode 100644
index 000000000..b1b4b5805
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_15.f03
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! Verify that an error is correctly reported if multiple identifiers are given
+! with a bind(c) statement that has a NAME= specifier.
+module m
+  use iso_c_binding
+  implicit none
+  integer(c_int), bind(C, name="") :: a,b ! { dg-error "Multiple identifiers" }
+  integer(c_int), bind(C, name="bob") :: c,d ! { dg-error "Multiple identifiers" }
+  integer(c_int) :: e,f 
+  bind(c, name="foo") :: e,f ! { dg-error "Multiple identifiers" }
+end module m
+
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_16.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_16.f03
new file mode 100644
index 000000000..6b8f1f89b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_16.f03
@@ -0,0 +1,22 @@
+! { dg-do run }
+! Verify that the variables 'a' in both modules don't collide.
+module m
+  use iso_c_binding
+  implicit none
+  integer(c_int), save, bind(C, name="") :: a = 5
+end module m
+
+module n
+  use iso_c_binding
+  implicit none
+  integer(c_int), save, bind(C,name="") :: a = -5
+end module n
+
+program prog
+use m
+use n, b=>a
+implicit none
+  print *, a, b
+  if (a /= 5 .or. b /= -5) call abort()
+end program prog
+! { dg-final { cleanup-modules "m n" } }
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_2.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_2.f03
new file mode 100644
index 000000000..bf9da112a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_2.f03
@@ -0,0 +1,35 @@
+! { dg-do compile }
+module binding_label_tests_2
+
+contains
+  ! this is just here so at least one of the subroutines will be accepted so
+  ! gfortran doesn't give an Extension warning when using -pedantic-errors
+  subroutine ok() 
+  end subroutine ok
+
+  subroutine sub0() bind(c, name="   1") ! { dg-error "Invalid C name" }
+  end subroutine sub0 ! { dg-error "Expecting END MODULE" }
+
+  subroutine sub1() bind(c, name="$") ! { dg-error "Invalid C name" }
+  end subroutine sub1 ! { dg-error "Expecting END MODULE" }
+
+  subroutine sub2() bind(c, name="abc$") ! { dg-error "Invalid C name" }
+  end subroutine sub2 ! { dg-error "Expecting END MODULE" }
+
+  subroutine sub3() bind(c, name="abc d") ! { dg-error "Embedded space" }
+  end subroutine sub3 ! { dg-error "Expecting END MODULE" }
+
+  subroutine sub5() BIND(C, name=" myvar 2 ") ! { dg-error "Embedded space" }
+  end subroutine sub5 ! { dg-error "Expecting END MODULE" }
+
+  subroutine sub6() bind(c, name="         ) ! { dg-error "Invalid C name" }
+  end subroutine sub6 ! { dg-error "Expecting END MODULE" }
+
+  subroutine sub7() bind(c, name=) ! { dg-error "Syntax error" }
+  end subroutine sub7 ! { dg-error "Expecting END MODULE" }
+
+  subroutine sub8() bind(c, name) ! { dg-error "Syntax error" }
+  end subroutine sub8 ! { dg-error "Expecting END MODULE" }
+end module binding_label_tests_2 
+
+! { dg-final { cleanup-modules "binding_label_tests_2" } }
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_3.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_3.f03
new file mode 100644
index 000000000..6e1244702
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_3.f03
@@ -0,0 +1,30 @@
+! { dg-do compile }
+program main
+use iso_c_binding
+  interface
+     subroutine p1(f, a1, a2, a3, a4) bind(c, name='printf') ! { dg-error "collides" }
+       import :: c_ptr, c_int, c_double
+       type(c_ptr), value :: f
+       integer(c_int), value :: a1, a3
+       real(c_double), value :: a2, a4
+     end subroutine p1
+
+     subroutine p2(f, a1, a2, a3, a4) bind(c, name='printf') ! { dg-error "collides" }
+       import :: c_ptr, c_int, c_double
+       type(c_ptr), value :: f
+       real(c_double), value :: a1, a3
+       integer(c_int), value :: a2, a4
+     end subroutine p2
+  end interface
+
+  type(c_ptr) :: f_ptr
+  character(len=20), target :: format
+
+  f_ptr = c_loc(format(1:1))
+
+  format = 'Hello %d %f %d %f\n' // char(0)
+  call p1(f_ptr, 10, 1.23d0, 20, 2.46d0)
+
+  format = 'World %f %d %f %d\n' // char(0)
+  call p2(f_ptr, 1.23d0, 10, 2.46d0, 20)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03
new file mode 100644
index 000000000..5a0767d87
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03
@@ -0,0 +1,24 @@
+! { dg-do compile }
+module A
+  use, intrinsic :: iso_c_binding
+contains
+  subroutine pA() bind(c, name='printf') ! { dg-error "collides" }
+    print *, 'hello from pA'
+  end subroutine pA
+end module A
+
+module B
+  use, intrinsic :: iso_c_binding
+
+contains
+  subroutine pB() bind(c, name='printf') ! { dg-error "collides" }
+    print *, 'hello from pB'
+  end subroutine pB
+end module B
+
+module C
+use A
+use B ! { dg-error "Can't open module file" }
+end module C
+
+
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_5.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_5.f03
new file mode 100644
index 000000000..c8aa4e862
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_5.f03
@@ -0,0 +1,12 @@
+! { dg-do compile }
+module binding_label_tests_5
+  use, intrinsic :: iso_c_binding
+  
+  interface
+     subroutine sub0() bind(c, name='c_sub') ! { dg-error "collides" }
+     end subroutine sub0
+     
+     subroutine sub1() bind(c, name='c_sub') ! { dg-error "collides" }
+     end subroutine sub1
+  end interface
+end module binding_label_tests_5
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03
new file mode 100644
index 000000000..0784de12e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03
@@ -0,0 +1,6 @@
+! { dg-do compile }
+module binding_label_tests_6
+  use, intrinsic :: iso_c_binding
+  integer(c_int), bind(c, name='my_int') :: my_f90_int_1 ! { dg-error "collides" }
+  integer(c_int), bind(c, name='my_int') :: my_f90_int_2 ! { dg-error "collides" }
+end module binding_label_tests_6
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_7.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_7.f03
new file mode 100644
index 000000000..1234bb535
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_7.f03
@@ -0,0 +1,15 @@
+! { dg-do compile }
+module A
+  use, intrinsic :: iso_c_binding, only: c_int
+  integer(c_int), bind(c, name='my_c_print') :: my_int ! { dg-error "collides" }
+end module A
+
+program main
+use A
+interface
+   subroutine my_c_print() bind(c) ! { dg-error "collides" }
+   end subroutine my_c_print
+end interface
+
+call my_c_print()
+end program main
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_8.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_8.f03
new file mode 100644
index 000000000..c49ee6254
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_8.f03
@@ -0,0 +1,9 @@
+! { dg-do compile }
+module binding_label_tests_8
+  use, intrinsic :: iso_c_binding, only: c_int
+  integer(c_int), bind(c, name='my_f90_sub') :: my_c_int ! { dg-error "collides" }
+
+contains
+  subroutine my_f90_sub() bind(c) ! { dg-error "collides" }
+  end subroutine my_f90_sub
+end module binding_label_tests_8
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_9.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_9.f03
new file mode 100644
index 000000000..cdf1ef880
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_9.f03
@@ -0,0 +1,23 @@
+! { dg-do compile }
+module x
+  use iso_c_binding
+  implicit none
+  private :: bar
+  private :: my_private_sub
+  private :: my_private_sub_2
+  public :: my_public_sub
+contains
+  subroutine bar() bind(c,name="foo") ! { dg-warning "PRIVATE but has been given the binding label" }
+  end subroutine bar
+  
+  subroutine my_private_sub() bind(c, name="")
+  end subroutine my_private_sub
+
+  subroutine my_private_sub_2() bind(c) ! { dg-warning "PRIVATE but has been given the binding label" }
+  end subroutine my_private_sub_2
+
+  subroutine my_public_sub() bind(c, name="my_sub")
+  end subroutine my_public_sub
+end module x
+
+! { dg-final { cleanup-modules "x" } }
diff --git a/gcc/testsuite/gfortran.dg/bit_comparison_1.F90 b/gcc/testsuite/gfortran.dg/bit_comparison_1.F90
new file mode 100644
index 000000000..97b00b5be
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bit_comparison_1.F90
@@ -0,0 +1,153 @@
+! Test the BGE, BGT, BLE and BLT intrinsics.
+!
+! { dg-do run }
+! { dg-options "-ffree-line-length-none" }
+
+  interface run_bge
+    procedure run_bge1
+    procedure run_bge2
+    procedure run_bge4
+    procedure run_bge8
+  end interface
+
+  interface run_bgt
+    procedure run_bgt1
+    procedure run_bgt2
+    procedure run_bgt4
+    procedure run_bgt8
+  end interface
+
+  interface run_ble
+    procedure run_ble1
+    procedure run_ble2
+    procedure run_ble4
+    procedure run_ble8
+  end interface
+
+  interface run_blt
+    procedure run_blt1
+    procedure run_blt2
+    procedure run_blt4
+    procedure run_blt8
+  end interface
+
+#define CHECK(I,J,RES) \
+  if (bge(I,J) .neqv. RES) call abort ; \
+  if (run_bge(I,J) .neqv. RES) call abort ; \
+  if (bgt(I,J) .neqv. (RES .and. (I/=J))) call abort ; \
+  if (run_bgt(I,J) .neqv. (RES .and. (I/=J))) call abort ; \
+  if (ble(J,I) .neqv. RES) call abort ; \
+  if (run_ble(J,I) .neqv. RES) call abort ; \
+  if (blt(J,I) .neqv. (RES .and. (I/=J))) call abort ; \
+  if (run_blt(J,I) .neqv. (RES .and. (I/=J))) call abort
+
+#define T .true.
+#define F .false.
+
+  CHECK(0_1, 0_1, T)
+  CHECK(1_1, 0_1, T)
+  CHECK(0_1, 107_1, F)
+  CHECK(5_1, huge(0_1) / 2_1, F)
+  CHECK(5_1, huge(0_1), F)
+  CHECK(-1_1, 0_1, T)
+  CHECK(0_1, -19_1, F)
+  CHECK(huge(0_1), -19_1, F)
+
+  CHECK(0_2, 0_2, T)
+  CHECK(1_2, 0_2, T)
+  CHECK(0_2, 107_2, F)
+  CHECK(5_2, huge(0_2) / 2_2, F)
+  CHECK(5_2, huge(0_2), F)
+  CHECK(-1_2, 0_2, T)
+  CHECK(0_2, -19_2, F)
+  CHECK(huge(0_2), -19_2, F)
+
+  CHECK(0_4, 0_4, T)
+  CHECK(1_4, 0_4, T)
+  CHECK(0_4, 107_4, F)
+  CHECK(5_4, huge(0_4) / 2_4, F)
+  CHECK(5_4, huge(0_4), F)
+  CHECK(-1_4, 0_4, T)
+  CHECK(0_4, -19_4, F)
+  CHECK(huge(0_4), -19_4, F)
+
+  CHECK(0_8, 0_8, T)
+  CHECK(1_8, 0_8, T)
+  CHECK(0_8, 107_8, F)
+  CHECK(5_8, huge(0_8) / 2_8, F)
+  CHECK(5_8, huge(0_8), F)
+  CHECK(-1_8, 0_8, T)
+  CHECK(0_8, -19_8, F)
+  CHECK(huge(0_8), -19_8, F)
+
+contains
+
+  pure logical function run_bge1 (i, j) result(res)
+    integer(kind=1), intent(in) :: i, j
+    res = bge(i,j)
+  end function
+  pure logical function run_bgt1 (i, j) result(res)
+    integer(kind=1), intent(in) :: i, j
+    res = bgt(i,j)
+  end function
+  pure logical function run_ble1 (i, j) result(res)
+    integer(kind=1), intent(in) :: i, j
+    res = ble(i,j)
+  end function
+  pure logical function run_blt1 (i, j) result(res)
+    integer(kind=1), intent(in) :: i, j
+    res = blt(i,j)
+  end function
+
+  pure logical function run_bge2 (i, j) result(res)
+    integer(kind=2), intent(in) :: i, j
+    res = bge(i,j)
+  end function
+  pure logical function run_bgt2 (i, j) result(res)
+    integer(kind=2), intent(in) :: i, j
+    res = bgt(i,j)
+  end function
+  pure logical function run_ble2 (i, j) result(res)
+    integer(kind=2), intent(in) :: i, j
+    res = ble(i,j)
+  end function
+  pure logical function run_blt2 (i, j) result(res)
+    integer(kind=2), intent(in) :: i, j
+    res = blt(i,j)
+  end function
+
+  pure logical function run_bge4 (i, j) result(res)
+    integer(kind=4), intent(in) :: i, j
+    res = bge(i,j)
+  end function
+  pure logical function run_bgt4 (i, j) result(res)
+    integer(kind=4), intent(in) :: i, j
+    res = bgt(i,j)
+  end function
+  pure logical function run_ble4 (i, j) result(res)
+    integer(kind=4), intent(in) :: i, j
+    res = ble(i,j)
+  end function
+  pure logical function run_blt4 (i, j) result(res)
+    integer(kind=4), intent(in) :: i, j
+    res = blt(i,j)
+  end function
+
+  pure logical function run_bge8 (i, j) result(res)
+    integer(kind=8), intent(in) :: i, j
+    res = bge(i,j)
+  end function
+  pure logical function run_bgt8 (i, j) result(res)
+    integer(kind=8), intent(in) :: i, j
+    res = bgt(i,j)
+  end function
+  pure logical function run_ble8 (i, j) result(res)
+    integer(kind=8), intent(in) :: i, j
+    res = ble(i,j)
+  end function
+  pure logical function run_blt8 (i, j) result(res)
+    integer(kind=8), intent(in) :: i, j
+    res = blt(i,j)
+  end function
+
+end
diff --git a/gcc/testsuite/gfortran.dg/bit_comparison_2.F90 b/gcc/testsuite/gfortran.dg/bit_comparison_2.F90
new file mode 100644
index 000000000..73d0679d0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bit_comparison_2.F90
@@ -0,0 +1,48 @@
+! Test the BGE, BGT, BLE and BLT intrinsics.
+!
+! { dg-do run }
+! { dg-options "-ffree-line-length-none" }
+! { dg-require-effective-target fortran_integer_16 }
+
+#define CHECK(I,J,RES) \
+  if (bge(I,J) .neqv. RES) call abort ; \
+  if (run_bge(I,J) .neqv. RES) call abort ; \
+  if (bgt(I,J) .neqv. (RES .and. (I/=J))) call abort ; \
+  if (run_bgt(I,J) .neqv. (RES .and. (I/=J))) call abort ; \
+  if (ble(J,I) .neqv. RES) call abort ; \
+  if (run_ble(J,I) .neqv. RES) call abort ; \
+  if (blt(J,I) .neqv. (RES .and. (I/=J))) call abort ; \
+  if (run_blt(J,I) .neqv. (RES .and. (I/=J))) call abort
+
+#define T .true.
+#define F .false.
+
+  CHECK(0_16, 0_16, T)
+  CHECK(1_16, 0_16, T)
+  CHECK(0_16, 107_16, F)
+  CHECK(5_16, huge(0_16) / 2_16, F)
+  CHECK(5_16, huge(0_16), F)
+  CHECK(-1_16, 0_16, T)
+  CHECK(0_16, -19_16, F)
+  CHECK(huge(0_16), -19_16, F)
+
+contains
+
+  pure logical function run_bge (i, j) result(res)
+    integer(kind=16), intent(in) :: i, j
+    res = bge(i,j)
+  end function
+  pure logical function run_bgt (i, j) result(res)
+    integer(kind=16), intent(in) :: i, j
+    res = bgt(i,j)
+  end function
+  pure logical function run_ble (i, j) result(res)
+    integer(kind=16), intent(in) :: i, j
+    res = ble(i,j)
+  end function
+  pure logical function run_blt (i, j) result(res)
+    integer(kind=16), intent(in) :: i, j
+    res = blt(i,j)
+  end function
+
+end
diff --git a/gcc/testsuite/gfortran.dg/block_1.f08 b/gcc/testsuite/gfortran.dg/block_1.f08
new file mode 100644
index 000000000..a2a67bc29
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/block_1.f08
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+
+! Basic Fortran 2008 BLOCK construct test.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER :: i
+
+  i = 42
+
+  ! Empty block.
+  BLOCK
+  END BLOCK
+
+  ! Block without local variables but name.
+  BLOCK
+    IF (i /= 42) CALL abort ()
+    i = 5
+  END BLOCK
+  IF (i /= 5) CALL abort ()
+
+  ! Named block with local variable and nested block.
+  myblock: BLOCK
+    INTEGER :: i
+    i = -1
+    BLOCK
+      IF (i /= -1) CALL abort ()
+      i = -2
+    END BLOCK
+    IF (i /= -2) CALL abort ()
+  END BLOCK myblock ! Matching end-label.
+  IF (i /= 5) CALL abort ()
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/block_12.f90 b/gcc/testsuite/gfortran.dg/block_12.f90
new file mode 100644
index 000000000..a7e9c1043
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/block_12.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! PR 50627 - this used to free a namespace twice.
+program main
+  block
+end program main ! { dg-error "END BLOCK" }
+! { dg-prune-output "Unexpected end of file" }
diff --git a/gcc/testsuite/gfortran.dg/block_2.f08 b/gcc/testsuite/gfortran.dg/block_2.f08
new file mode 100644
index 000000000..484b6ce72
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/block_2.f08
@@ -0,0 +1,39 @@
+! { dg-do run }
+! { dg-options "-std=f2008 -fall-intrinsics -fdump-tree-original" }
+
+! More sophisticated BLOCK runtime checks for correct initialization/clean-up.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER :: n
+
+  n = 5
+
+  myblock: BLOCK
+    INTEGER :: arr(n)
+    IF (SIZE (arr) /= 5) CALL abort ()
+    BLOCK
+      INTEGER :: arr(2*n)
+      IF (SIZE (arr) /= 10) CALL abort ()
+    END BLOCK
+    IF (SIZE (arr) /= 5) CALL abort ()
+  END BLOCK myblock
+
+  BLOCK
+    INTEGER, ALLOCATABLE :: alloc_arr(:)
+    IF (ALLOCATED (alloc_arr)) CALL abort ()
+    ALLOCATE (alloc_arr(n))
+    IF (SIZE (alloc_arr) /= 5) CALL abort ()
+    ! Should be free'ed here (but at least somewhere), this is checked
+    ! with pattern below.
+  END BLOCK
+
+  BLOCK
+    CHARACTER(LEN=n) :: str
+    IF (LEN (str) /= 5) CALL abort ()
+    str = "123456789"
+    IF (str /= "12345") CALL abort ()
+  END BLOCK
+END PROGRAM main
+! { dg-final { scan-tree-dump-times "free \\(\\(void \\*\\) alloc_arr\\.data" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/block_3.f90 b/gcc/testsuite/gfortran.dg/block_3.f90
new file mode 100644
index 000000000..224262829
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/block_3.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! BLOCK should be rejected without F2008.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  BLOCK ! { dg-error "Fortran 2008" }
+    INTEGER :: i
+  END BLOCK
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/block_4.f08 b/gcc/testsuite/gfortran.dg/block_4.f08
new file mode 100644
index 000000000..4c63194c8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/block_4.f08
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+
+! Check for label mismatch errors with BLOCK statements.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  BLOCK 
+  END BLOCK wrongname ! { dg-error "Syntax error" }
+
+  myname: BLOCK
+  END BLOCK wrongname ! { dg-error "Expected label 'myname'" }
+
+  myname2: BLOCK
+  END BLOCK ! { dg-error "Expected block name of 'myname2'" }
+END PROGRAM main ! { dg-error "Expecting END BLOCK" }
+! { dg-excess-errors "Unexpected end of file" }
diff --git a/gcc/testsuite/gfortran.dg/block_5.f08 b/gcc/testsuite/gfortran.dg/block_5.f08
new file mode 100644
index 000000000..46de78dd0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/block_5.f08
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+! We want to check for statement functions, thus legacy mode.
+
+! Check for errors with declarations not allowed within BLOCK.
+
+SUBROUTINE proc (a)
+  IMPLICIT NONE
+  INTEGER :: a
+
+  BLOCK
+    INTENT(IN) :: a ! { dg-error "not allowed inside of BLOCK" }
+    VALUE :: a ! { dg-error "not allowed inside of BLOCK" }
+    OPTIONAL :: a ! { dg-error "not allowed inside of BLOCK" }
+  END BLOCK
+END SUBROUTINE proc
+
+PROGRAM main
+  IMPLICIT NONE
+
+  BLOCK 
+    IMPLICIT INTEGER(a-z) ! { dg-error "not allowed inside of BLOCK" }
+    INTEGER :: a, b, c, d
+    INTEGER :: stfunc
+    stfunc(a, b) = a + b ! { dg-error "not allowed inside of BLOCK" }
+    EQUIVALENCE (a, b) ! { dg-error "not allowed inside of BLOCK" }
+    NAMELIST /NLIST/ a, b ! { dg-error "not allowed inside of BLOCK" }
+    COMMON /CBLOCK/ c, d ! { dg-error "not allowed inside of BLOCK" }
+  ! This contains is in the specification part.
+  CONTAINS ! { dg-error "Unexpected CONTAINS statement" }
+  END BLOCK
+
+  BLOCK
+    PRINT *, "Hello, world"
+  ! This one in the executable statement part.
+  CONTAINS ! { dg-error "Unexpected CONTAINS statement" }
+  END BLOCK
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/block_6.f08 b/gcc/testsuite/gfortran.dg/block_6.f08
new file mode 100644
index 000000000..621a93304
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/block_6.f08
@@ -0,0 +1,17 @@
+! { dg-do run { xfail *-*-* } }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+
+! Check for correct scope of variables that are implicit typed within a BLOCK.
+! This is not yet implemented, thus XFAIL'ed the test.
+
+PROGRAM main
+  IMPLICIT INTEGER(a-z)
+
+  BLOCK
+    ! a gets implicitly typed, but scope should not be limited to BLOCK.
+    a = 42
+  END BLOCK
+
+  ! Here, we should still access the same a that was set above.
+  IF (a /= 42) CALL abort ()
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/block_7.f08 b/gcc/testsuite/gfortran.dg/block_7.f08
new file mode 100644
index 000000000..3a267edc3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/block_7.f08
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+
+! Check for correct placement (on the stack) of local variables with BLOCK
+! and recursive container procedures.
+
+RECURSIVE SUBROUTINE myproc (i)
+  INTEGER, INTENT(IN) :: i
+  ! Wrap the block up in some other construct so we see this doesn't mess
+  ! things up, either.
+  DO
+    BLOCK
+      INTEGER :: x
+      x = i
+      IF (i > 0) CALL myproc (i - 1)
+      IF (x /= i) CALL abort ()
+    END BLOCK
+    EXIT
+  END DO
+END SUBROUTINE myproc
+
+PROGRAM main
+  CALL myproc (42)
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/block_8.f08 b/gcc/testsuite/gfortran.dg/block_8.f08
new file mode 100644
index 000000000..6059fa89c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/block_8.f08
@@ -0,0 +1,17 @@
+! { dg-do run }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+
+! Check BLOCK with SAVE'ed variables.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER :: i
+
+  DO i = 1, 100
+    BLOCK
+      INTEGER, SAVE :: summed = 0
+      summed = summed + i
+      IF (i == 100 .AND. summed /= 5050) CALL abort ()
+    END BLOCK
+  END DO
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/block_9.f08 b/gcc/testsuite/gfortran.dg/block_9.f08
new file mode 100644
index 000000000..277d1e224
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/block_9.f08
@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+! PR 46849: [OOP] MODULE PROCEDURE resolution does not work in BLOCK or SELECT TYPE
+!
+! Contributed by Reinhold Bader <bader@lrz.de>
+
+  implicit none
+
+  block
+    call init(fun)
+  end block
+
+contains
+
+  subroutine init(func)
+    real, external :: func
+  end subroutine
+
+  real function fun()
+    fun = 1.1
+  end function
+
+end
diff --git a/gcc/testsuite/gfortran.dg/block_name_1.f90 b/gcc/testsuite/gfortran.dg/block_name_1.f90
new file mode 100644
index 000000000..600885c3a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/block_name_1.f90
@@ -0,0 +1,78 @@
+! { dg-do compile }
+! Verify that the compiler accepts the various legal combinations of
+! using construct names.
+!
+! The correct behavior of EXIT and CYCLE is already established in
+! the various DO related testcases, they're included here for
+! completeness.
+       dimension a(5)
+       i = 0
+       ! construct name is optional on else clauses
+       ia: if (i > 0) then
+          i = 1
+       else
+          i = 2
+       end if ia
+       ib: if (i < 0) then
+          i = 3
+       else ib
+          i = 4
+       end if ib
+       ic: if (i < 0) then
+          i = 5
+       else if (i == 0) then ic
+          i = 6
+       else if (i == 1) then
+          i =7
+       else if (i == 2) then ic
+          i = 8
+       end if ic
+
+       fa: forall (i=1:5, a(i) > 0)
+          a(i) = 9
+       end forall fa
+
+       wa: where (a > 0)
+          a = -a
+       elsewhere
+          wb: where (a == 0)
+             a = a + 1.
+          elsewhere wb
+             a = 2*a
+          end where wb
+       end where wa
+
+       j = 1
+       sa: select case (i)
+          case (1)
+             i = 2
+          case (2) sa
+             i = 3
+          case default sa
+             sb: select case (j)
+                case (1) sb
+                   i = j
+                case default
+                   j = i
+             end select sb
+       end select sa
+
+       da: do i=1,10
+          cycle da
+          cycle
+          exit da
+          exit
+          db: do
+             cycle da
+             cycle db
+             cycle
+             exit da
+             exit db
+             exit
+             j = i+1
+          end do db
+          dc: do while (j>0)
+             j = j-1
+          end do dc
+       end do da
+end
diff --git a/gcc/testsuite/gfortran.dg/block_name_2.f90 b/gcc/testsuite/gfortran.dg/block_name_2.f90
new file mode 100644
index 000000000..d86e77e7a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/block_name_2.f90
@@ -0,0 +1,60 @@
+! { dg-do compile }
+! Test that various illegal combinations of block statements with
+! block names yield the correct error messages.  Motivated by PR31471.
+program blocks
+  dimension a(5,2)
+
+  a = 0
+
+  ! The END statement of a labelled block needs to carry the construct
+  ! name.
+  d1: do i=1,10
+  end do      ! { dg-error "Expected block name of .... in END DO statement" }
+  end do d1
+
+  i1: if (i > 0) then
+  end if      ! { dg-error "Expected block name of .... in END IF statement" }
+  end if i1
+
+  s1: select case (i)
+  end select ! { dg-error "Expected block name of .... in END SELECT statement" }
+  end select s1
+
+  w1: where (a > 0)
+  end where ! { dg-error "Expected block name of .... in END WHERE statement" }
+  end where w1
+
+  f1: forall (i = 1:10)
+  end forall ! { dg-error "Expected block name of .... in END FORALL statement" }
+  end forall f1
+
+  ! A construct name may not appear in the END statement, if it
+  ! doesn't appear in the statement beginning the block.
+  ! Likewise it may not appear in ELSE IF, ELSE, ELSEWHERE or CASE
+  ! statements.
+  do i=1,10
+  end do d2 ! { dg-error "Syntax error in END DO statement" }
+  end do
+
+  if (i > 0) then
+  else if (i ==0) then i2 ! { dg-error "Unexpected junk after ELSE IF statement" }
+  else i2 ! { dg-error "Unexpected junk after ELSE statement" }
+  end if i2 ! { dg-error "Syntax error in END IF statement" }
+  end if
+
+  select case (i)
+  case (1) s2  ! { dg-error "Syntax error in CASE specification" }
+  case default s2 ! { dg-error "Syntax error in CASE specification" }
+  end select s2 ! { dg-error "Syntax error in END SELECT statement" }
+  end select
+
+  where (a > 0)
+  elsewhere w2  ! { dg-error "Unexpected junk after ELSE statement" }
+  end where w2 ! { dg-error "Syntax error in END WHERE statement" }
+  end where
+
+  forall (i=1:10)
+  end forall f2 ! { dg-error "Syntax error in END FORALL statement" }
+  end forall
+  
+end program blocks
diff --git a/gcc/testsuite/gfortran.dg/blockdata_1.f90 b/gcc/testsuite/gfortran.dg/blockdata_1.f90
new file mode 100644
index 000000000..74910c4d4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/blockdata_1.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! tests basic block data functionality
+! we didn't allow multiple block data program units
+block data 
+ common /a/ y(3)
+ data y /3*1./
+end
+
+blockdata d1
+ common /a/ w(3)
+ common /b/ u
+ data u /1./
+end blockdata d1
+
+block data d2
+ common /b/ u
+ common j ! { dg-warning "blank COMMON but initialization is only allowed in named common" }
+ data j /1/
+end block data d2
+!
+! begin testing code
+common /a/ x(3)
+common /b/ y
+common i
+
+if (any(x /= 1.)) call abort ()
+if (y /= 1. .or. i /= 1) call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/blockdata_2.f90 b/gcc/testsuite/gfortran.dg/blockdata_2.f90
new file mode 100644
index 000000000..b4badbaf7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/blockdata_2.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! Test for pr29537 where we did ICE trying to dereference the NULL
+! proc_name from an unnamed block data which we intended to use as locus
+! for a blank common.
+block data
+  common c
+end !block data
+end
diff --git a/gcc/testsuite/gfortran.dg/blockdata_3.f90 b/gcc/testsuite/gfortran.dg/blockdata_3.f90
new file mode 100644
index 000000000..8d1a84da0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/blockdata_3.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-options "-W -Wall" }
+! Tests the fix for PR29539, in which the derived type in a blockdata
+! cause an ICE.  With the fix for PR29565, this now compiles and runs
+! correctly.
+!
+! Contributed by Bernhard Fischer  <aldot@gcc.gnu.org>
+!
+block data
+  common /c/ d(5), cc
+  type c_t
+    sequence
+    integer i
+  end type c_t
+  type (c_t) :: cc
+  data d /5*1./
+  data cc%i /5/
+end
+
+  common /c/ d(5), cc
+  type c_t
+    sequence
+    integer i
+  end type c_t
+  type (c_t) :: cc
+  print *, d
+  print *, cc
+end
diff --git a/gcc/testsuite/gfortran.dg/blockdata_4.f90 b/gcc/testsuite/gfortran.dg/blockdata_4.f90
new file mode 100644
index 000000000..5cf3d1f42
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/blockdata_4.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-std=gnu" }
+! PR33152 Initialization/declaration problems in block data
+! Test case prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+blockdata bab
+ character(len=3) :: myname(2)=(/'bar','baz'/)
+ common/nmstr/myname
+end blockdata bab
+
+blockdata thdinit 
+ implicit none 
+ integer, parameter :: nmin=2 
+ common/onestr/emname 
+ character(len=3) :: emname(nmin) = (/'bar','baz'/) 
+end blockdata thdinit
+
+blockdata fooinit 
+ implicit none 
+ integer, parameter :: nmin=2 
+ common/twostr/aname 
+ data aname/'bar','baz'/ ! { dg-error "DATA array" }
+ character(len=3) :: aname(nmin)
+end blockdata fooinit
+
+end
diff --git a/gcc/testsuite/gfortran.dg/blockdata_5.f90 b/gcc/testsuite/gfortran.dg/blockdata_5.f90
new file mode 100644
index 000000000..03e667ce9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/blockdata_5.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! PR34227 Initialized symbol in COMMON: Missing checks
+program main
+ implicit none
+ integer, parameter:: nmin = 2
+ character(len=3) :: emname(nmin)=(/'bar','baz'/)
+ common/nmstr/emname ! { dg-error "can only be COMMON in BLOCK DATA" } 
+end program main
+
diff --git a/gcc/testsuite/gfortran.dg/blockdata_6.f90 b/gcc/testsuite/gfortran.dg/blockdata_6.f90
new file mode 100644
index 000000000..19bb6181c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/blockdata_6.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! PR34227 Initialized symbol in COMMON: Missing checks
+program main
+ implicit none
+ integer, parameter:: nmin = 2
+ character(len=3) :: emname(nmin)
+ data emname/'bar','baz'/
+ common/dd/emname ! { dg-error "can only be COMMON in BLOCK DATA" }
+end program main
diff --git a/gcc/testsuite/gfortran.dg/bom_UTF-32.f90 b/gcc/testsuite/gfortran.dg/bom_UTF-32.f90
new file mode 100644
index 000000000..d42430313
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bom_UTF-32.f90
diff --git a/gcc/testsuite/gfortran.dg/bom_UTF-8.f90 b/gcc/testsuite/gfortran.dg/bom_UTF-8.f90
new file mode 100644
index 000000000..f9d9e88d4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bom_UTF-8.f90
@@ -0,0 +1,3 @@
+print *, "Hello world"

+end

+! { dg-do compile }

diff --git a/gcc/testsuite/gfortran.dg/bom_UTF-8_F.F90 b/gcc/testsuite/gfortran.dg/bom_UTF-8_F.F90
new file mode 100644
index 000000000..f9d9e88d4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bom_UTF-8_F.F90
@@ -0,0 +1,3 @@
+print *, "Hello world"

+end

+! { dg-do compile }

diff --git a/gcc/testsuite/gfortran.dg/bom_UTF16-BE.f90 b/gcc/testsuite/gfortran.dg/bom_UTF16-BE.f90
new file mode 100644
index 000000000..f590e71f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bom_UTF16-BE.f90
diff --git a/gcc/testsuite/gfortran.dg/bom_UTF16-LE.f90 b/gcc/testsuite/gfortran.dg/bom_UTF16-LE.f90
new file mode 100644
index 000000000..29e7ca682
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bom_UTF16-LE.f90
diff --git a/gcc/testsuite/gfortran.dg/bom_error.f90 b/gcc/testsuite/gfortran.dg/bom_error.f90
new file mode 100644
index 000000000..142d7509e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bom_error.f90
@@ -0,0 +1,4 @@
+ÿþprint *, "Hello world!"
+ÿþend ! { dg-error "Invalid character" }
+! { dg-do compile }
+! { dg-error "Unexpected end of file" "" { target "*-*-*" } 0 }
diff --git a/gcc/testsuite/gfortran.dg/bom_include.f90 b/gcc/testsuite/gfortran.dg/bom_include.f90
new file mode 100644
index 000000000..65a289803
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bom_include.f90
@@ -0,0 +1,2 @@
+! { dg-do compile }
+include "bom_include.inc"
diff --git a/gcc/testsuite/gfortran.dg/bom_include.inc b/gcc/testsuite/gfortran.dg/bom_include.inc
new file mode 100644
index 000000000..b30290103
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bom_include.inc
@@ -0,0 +1,2 @@
+print *, "Hello world!"
+end
diff --git a/gcc/testsuite/gfortran.dg/bound_1.f90 b/gcc/testsuite/gfortran.dg/bound_1.f90
new file mode 100644
index 000000000..ce872bb0a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bound_1.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+  implicit none
+
+  type test_type
+    integer, dimension(5) :: a
+  end type test_type
+
+  type (test_type), target :: tt(2)
+  integer i
+
+  i = ubound(tt(1)%a, 1)
+  if (i/=5) call abort()
+  i = lbound(tt(1)%a, 1)
+  if (i/=1) call abort()
+
+  i = ubound(tt, 1)
+  if (i/=2) call abort()
+  i = lbound(tt, 1)
+  if (i/=1) call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/bound_2.f90 b/gcc/testsuite/gfortran.dg/bound_2.f90
new file mode 100644
index 000000000..3b99a1f54
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bound_2.f90
@@ -0,0 +1,219 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+! PR fortran/29391
+! This file is here to check that LBOUND and UBOUND return correct values
+!
+! Contributed by Francois-Xavier Coudert (coudert@clipper.ens.fr)
+  implicit none
+  integer :: i(-1:1,-1:1) = 0
+  integer :: j(-1:2) = 0
+  integer :: u(7,4,2,9)
+
+  call foo(u,4)
+  call jackal(-1,-8)
+  call jackal(-1,8)
+
+  if (any(lbound(i(-1:1,-1:1)) /= 1)) call abort
+  if (lbound(i(-1:1,-1:1), 1) /= 1) call abort
+  if (lbound(i(-1:1,-1:1), 2) /= 1) call abort
+
+  if (any(ubound(i(-1:1,-1:1)) /= 3)) call abort
+  if (ubound(i(-1:1,-1:1), 1) /= 3) call abort
+  if (ubound(i(-1:1,-1:1), 2) /= 3) call abort
+
+  if (any(lbound(i(:,:)) /= 1)) call abort
+  if (lbound(i(:,:), 1) /= 1) call abort
+  if (lbound(i(:,:), 2) /= 1) call abort
+
+  if (any(ubound(i(:,:)) /= 3)) call abort
+  if (ubound(i(:,:), 1) /= 3) call abort
+  if (ubound(i(:,:), 2) /= 3) call abort
+
+  if (any(lbound(i(0:,-1:)) /= 1)) call abort
+  if (lbound(i(0:,-1:), 1) /= 1) call abort
+  if (lbound(i(0:,-1:), 2) /= 1) call abort
+
+  if (any(ubound(i(0:,-1:)) /= [2,3])) call abort
+  if (ubound(i(0:,-1:), 1) /= 2) call abort
+  if (ubound(i(0:,-1:), 2) /= 3) call abort
+
+  if (any(lbound(i(:0,:0)) /= 1)) call abort
+  if (lbound(i(:0,:0), 1) /= 1) call abort
+  if (lbound(i(:0,:0), 2) /= 1) call abort
+
+  if (any(ubound(i(:0,:0)) /= 2)) call abort
+  if (ubound(i(:0,:0), 1) /= 2) call abort
+  if (ubound(i(:0,:0), 2) /= 2) call abort
+
+  if (any(lbound(transpose(i)) /= 1)) call abort
+  if (lbound(transpose(i), 1) /= 1) call abort
+  if (lbound(transpose(i), 2) /= 1) call abort
+
+  if (any(ubound(transpose(i)) /= 3)) call abort
+  if (ubound(transpose(i), 1) /= 3) call abort
+  if (ubound(transpose(i), 2) /= 3) call abort
+
+  if (any(lbound(reshape(i,[2,2])) /= 1)) call abort
+  if (lbound(reshape(i,[2,2]), 1) /= 1) call abort
+  if (lbound(reshape(i,[2,2]), 2) /= 1) call abort
+
+  if (any(ubound(reshape(i,[2,2])) /= 2)) call abort
+  if (ubound(reshape(i,[2,2]), 1) /= 2) call abort
+  if (ubound(reshape(i,[2,2]), 2) /= 2) call abort
+
+  if (any(lbound(cshift(i,-1)) /= 1)) call abort
+  if (lbound(cshift(i,-1), 1) /= 1) call abort
+  if (lbound(cshift(i,-1), 2) /= 1) call abort
+
+  if (any(ubound(cshift(i,-1)) /= 3)) call abort
+  if (ubound(cshift(i,-1), 1) /= 3) call abort
+  if (ubound(cshift(i,-1), 2) /= 3) call abort
+
+  if (any(lbound(eoshift(i,-1)) /= 1)) call abort
+  if (lbound(eoshift(i,-1), 1) /= 1) call abort
+  if (lbound(eoshift(i,-1), 2) /= 1) call abort
+
+  if (any(ubound(eoshift(i,-1)) /= 3)) call abort
+  if (ubound(eoshift(i,-1), 1) /= 3) call abort
+  if (ubound(eoshift(i,-1), 2) /= 3) call abort
+
+  if (any(lbound(spread(i,1,2)) /= 1)) call abort
+  if (lbound(spread(i,1,2), 1) /= 1) call abort
+  if (lbound(spread(i,1,2), 2) /= 1) call abort
+
+  if (any(ubound(spread(i,1,2)) /= [2,3,3])) call abort
+  if (ubound(spread(i,1,2), 1) /= 2) call abort
+  if (ubound(spread(i,1,2), 2) /= 3) call abort
+  if (ubound(spread(i,1,2), 3) /= 3) call abort
+
+  if (any(lbound(maxloc(i)) /= 1)) call abort
+  if (lbound(maxloc(i), 1) /= 1) call abort
+
+  if (any(ubound(maxloc(i)) /= 2)) call abort
+  if (ubound(maxloc(i), 1) /= 2) call abort
+
+  if (any(lbound(minloc(i)) /= 1)) call abort
+  if (lbound(minloc(i), 1) /= 1) call abort
+
+  if (any(ubound(minloc(i)) /= 2)) call abort
+  if (ubound(minloc(i), 1) /= 2) call abort
+
+  if (any(lbound(maxval(i,2)) /= 1)) call abort
+  if (lbound(maxval(i,2), 1) /= 1) call abort
+
+  if (any(ubound(maxval(i,2)) /= 3)) call abort
+  if (ubound(maxval(i,2), 1) /= 3) call abort
+
+  if (any(lbound(minval(i,2)) /= 1)) call abort
+  if (lbound(minval(i,2), 1) /= 1) call abort
+
+  if (any(ubound(minval(i,2)) /= 3)) call abort
+  if (ubound(minval(i,2), 1) /= 3) call abort
+
+  if (any(lbound(any(i==1,2)) /= 1)) call abort
+  if (lbound(any(i==1,2), 1) /= 1) call abort
+
+  if (any(ubound(any(i==1,2)) /= 3)) call abort
+  if (ubound(any(i==1,2), 1) /= 3) call abort
+
+  if (any(lbound(count(i==1,2)) /= 1)) call abort
+  if (lbound(count(i==1,2), 1) /= 1) call abort
+
+  if (any(ubound(count(i==1,2)) /= 3)) call abort
+  if (ubound(count(i==1,2), 1) /= 3) call abort
+
+  if (any(lbound(merge(i,i,.true.)) /= 1)) call abort
+  if (lbound(merge(i,i,.true.), 1) /= 1) call abort
+  if (lbound(merge(i,i,.true.), 2) /= 1) call abort
+
+  if (any(ubound(merge(i,i,.true.)) /= 3)) call abort
+  if (ubound(merge(i,i,.true.), 1) /= 3) call abort
+  if (ubound(merge(i,i,.true.), 2) /= 3) call abort
+
+  if (any(lbound(lbound(i)) /= 1)) call abort
+  if (lbound(lbound(i), 1) /= 1) call abort
+
+  if (any(ubound(lbound(i)) /= 2)) call abort
+  if (ubound(lbound(i), 1) /= 2) call abort
+
+  if (any(lbound(ubound(i)) /= 1)) call abort
+  if (lbound(ubound(i), 1) /= 1) call abort
+
+  if (any(ubound(ubound(i)) /= 2)) call abort
+  if (ubound(ubound(i), 1) /= 2) call abort
+
+  if (any(lbound(shape(i)) /= 1)) call abort
+  if (lbound(shape(i), 1) /= 1) call abort
+
+  if (any(ubound(shape(i)) /= 2)) call abort
+  if (ubound(shape(i), 1) /= 2) call abort
+
+  if (any(lbound(product(i,2)) /= 1)) call abort
+  if (any(ubound(product(i,2)) /= 3)) call abort
+  if (any(lbound(sum(i,2)) /= 1)) call abort
+  if (any(ubound(sum(i,2)) /= 3)) call abort
+  if (any(lbound(matmul(i,i)) /= 1)) call abort
+  if (any(ubound(matmul(i,i)) /= 3)) call abort
+  if (any(lbound(pack(i,.true.)) /= 1)) call abort
+  if (any(ubound(pack(i,.true.)) /= 9)) call abort
+  if (any(lbound(unpack(j,[.true.],[2])) /= 1)) call abort
+  if (any(ubound(unpack(j,[.true.],[2])) /= 1)) call abort
+
+  call sub1(i,3)
+  call sub1(reshape([7,9,4,6,7,9],[3,2]),3)
+  call sub2
+
+contains
+
+  subroutine sub1(a,n)
+    integer :: n, a(2:n+1,4:*)
+
+    if (any([lbound(a,1), lbound(a,2)] /= [2, 4])) call abort
+    if (any(lbound(a) /= [2, 4])) call abort
+  end subroutine sub1
+
+  subroutine sub2
+    integer :: x(3:2, 1:2)
+
+    if (size(x) /= 0) call abort
+    if (lbound (x, 1) /= 1 .or. lbound(x, 2) /= 1) call abort
+    if (any (lbound (x) /= [1, 1])) call abort
+    if (ubound (x, 1) /= 0 .or. ubound(x, 2) /= 2) call abort
+    if (any (ubound (x) /= [0, 2])) call abort
+  end subroutine sub2
+
+  subroutine sub3
+    integer :: x(4:5, 1:2)
+
+    if (size(x) /= 0) call abort
+    if (lbound (x, 1) /= 4 .or. lbound(x, 2) /= 1) call abort
+    if (any (lbound (x) /= [4, 1])) call abort
+    if (ubound (x, 1) /= 4 .or. ubound(x, 2) /= 2) call abort
+    if (any (ubound (x) /= [4, 2])) call abort
+  end subroutine sub3
+
+  subroutine foo (x,n)
+    integer :: x(7,n,2,*), n
+
+    if (ubound(x,1) /= 7 .or. ubound(x,2) /= 4 .or. ubound(x,3) /= 2) call abort
+  end subroutine foo
+
+  subroutine jackal (b, c)
+    integer :: b, c
+    integer :: soda(b:c, 3:4)
+
+    if (b > c) then
+      if (size(soda) /= 0) call abort
+      if (lbound (soda, 1) /= 1 .or. ubound (soda, 1) /= 0) call abort
+    else
+      if (size(soda) /= 2*(c-b+1)) call abort
+      if (lbound (soda, 1) /= b .or. ubound (soda, 1) /= c) call abort
+    end if
+
+    if (lbound (soda, 2) /= 3 .or. ubound (soda, 2) /= 4) call abort
+    if (any (lbound (soda) /= [lbound(soda,1), lbound(soda,2)])) call abort
+    if (any (ubound (soda) /= [ubound(soda,1), ubound(soda,2)])) call abort
+
+  end subroutine jackal
+
+end
diff --git a/gcc/testsuite/gfortran.dg/bound_3.f90 b/gcc/testsuite/gfortran.dg/bound_3.f90
new file mode 100644
index 000000000..7b1696d09
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bound_3.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+!
+  call s(1,0)
+  call s(2,0)
+  call s(3,0)
+  call s(4,0)
+  call s(5,1)
+  call s(6,2)
+  call s(7,3)
+contains
+  subroutine s(n,m)
+    implicit none
+    integer n, m
+    real x(10)
+    if (any (lbound(x(5:n)) /= 1)) call abort
+    if (lbound(x(5:n),1) /= 1) call abort
+    if (any (ubound(x(5:n)) /= m)) call abort
+    if (ubound(x(5:n),1) /= m) call abort
+  end subroutine
+end program
diff --git a/gcc/testsuite/gfortran.dg/bound_4.f90 b/gcc/testsuite/gfortran.dg/bound_4.f90
new file mode 100644
index 000000000..b63ce9ec6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bound_4.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+
+program test
+  integer x(20)
+  integer, volatile :: n
+  n = 1
+  if (size(x(n:2:-3)) /= 0) call abort
+
+  call ha0020(-3)
+  call ha0020(-1)
+end program test
+
+subroutine ha0020(mf3)
+  implicit none
+  integer xca(2), xda(2), mf3
+
+  xca = 1
+  xda = -1
+
+  xca(1:2:-1) = xda(1:2:mf3)
+
+  if (any (xca /= 1)) call abort
+  if (any(xda(1:2:mf3) /= xda(1:0))) call abort
+  if (size(xda(1:2:mf3)) /= 0) call abort
+  if (any(shape(xda(1:2:mf3)) /= 0)) call abort
+  if (any(ubound(xda(1:2:mf3)) /= 0)) call abort
+  if (ubound(xda(1:2:mf3),1) /= 0) call abort
+  if (lbound(xda(1:2:mf3),1) /= 1) call abort
+
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/bound_5.f90 b/gcc/testsuite/gfortran.dg/bound_5.f90
new file mode 100644
index 000000000..04245d6d8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bound_5.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+!
+! PR fortran/38859
+! Wrong bounds simplification
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+
+       type x
+         integer I
+       end type x
+       type (x) A(0:5, 2:8)
+       integer ida(2)
+
+       ida = lbound(a)
+       if (any(ida /= (/0,2/))) call abort
+
+       ida = lbound(a%i)
+       if (any(ida /= (/1,1/))) call abort
+
+       ida = ubound(a)
+       if (any(ida /= (/5,8/))) call abort
+       
+       ida = ubound(a%i)
+       if (any(ida /= (/6,7/))) call abort
+
+       end
diff --git a/gcc/testsuite/gfortran.dg/bound_6.f90 b/gcc/testsuite/gfortran.dg/bound_6.f90
new file mode 100644
index 000000000..5e0e3f7dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bound_6.f90
@@ -0,0 +1,71 @@
+! { dg-do run }

+! Test the fix for PR38852 and PR39006 in which LBOUND did not work

+! for some arrays with negative strides.

+!

+! Contributed by Dick Hendrickson  <dick.hendrickson@gmail.com>

+!                Clive Page        <clivegpage@googlemail.com>

+!            and Mikael Morin      <mikael.morin@tele2.fr>

+!

+program try_je0031

+  integer ida(4)

+  real dda(5,5,5,5,5)

+  integer, parameter :: nx = 4, ny = 3

+  interface

+    SUBROUTINE PR38852(IDA,DDA,nf2,nf5,mf2)

+      INTEGER IDA(4)

+      REAL DDA(5,5,5,5,5)

+      TARGET DDA

+    END SUBROUTINE

+  end interface

+  integer :: array1(nx,ny), array2(nx,ny) 

+  data array2 / 1,2,3,4, 10,20,30,40, 100,200,300,400 /

+  array1 = array2

+  call PR38852(IDA,DDA,2,5,-2)

+  call PR39006(array1, array2(:,ny:1:-1))

+  call mikael         ! http://gcc.gnu.org/ml/fortran/2009-01/msg00342.html

+contains

+  subroutine PR39006(array1, array2)

+    integer, intent(in) :: array1(:,:), array2(:,:)

+    integer :: j

+    do j = 1, ubound(array2,2)

+      if (any (array1(:,j) .ne. array2(:,4-j))) call abort

+    end do

+  end subroutine

+end 

+

+SUBROUTINE PR38852(IDA,DDA,nf2,nf5,mf2)

+  INTEGER IDA(4)

+  REAL DLA(:,:,:,:)

+  REAL DDA(5,5,5,5,5)

+  POINTER DLA

+  TARGET DDA

+  DLA => DDA(2:3, 1:3:2, 5:4:-1, NF2, NF5:NF2:MF2)

+  IDA = UBOUND(DLA)

+  if (any(ida /= 2)) call abort

+  DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2)

+  IDA = UBOUND(DLA)

+  if (any(ida /= 2)) call abort

+!

+! These worked.

+!

+  DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2)

+  IDA = shape(DLA)

+  if (any(ida /= 2)) call abort

+  DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2)

+  IDA = LBOUND(DLA)

+  if (any(ida /= 1)) call abort

+END SUBROUTINE

+

+subroutine mikael

+  implicit none

+  call test (1,  3, 3)

+  call test (2,  3, 3)

+  call test (2, -1, 0)

+  call test (1, -1, 0)

+contains

+  subroutine test (a, b, expect)

+    integer :: a, b, expect

+    integer :: c(a:b)

+    if (ubound (c, 1) .ne. expect) call abort

+  end subroutine test

+end subroutine

diff --git a/gcc/testsuite/gfortran.dg/bound_7.f90 b/gcc/testsuite/gfortran.dg/bound_7.f90
new file mode 100644
index 000000000..e422845b9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bound_7.f90
@@ -0,0 +1,223 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+! PR fortran/29391
+! This file is here to check that LBOUND and UBOUND return correct values
+!
+! Contributed by Francois-Xavier Coudert (coudert@clipper.ens.fr)
+  implicit none
+  integer, allocatable :: i(:,:), j(:), u(:,:,:,:)
+
+  allocate (i(-1:1,-1:1))
+  i = 0
+  allocate (j(-1:2))
+  j = 0
+  allocate (u(7,4,2,9))
+
+  call foo(u,4)
+  call jackal(-1,-8)
+  call jackal(-1,8)
+
+  if (any(lbound(i(-1:1,-1:1)) /= 1)) call abort
+  if (lbound(i(-1:1,-1:1), 1) /= 1) call abort
+  if (lbound(i(-1:1,-1:1), 2) /= 1) call abort
+
+  if (any(ubound(i(-1:1,-1:1)) /= 3)) call abort
+  if (ubound(i(-1:1,-1:1), 1) /= 3) call abort
+  if (ubound(i(-1:1,-1:1), 2) /= 3) call abort
+
+  if (any(lbound(i(:,:)) /= 1)) call abort
+  if (lbound(i(:,:), 1) /= 1) call abort
+  if (lbound(i(:,:), 2) /= 1) call abort
+
+  if (any(ubound(i(:,:)) /= 3)) call abort
+  if (ubound(i(:,:), 1) /= 3) call abort
+  if (ubound(i(:,:), 2) /= 3) call abort
+
+  if (any(lbound(i(0:,-1:)) /= 1)) call abort
+  if (lbound(i(0:,-1:), 1) /= 1) call abort
+  if (lbound(i(0:,-1:), 2) /= 1) call abort
+
+  if (any(ubound(i(0:,-1:)) /= [2,3])) call abort
+  if (ubound(i(0:,-1:), 1) /= 2) call abort
+  if (ubound(i(0:,-1:), 2) /= 3) call abort
+
+  if (any(lbound(i(:0,:0)) /= 1)) call abort
+  if (lbound(i(:0,:0), 1) /= 1) call abort
+  if (lbound(i(:0,:0), 2) /= 1) call abort
+
+  if (any(ubound(i(:0,:0)) /= 2)) call abort
+  if (ubound(i(:0,:0), 1) /= 2) call abort
+  if (ubound(i(:0,:0), 2) /= 2) call abort
+
+  if (any(lbound(transpose(i)) /= 1)) call abort
+  if (lbound(transpose(i), 1) /= 1) call abort
+  if (lbound(transpose(i), 2) /= 1) call abort
+
+  if (any(ubound(transpose(i)) /= 3)) call abort
+  if (ubound(transpose(i), 1) /= 3) call abort
+  if (ubound(transpose(i), 2) /= 3) call abort
+
+  if (any(lbound(reshape(i,[2,2])) /= 1)) call abort
+  if (lbound(reshape(i,[2,2]), 1) /= 1) call abort
+  if (lbound(reshape(i,[2,2]), 2) /= 1) call abort
+
+  if (any(ubound(reshape(i,[2,2])) /= 2)) call abort
+  if (ubound(reshape(i,[2,2]), 1) /= 2) call abort
+  if (ubound(reshape(i,[2,2]), 2) /= 2) call abort
+
+  if (any(lbound(cshift(i,-1)) /= 1)) call abort
+  if (lbound(cshift(i,-1), 1) /= 1) call abort
+  if (lbound(cshift(i,-1), 2) /= 1) call abort
+
+  if (any(ubound(cshift(i,-1)) /= 3)) call abort
+  if (ubound(cshift(i,-1), 1) /= 3) call abort
+  if (ubound(cshift(i,-1), 2) /= 3) call abort
+
+  if (any(lbound(eoshift(i,-1)) /= 1)) call abort
+  if (lbound(eoshift(i,-1), 1) /= 1) call abort
+  if (lbound(eoshift(i,-1), 2) /= 1) call abort
+
+  if (any(ubound(eoshift(i,-1)) /= 3)) call abort
+  if (ubound(eoshift(i,-1), 1) /= 3) call abort
+  if (ubound(eoshift(i,-1), 2) /= 3) call abort
+
+  if (any(lbound(spread(i,1,2)) /= 1)) call abort
+  if (lbound(spread(i,1,2), 1) /= 1) call abort
+  if (lbound(spread(i,1,2), 2) /= 1) call abort
+
+  if (any(ubound(spread(i,1,2)) /= [2,3,3])) call abort
+  if (ubound(spread(i,1,2), 1) /= 2) call abort
+  if (ubound(spread(i,1,2), 2) /= 3) call abort
+  if (ubound(spread(i,1,2), 3) /= 3) call abort
+
+  if (any(lbound(maxloc(i)) /= 1)) call abort
+  if (lbound(maxloc(i), 1) /= 1) call abort
+
+  if (any(ubound(maxloc(i)) /= 2)) call abort
+  if (ubound(maxloc(i), 1) /= 2) call abort
+
+  if (any(lbound(minloc(i)) /= 1)) call abort
+  if (lbound(minloc(i), 1) /= 1) call abort
+
+  if (any(ubound(minloc(i)) /= 2)) call abort
+  if (ubound(minloc(i), 1) /= 2) call abort
+
+  if (any(lbound(maxval(i,2)) /= 1)) call abort
+  if (lbound(maxval(i,2), 1) /= 1) call abort
+
+  if (any(ubound(maxval(i,2)) /= 3)) call abort
+  if (ubound(maxval(i,2), 1) /= 3) call abort
+
+  if (any(lbound(minval(i,2)) /= 1)) call abort
+  if (lbound(minval(i,2), 1) /= 1) call abort
+
+  if (any(ubound(minval(i,2)) /= 3)) call abort
+  if (ubound(minval(i,2), 1) /= 3) call abort
+
+  if (any(lbound(any(i==1,2)) /= 1)) call abort
+  if (lbound(any(i==1,2), 1) /= 1) call abort
+
+  if (any(ubound(any(i==1,2)) /= 3)) call abort
+  if (ubound(any(i==1,2), 1) /= 3) call abort
+
+  if (any(lbound(count(i==1,2)) /= 1)) call abort
+  if (lbound(count(i==1,2), 1) /= 1) call abort
+
+  if (any(ubound(count(i==1,2)) /= 3)) call abort
+  if (ubound(count(i==1,2), 1) /= 3) call abort
+
+  if (any(lbound(merge(i,i,.true.)) /= 1)) call abort
+  if (lbound(merge(i,i,.true.), 1) /= 1) call abort
+  if (lbound(merge(i,i,.true.), 2) /= 1) call abort
+
+  if (any(ubound(merge(i,i,.true.)) /= 3)) call abort
+  if (ubound(merge(i,i,.true.), 1) /= 3) call abort
+  if (ubound(merge(i,i,.true.), 2) /= 3) call abort
+
+  if (any(lbound(lbound(i)) /= 1)) call abort
+  if (lbound(lbound(i), 1) /= 1) call abort
+
+  if (any(ubound(lbound(i)) /= 2)) call abort
+  if (ubound(lbound(i), 1) /= 2) call abort
+
+  if (any(lbound(ubound(i)) /= 1)) call abort
+  if (lbound(ubound(i), 1) /= 1) call abort
+
+  if (any(ubound(ubound(i)) /= 2)) call abort
+  if (ubound(ubound(i), 1) /= 2) call abort
+
+  if (any(lbound(shape(i)) /= 1)) call abort
+  if (lbound(shape(i), 1) /= 1) call abort
+
+  if (any(ubound(shape(i)) /= 2)) call abort
+  if (ubound(shape(i), 1) /= 2) call abort
+
+  if (any(lbound(product(i,2)) /= 1)) call abort
+  if (any(ubound(product(i,2)) /= 3)) call abort
+  if (any(lbound(sum(i,2)) /= 1)) call abort
+  if (any(ubound(sum(i,2)) /= 3)) call abort
+  if (any(lbound(matmul(i,i)) /= 1)) call abort
+  if (any(ubound(matmul(i,i)) /= 3)) call abort
+  if (any(lbound(pack(i,.true.)) /= 1)) call abort
+  if (any(ubound(pack(i,.true.)) /= 9)) call abort
+  if (any(lbound(unpack(j,[.true.],[2])) /= 1)) call abort
+  if (any(ubound(unpack(j,[.true.],[2])) /= 1)) call abort
+
+  call sub1(i,3)
+  call sub1(reshape([7,9,4,6,7,9],[3,2]),3)
+  call sub2
+
+contains
+
+  subroutine sub1(a,n)
+    integer :: n, a(2:n+1,4:*)
+
+    if (any([lbound(a,1), lbound(a,2)] /= [2, 4])) call abort
+    if (any(lbound(a) /= [2, 4])) call abort
+  end subroutine sub1
+
+  subroutine sub2
+    integer :: x(3:2, 1:2)
+
+    if (size(x) /= 0) call abort
+    if (lbound (x, 1) /= 1 .or. lbound(x, 2) /= 1) call abort
+    if (any (lbound (x) /= [1, 1])) call abort
+    if (ubound (x, 1) /= 0 .or. ubound(x, 2) /= 2) call abort
+    if (any (ubound (x) /= [0, 2])) call abort
+  end subroutine sub2
+
+  subroutine sub3
+    integer :: x(4:5, 1:2)
+
+    if (size(x) /= 0) call abort
+    if (lbound (x, 1) /= 4 .or. lbound(x, 2) /= 1) call abort
+    if (any (lbound (x) /= [4, 1])) call abort
+    if (ubound (x, 1) /= 4 .or. ubound(x, 2) /= 2) call abort
+    if (any (ubound (x) /= [4, 2])) call abort
+  end subroutine sub3
+
+  subroutine foo (x,n)
+    integer :: x(7,n,2,*), n
+
+    if (ubound(x,1) /= 7 .or. ubound(x,2) /= 4 .or. ubound(x,3) /= 2) call abort
+  end subroutine foo
+
+  subroutine jackal (b, c)
+    integer :: b, c
+    integer :: soda(b:c, 3:4)
+
+    if (b > c) then
+      if (size(soda) /= 0) call abort
+      if (lbound (soda, 1) /= 1 .or. ubound (soda, 1) /= 0) call abort
+    else
+      if (size(soda) /= 2*(c-b+1)) call abort
+      if (lbound (soda, 1) /= b .or. ubound (soda, 1) /= c) call abort
+    end if
+
+    if (lbound (soda, 2) /= 3 .or. ubound (soda, 2) /= 4) call abort
+    if (any (lbound (soda) /= [lbound(soda,1), lbound(soda,2)])) call abort
+    if (any (ubound (soda) /= [ubound(soda,1), ubound(soda,2)])) call abort
+
+  end subroutine jackal
+
+end
diff --git a/gcc/testsuite/gfortran.dg/bound_8.f90 b/gcc/testsuite/gfortran.dg/bound_8.f90
new file mode 100644
index 000000000..046fc7eb2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bound_8.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+! { dg-options "-Warray-temporaries -fall-intrinsics" }
+
+! Check that LBOUND/UBOUND/SIZE/SHAPE of array-expressions get simplified
+! in certain cases.
+! There should no array-temporaries warnings pop up, as this means that
+! the intrinsic call has not been properly simplified.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  ! Some explicitely shaped arrays and allocatable ones.
+  INTEGER :: a(2, 3), b(0:1, 4:6)
+  INTEGER, ALLOCATABLE :: x(:, :), y(:, :)
+
+  ! Allocate to matching sizes and initialize.
+  ALLOCATE (x(-1:0, -3:-1), y(11:12, 3))
+  a = 0
+  b = 1
+  x = 2
+  y = 3
+
+  ! Run the checks.  This should be simplified without array temporaries,
+  ! and additionally correct (of course).
+
+  ! Shape of expressions known at compile-time.
+  IF (ANY (LBOUND (a + b) /= 1)) CALL abort ()
+  IF (ANY (UBOUND (2 * b) /= (/ 2, 3 /))) CALL abort ()
+  IF (ANY (SHAPE (- b) /= (/ 2, 3 /))) CALL abort ()
+  IF (SIZE (a ** 2) /= 6) CALL abort
+
+  ! Shape unknown at compile-time.
+  IF (ANY (LBOUND (x + y) /= 1)) CALL abort ()
+  IF (SIZE (x ** 2) /= 6) CALL abort ()
+
+  ! Unfortunately, the array-version of UBOUND and SHAPE keep generating
+  ! temporary arrays for their results (not for the operation).  Thus we
+  ! can not check SHAPE in this case and do UBOUND in the single-dimension
+  ! version.
+  IF (UBOUND (2 * y, 1) /= 2 .OR. UBOUND (2 * y, 2) /= 3) CALL abort ()
+  !IF (ANY (SHAPE (- y) /= (/ 2, 3 /))) CALL abort ()
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/bound_simplification_1.f90 b/gcc/testsuite/gfortran.dg/bound_simplification_1.f90
new file mode 100644
index 000000000..def5b7005
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bound_simplification_1.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! { dg-options "" }
+  implicit none
+  real :: f(10,10,10,3,4)
+  integer, parameter :: upper(5) = ubound(f), lower(5) = lbound (f)
+  integer :: varu(5), varl(5)
+
+  varu(:) = ubound(f)
+  varl(:) = lbound(f)
+  if (any (varu /= upper)) call abort
+  if (any (varl /= lower)) call abort
+
+  call check (f, upper, lower)
+  call check (f, ubound(f), lbound(f))
+
+contains
+
+  subroutine check (f, upper, lower)
+    implicit none
+    integer :: upper(5), lower(5)
+    real :: f(:,:,:,:,:)
+
+    if (any (ubound(f) /= upper)) call abort
+    if (any (lbound(f) /= lower)) call abort
+  end subroutine check
+
+end
diff --git a/gcc/testsuite/gfortran.dg/bound_simplification_2.f90 b/gcc/testsuite/gfortran.dg/bound_simplification_2.f90
new file mode 100644
index 000000000..05477776f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bound_simplification_2.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR 38914 - this used to give an ICE due to missing
+! simplification.
+module foo
+  INTEGER, PARAMETER, DIMENSION(0:20,4) :: IP_ARRAY2_4_S = 0
+  INTEGER, PARAMETER, DIMENSION(2) ::  IP_ARRAY1_32_S = &
+  & (/  LBOUND(IP_ARRAY2_4_S(5:10,2:3))/)
+END module foo
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/bound_simplification_3.f90 b/gcc/testsuite/gfortran.dg/bound_simplification_3.f90
new file mode 100644
index 000000000..de3a3dc8a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bound_simplification_3.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/54208
+! The I and J definitions used to raise an error because ARR's array spec
+! was resolved to late for the LBOUND and UBOUND calls to be simplified to
+! a constant.
+!
+! Contributed by Carlos A. Cruz <carlos.a.cruz@nasa.gov>
+
+program testit
+  integer, parameter :: n=2
+  integer, dimension(1-min(n,2)/2:n) :: arr
+  integer, parameter :: i=lbound(arr,1)
+  integer, parameter :: j=ubound(arr,1)
+  ! write(6,*) i, j
+  if (i /= 0) call abort
+  if (j /= 2) call abort
+end program testit
+
+! { dg-final { scan-tree-dump-times "bound" 0 "original" } }
+! { dg-final { scan-tree-dump-times "abort" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_1.f90 b/gcc/testsuite/gfortran.dg/bounds_check_1.f90
new file mode 100644
index 000000000..c05f4456a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_1.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! PR fortran/27524
+    integer :: res(1)
+    res = F()
+    if (res(1) /= 1) call abort
+    contains
+      function F()
+        integer :: F(1)
+        f = 1
+      end function F
+    end
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_10.f90 b/gcc/testsuite/gfortran.dg/bounds_check_10.f90
new file mode 100644
index 000000000..66bc308f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_10.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Different CHARACTER lengths" }
+! PR fortran/33254: No bounds checking for array constructors
+program array_char
+implicit none
+character (len=2) :: x, y
+character (len=2) :: z(3)
+x = "a "
+y = "cd"
+z = [y(1:1), y(1:1), x(1:len(trim(x)))]  ! should work
+z = [trim(x), trim(y), "aaaa"] ! [ "a", "cd", "aaaa" ] should catch first error
+end program array_char
+
+! { dg-output "Different CHARACTER lengths .1/.. in array constructor" }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_11.f90 b/gcc/testsuite/gfortran.dg/bounds_check_11.f90
new file mode 100644
index 000000000..6e2cf3e78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_11.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Array bound checking" }
+! PR fortran/33745
+!
+! Don't check upper bound of assumed-size array
+!
+
+program test
+ implicit none
+ integer, parameter :: maxss=7,maxc=8
+ integer :: jp(2,maxc)
+ call findphase(jp)
+contains
+  subroutine findphase(jp)
+    integer, intent(out) :: jp(2,*)
+    jp(2,2:4)=0
+    jp(2,0:4)=0 ! { dg-warning "out of bounds" }
+    jp(3,1:4)=0 ! { dg-warning "out of bounds" }
+  end subroutine
+end program test
+
+! { dg-output "At line 18 of file .*" }
+! { dg-output "Index '0' of dimension 2 of array 'jp' below lower bound of 1" }
+
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_12.f90 b/gcc/testsuite/gfortran.dg/bounds_check_12.f90
new file mode 100644
index 000000000..f671badba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_12.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Different CHARACTER lengths" }
+! Tests the fix for PR34396, where the non-constant string lengths in the
+! array constructor were being ignored and the bounds checking was not
+! being done correctly.
+!
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+!
+program array_char
+  implicit none
+  integer :: i, j(5)
+  character (len=5) :: x, y
+  character (len=5) :: z(2)
+  x = "ab"
+  y = "cd"
+  z = ""
+  z = (/y(1: len (trim(y))), x(1: len (trim(x)))/)
+  j = ichar ([(z(1)(i:i), i=1,5)])
+  if (any (j .ne. (/99,100,32,32,32/))) call abort ()
+  j = ichar ([(z(2)(i:i), i=1,5)])
+  if (any (j .ne. (/97,98,32,32,32/))) call abort ()
+  x = "a "
+  z = (/y(1: len (trim(y))), x(1: len (trim(x)))/)
+end program array_char
+
+! { dg-output "At line 24 of file .*" }
+! { dg-output "Different CHARACTER lengths .2/1. in array constructor" }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_13.f b/gcc/testsuite/gfortran.dg/bounds_check_13.f
new file mode 100644
index 000000000..3581a18dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_13.f
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! Tests the fix for PR34945, in which the lbound = KIND(YDA) was not resolved
+! in time to set the size of TEST_ARRAY to zero.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+      SUBROUTINE VF0009(IDA1,IDA2,YDA,HDA)
+      INTEGER(4) IDA1(4)
+      INTEGER(4) IDA2(4)
+      COMPLEX(8) YDA(2)
+      INTEGER(4) HDA(3)
+!  I N I T I A L I Z A T I O N  S E C T I O N
+      COMPLEX(KIND=4) :: TEST_ARRAY
+     $(  4:5,
+     $   KIND(YDA):5,
+     $   4:5,
+     $   4:5  )
+!  T E S T  S T A T E M E N T S
+       IDA1(1:4) = LBOUND(TEST_ARRAY)
+      END SUBROUTINE
+
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_14.f90 b/gcc/testsuite/gfortran.dg/bounds_check_14.f90
new file mode 100644
index 000000000..1e5a4aeee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_14.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+
+program test
+  integer x(20)
+  integer, volatile :: n
+  n = 1
+  if (size(x(n:2:-3)) /= 0) call abort
+
+  call ha0020(-3)
+  call ha0020(-1)
+end program test
+
+subroutine ha0020(mf3)
+  implicit none
+  integer xca(2), xda(2), mf3
+
+  xca = 1
+  xda = -1
+
+  xca(1:2:-1) = xda(1:2:mf3)
+
+  if (any (xca /= 1)) call abort
+  if (any(xda(1:2:mf3) /= xda(1:0))) call abort
+  if (size(xda(1:2:mf3)) /= 0) call abort
+  if (any(shape(xda(1:2:mf3)) /= 0)) call abort
+  if (any(ubound(xda(1:2:mf3)) /= 0)) call abort
+  if (ubound(xda(1:2:mf3),1) /= 0) call abort
+  if (lbound(xda(1:2:mf3),1) /= 1) call abort
+
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_15.f90 b/gcc/testsuite/gfortran.dg/bounds_check_15.f90
new file mode 100644
index 000000000..947ffb2f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_15.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! Test the fix for PR42783, in which a bogus array bounds violation
+! with missing optional array argument.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+!
+program gfcbug99
+  implicit none
+  character(len=8), parameter :: mnem_list(2) = "A"
+
+  call foo (mnem_list)  ! This call succeeds
+  call foo ()           ! This call fails
+contains
+  subroutine foo (mnem_list)
+    character(len=8) ,intent(in) ,optional :: mnem_list(:)
+
+    integer            :: i,j
+    character(len=256) :: ml
+    ml = ''
+    j = 0
+    if (present (mnem_list)) then
+       do i = 1, size (mnem_list)
+          if (mnem_list(i) /= "") then
+             j = j + 1
+             if (j > len (ml)/8) call abort ()
+             ml((j-1)*8+1:(j-1)*8+8) = mnem_list(i)
+          end if
+       end do
+    end if
+    if (j > 0) print *, trim (ml(1:8))
+  end subroutine foo
+end program gfcbug99
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_2.f b/gcc/testsuite/gfortran.dg/bounds_check_2.f
new file mode 100644
index 000000000..671f7f241
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_2.f
@@ -0,0 +1,39 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! PR fortran/19777
+      implicit none
+      integer          npts
+      parameter        (npts=10)
+      double precision v(npts)
+      double precision w(npts,npts,npts)
+      external         init1
+      external         init2
+
+      call init1 (npts, v)
+      call init2 (npts, w)
+      end
+
+      subroutine init1 (npts, v)
+      implicit none
+      integer          npts
+      double precision v(*)
+
+      integer          i
+
+      do 10 i = 1, npts
+         v(i) = 0
+ 10   continue
+      end
+
+      subroutine init2 (npts, w)
+      implicit none
+      integer          npts
+      double precision w(npts,npts,*)
+
+      integer          i
+
+      do 20 i = 1, npts
+         w(i,1,1) = 0
+         w(1,npts,i) = 0
+ 20   continue
+      end
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_3.f90 b/gcc/testsuite/gfortran.dg/bounds_check_3.f90
new file mode 100644
index 000000000..5fb96b8dd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_3.f90
@@ -0,0 +1,69 @@
+! { dg-do compile }
+  integer,parameter :: n = 5, m = 8
+  integer a(10), i
+
+  print *, a(15:14) ! don't warn
+  print *, a(14:15) ! { dg-warning "is out of bounds" }
+  print *, a(-5:-6) ! don't warn
+  print *, a(-6:-5) ! { dg-warning "is out of bounds" }
+  print *, a(15:14:1) ! don't warn
+  print *, a(14:15:1) ! { dg-warning "is out of bounds" }
+  print *, a(-5:-6:1) ! don't warn
+  print *, a(-6:-5:1) ! { dg-warning "is out of bounds" }
+  print *, a(15:14:-1) ! { dg-warning "is out of bounds" }
+  print *, a(14:15:-1) ! don't warn
+  print *, a(-5:-6:-1) ! { dg-warning "is out of bounds" }
+  print *, a(-6:-5:-1) ! don't warn
+
+  print *, a(15:) ! don't warn
+  print *, a(15::-1) ! { dg-warning "is out of bounds" }
+  print *, a(-1:) ! { dg-warning "is out of bounds" }
+  print *, a(-1::-1) ! don't warn
+  print *, a(:-1) ! don't warn
+  print *, a(:-1:-1) ! { dg-warning "is out of bounds" }
+  print *, a(:11) ! { dg-warning "is out of bounds" }
+  print *, a(:11:-1) ! don't warn
+
+  print *, a(1:20:10) ! { dg-warning "is out of bounds" }
+  print *, a(1:15:15) ! don't warn
+  print *, a(1:16:15) ! { dg-warning "is out of bounds" }
+  print *, a(10:15:6) ! don't warn
+  print *, a(11:15:6) ! { dg-warning "is out of bounds" }
+  print *, a(11:-5:6) ! don't warn
+
+  print *, a(10:-8:-9) ! { dg-warning "is out of bounds" }
+  print *, a(10:-7:-9) ! don't warn
+  
+  print *, a(0:0:-1) ! { dg-warning "is out of bounds" }
+  print *, a(0:0:1) ! { dg-warning "is out of bounds" }
+  print *, a(0:0) ! { dg-warning "is out of bounds" }
+
+  print *, a(1:15:i) ! don't warn
+  print *, a(1:15:n) ! { dg-warning "is out of bounds" }
+  print *, a(1:15:m) ! don't warn
+
+  print *, a(1:-5:-m) ! don't warn
+  print *, a(1:-5:-n) ! { dg-warning "is out of bounds" }
+  print *, a(1:-5:-i) ! don't warn
+
+  print *, a(-5:-5) ! { dg-warning "is out of bounds" }
+  print *, a(15:15) ! { dg-warning "is out of bounds" }
+  print *, a(-5:-5:1) ! { dg-warning "is out of bounds" }
+  print *, a(15:15:-1) ! { dg-warning "is out of bounds" }
+  print *, a(-5:-5:2) ! { dg-warning "is out of bounds" }
+  print *, a(15:15:-2) ! { dg-warning "is out of bounds" }
+  print *, a(-5:-5:n) ! { dg-warning "is out of bounds" }
+  print *, a(15:15:-n) ! { dg-warning "is out of bounds" }
+  print *, a(-5:-5:i) ! { dg-warning "is out of bounds" }
+  print *, a(15:15:-i) ! { dg-warning "is out of bounds" }
+  print *, a(5:5) ! don't warn
+  print *, a(5:5:1) ! don't warn
+  print *, a(5:5:-1) ! don't warn
+  print *, a(5:5:2) ! don't warn
+  print *, a(5:5:-2) ! don't warn
+  print *, a(5:5:n) ! don't warn
+  print *, a(5:5:-n) ! don't warn
+  print *, a(5:5:i) ! don't warn
+  print *, a(5:5:-i) ! don't warn
+
+  end
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_4.f90 b/gcc/testsuite/gfortran.dg/bounds_check_4.f90
new file mode 100644
index 000000000..9ce2298f2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_4.f90
@@ -0,0 +1,18 @@
+subroutine foo(n,x)
+  implicit none
+  integer, intent(in) :: n
+  complex(8), intent(out) :: x(n,*)
+  x(1,1) = 0.d0
+  x(n,1) = 0.d0
+  x(:,1) = 0.d0
+  x(2:,1) = 0.d0
+  x(:n-1,1) = 0.d0
+  x((/1,n/),1) = 0.d0
+end subroutine foo
+
+program test
+  implicit none
+  integer, parameter :: n = 17
+  complex(8) :: x(n,n)
+  call foo(n,x)
+end program test
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_5.f90 b/gcc/testsuite/gfortran.dg/bounds_check_5.f90
new file mode 100644
index 000000000..3a2fc6306
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_5.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! This tests the fix for PR30190, in which the array reference
+! in the associated statement would cause a segfault.
+!
+! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+  TYPE particle_type
+     INTEGER, POINTER :: p(:)
+  END TYPE particle_type
+  TYPE(particle_type), POINTER  :: t(:)
+  integer :: i
+  logical :: f
+  i = 1
+  allocate(t(1))
+  allocate(t(1)%p(0))
+  f = associated(t(i)%p,t(i)%p)
+end
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_6.f90 b/gcc/testsuite/gfortran.dg/bounds_check_6.f90
new file mode 100644
index 000000000..6535db760
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_6.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+!
+! Testcase for PR30655, we used to issue a compile-time warning
+  integer i(12), j
+  j = -1
+  i(0:j) = 42
+  end
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_7.f90 b/gcc/testsuite/gfortran.dg/bounds_check_7.f90
new file mode 100644
index 000000000..c488a68ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_7.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Array reference out of bounds" }
+! PR fortran/31627
+subroutine foo(a)
+  integer a(*), i
+  i = 0
+  a(i) = 42 ! {
+end subroutine foo
+
+program test
+  integer x(42)
+  call foo(x)
+end program test
+! { dg-output "Index '0' of dimension 1 of array 'a' below lower bound of 1" }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_8.f90 b/gcc/testsuite/gfortran.dg/bounds_check_8.f90
new file mode 100644
index 000000000..11be29bda
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_8.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! PR fortran/32036
+program test
+  type t
+    integer, dimension (5) :: field
+  end type t
+  type (t), dimension (2) :: a
+  integer :: calls
+
+  type xyz_type
+     integer :: x
+  end type xyz_type
+  type (xyz_type), dimension(3) :: xyz
+  character(len=80) :: s
+
+  xyz(1)%x = 11111
+  xyz(2)%x = 0
+  xyz(3)%x = 0
+
+  write(s,*) xyz(bar())
+  if (trim(adjustl(s)) /= "11111") call abort
+
+  a(1)%field = 0
+  a(2)%field = 0
+  calls = 0
+  if (sum(a(foo(calls))%field) /= 0) call abort
+  if (calls .ne. 1) call abort
+
+contains
+
+  function foo (calls)
+    integer :: calls, foo
+    calls = calls + 1
+    foo = 2
+  end function foo 
+
+  integer function bar ()
+    integer, save :: i = 1
+    bar = i
+    i = i + 1
+  end function
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_9.f90 b/gcc/testsuite/gfortran.dg/bounds_check_9.f90
new file mode 100644
index 000000000..3b487efa1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_9.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! PR fortran/31119
+!
+module sub_mod
+contains
+elemental subroutine set_optional(i,idef,iopt)
+  integer, intent(out) :: i
+  integer, intent(in) :: idef
+  integer, intent(in), optional :: iopt
+  if (present(iopt)) then
+    i = iopt
+  else
+    i = idef
+  end if
+  end subroutine set_optional
+
+  subroutine sub(ivec)
+    integer, intent(in), optional :: ivec(:)
+    integer :: ivec_(2)
+    call set_optional(ivec_,(/1,2/))
+    if (any (ivec_ /= (/1, 2/))) call abort
+    call set_optional(ivec_,(/1,2/),ivec)
+    if (present (ivec)) then
+      if (any (ivec_ /= ivec)) call abort
+    else
+      if (any (ivec_ /= (/1, 2/))) call abort
+    end if
+  end subroutine sub
+end module sub_mod
+
+program main
+  use sub_mod, only: sub
+  call sub()
+  call sub((/4,5/))
+end program main
+! { dg-final { cleanup-modules "sub_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_1.f90 b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_1.f90
new file mode 100644
index 000000000..45b21d21e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_1.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "foo" }
+!
+! PR 36112
+! Check correct bounds-checking behaviour for character-array-constructors.
+
+  call test ("this is long")
+contains
+  subroutine test(s)
+    character(len=*) :: s
+    character(len=128) :: arr(2)
+    arr = (/ s, "abc" /)
+  end subroutine test
+end
+! { dg-output "Different CHARACTER lengths \\(12/3\\) in array constructor" }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_2.f90 b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_2.f90
new file mode 100644
index 000000000..e0cbf1061
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_2.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "foo" }
+!
+! PR 36112
+! Check correct bounds-checking behaviour for character-array-constructors.
+
+  call test ("this is long")
+contains
+  subroutine test(s)
+    character(len=*) :: s
+    character(len=128) :: arr(2)
+    arr = (/ "abc", s /)
+  end subroutine test
+end
+! { dg-output "Different CHARACTER lengths \\(3/12\\) in array constructor" }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_3.f90 b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_3.f90
new file mode 100644
index 000000000..5e566ba9b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_3.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+!
+! PR 36112
+! Check correct bounds-checking behaviour for character-array-constructors.
+! This should not need any -fbounds-check and is enabled all the time.
+
+  character(len=128) :: arr(2) = (/ "abc", "foobar" /) ! { dg-error "Different CHARACTER lengths" }
+  arr = (/ "abc", "foobar" /) ! { dg-error "Different CHARACTER lengths" }
+end
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_4.f90 b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_4.f90
new file mode 100644
index 000000000..1d3bac83a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_4.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "foo" }
+!
+! PR 36112
+! Check correct bounds-checking behaviour for character-array-constructors.
+
+  call test ("short", "this is long")
+contains
+  subroutine test(r, s)
+    character(len=*) :: r, s
+    character(len=128) :: arr(2)
+    arr = (/ r, s /)
+  end subroutine test
+end
+! { dg-output "Different CHARACTER lengths \\(5/12\\) in array constructor" }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_5.f90 b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_5.f90
new file mode 100644
index 000000000..ad7f1b054
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_5.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+!
+! PR 36112
+! Check correct bounds-checking behaviour for character-array-constructors.
+! No need for -fbounds-check, enabled unconditionally.
+
+  character(len=5) :: s = "hello"
+  character(len=128) :: arr(3)
+  arr = (/ "abc", "foo", s /) ! { dg-error "Different CHARACTER lengths" }
+end
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_6.f90 b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_6.f90
new file mode 100644
index 000000000..c6f89e0de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_6.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "foo" }
+!
+! PR 36112
+! Check correct bounds-checking behaviour for character-array-constructors.
+
+  call test ("short", "also5")
+contains
+  subroutine test(r, s)
+    character(len=*) :: r, s
+    character(len=128) :: arr(3)
+    arr = (/ r, s, "this is too long" /)
+  end subroutine test
+end
+! { dg-output "Different CHARACTER lengths \\(5/16\\) in array constructor" }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_7.f90 b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_7.f90
new file mode 100644
index 000000000..2a13be2be
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_7.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "foo" }
+!
+! PR 36112
+! Check correct bounds-checking behaviour for character-array-constructors.
+
+  call test ("short")
+contains
+  subroutine test(s)
+    character(len=*) :: s
+    character(len=128) :: arr(3)
+    arr = (/ "this is long", "this one too", s /)
+  end subroutine test
+end
+! { dg-output "Different CHARACTER lengths \\(12/5\\) in array constructor" }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_8.f90 b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_8.f90
new file mode 100644
index 000000000..0d4ad0cfe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_8.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "foo" }
+!
+! PR 36112
+! Check correct bounds-checking behaviour for character-array-constructors.
+
+  call test ("short")
+contains
+  subroutine test(s)
+    character(len=*) :: s
+    character(len=128) :: arr(3)
+    arr = (/ s, "this is long", "this one too" /)
+  end subroutine test
+end
+! { dg-output "Different CHARACTER lengths \\(5/12\\) in array constructor" }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_fail_1.f90 b/gcc/testsuite/gfortran.dg/bounds_check_fail_1.f90
new file mode 100644
index 000000000..d3eb271c3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_fail_1.f90
@@ -0,0 +1,7 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "foo" }
+  integer x(1)
+  x(2) = x(1) ! { dg-warning "out of bounds" }
+  end
+! { dg-output "Index '2' of dimension 1 of array 'x' above upper bound of 1" }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_fail_2.f90 b/gcc/testsuite/gfortran.dg/bounds_check_fail_2.f90
new file mode 100644
index 000000000..d79272b38
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_fail_2.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "foo" }
+!
+! PR 31119
+module sub_mod
+contains
+  elemental subroutine set_optional(i,idef,iopt)
+    integer, intent(out)          :: i
+    integer, intent(in)           :: idef
+    integer, intent(in), optional :: iopt
+    if (present(iopt)) then
+      i = iopt
+    else
+      i = idef
+    end if
+  end subroutine set_optional
+
+  subroutine sub(ivec)
+    integer          , intent(in), optional :: ivec(:)
+    integer                                 :: ivec_(2)
+    call set_optional(ivec_,(/1,2/))
+    if (any (ivec_ /= (/1,2/))) call abort
+    call set_optional(ivec_,(/1,2/),ivec)
+    if (present (ivec)) then
+      if (any (ivec_ /= ivec)) call abort
+    else
+      if (any (ivec_ /= (/1,2/))) call abort
+    end if
+  end subroutine sub
+end module sub_mod
+
+program main
+  use sub_mod, only: sub
+  call sub()
+  call sub((/4,5/))
+  call sub((/4/))
+end program main
+! { dg-output "Fortran runtime error: Array bound mismatch" }
+! { dg-final { cleanup-modules "sub_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_fail_3.f90 b/gcc/testsuite/gfortran.dg/bounds_check_fail_3.f90
new file mode 100644
index 000000000..ce4d0368d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_fail_3.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "foo" }
+  integer x(10), m, n
+  x = (/ (i, i = 1, 10) /)
+  m = -3
+  n = -2
+  x(7:1:m) = x(6:2:n) 
+  if (any(x /= (/ 2, 2, 3, 4, 5, 6, 6, 8, 9, 10 /))) call abort()
+  x(8:1:m) = x(5:2:n) 
+  end
+! { dg-output "line 10 .* bound mismatch .* dimension 1 .* array \'x\' \\\(3/2\\\)" }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_fail_4.f90 b/gcc/testsuite/gfortran.dg/bounds_check_fail_4.f90
new file mode 100644
index 000000000..718d0058e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_fail_4.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "foo" }
+  integer x(10), m, n
+  x = (/ (i, i = 1, 10) /)
+  m = -3
+  n = -2
+  x(7:1:m) = x(1:3) + x(6:2:n) 
+  if (any(x /= (/ 5, 2, 3, 6, 5, 6, 7, 8, 9, 10 /))) call abort()
+  x(8:1:m) = x(1:3) + x(5:2:n) 
+  end
+! { dg-output "line 10 .* bound mismatch .* dimension 1 .* array \'x\' \\\(2/3\\\)" }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_strlen_1.f90 b/gcc/testsuite/gfortran.dg/bounds_check_strlen_1.f90
new file mode 100644
index 000000000..7ea4a89a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_strlen_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Character length mismatch" }
+
+! PR fortran/37746
+! Test bounds-checking for string length of dummy arguments.
+
+SUBROUTINE test (str)
+  IMPLICIT NONE
+  CHARACTER(len=5) :: str
+END SUBROUTINE test
+
+PROGRAM main
+  IMPLICIT NONE
+  CALL test ('abc') ! { dg-warning "Character length of actual argument shorter" }
+END PROGRAM main
+
+! { dg-output "shorter than the declared one for dummy argument 'str' \\(3/5\\)" }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_strlen_2.f90 b/gcc/testsuite/gfortran.dg/bounds_check_strlen_2.f90
new file mode 100644
index 000000000..7ecce2a71
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_strlen_2.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Character length mismatch" }
+
+! PR fortran/37746
+! Test bounds-checking for string length of dummy arguments.
+
+MODULE m
+
+CONTAINS
+
+  SUBROUTINE test (str, n)
+    IMPLICIT NONE
+    CHARACTER(len=n) :: str
+    INTEGER :: n
+  END SUBROUTINE test
+
+  SUBROUTINE test2 (str)
+    IMPLICIT NONE
+    CHARACTER(len=*) :: str
+    CALL test (str, 5) ! Expected length of str is 5.
+  END SUBROUTINE test2
+
+END MODULE m
+
+PROGRAM main
+  USE m
+  IMPLICIT NONE
+  CALL test2 ('abc') ! String is too short.
+END PROGRAM main
+
+! { dg-output "shorter than the declared one for dummy argument 'str' \\(3/5\\)" }
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_strlen_3.f90 b/gcc/testsuite/gfortran.dg/bounds_check_strlen_3.f90
new file mode 100644
index 000000000..69be0884c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_strlen_3.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Character length mismatch" }
+
+! PR fortran/37746
+! Test bounds-checking for string length of dummy arguments.
+
+MODULE m
+
+CONTAINS
+
+  SUBROUTINE test (str)
+    IMPLICIT NONE
+    CHARACTER(len=5), POINTER :: str
+  END SUBROUTINE test
+
+  SUBROUTINE test2 (n)
+    IMPLICIT NONE
+    INTEGER :: n
+    CHARACTER(len=n), POINTER :: str
+    CALL test (str)
+  END SUBROUTINE test2
+
+END MODULE m
+
+PROGRAM main
+  USE m
+  IMPLICIT NONE
+  CALL test2 (7) ! Too long.
+END PROGRAM main
+
+! { dg-output "does not match the declared one for dummy argument 'str' \\(7/5\\)" }
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_strlen_4.f90 b/gcc/testsuite/gfortran.dg/bounds_check_strlen_4.f90
new file mode 100644
index 000000000..db8ce3c3b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_strlen_4.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Character length mismatch" }
+
+! PR fortran/37746
+! Test bounds-checking for string length of dummy arguments.
+
+MODULE m
+
+CONTAINS
+
+  SUBROUTINE test (str)
+    IMPLICIT NONE
+    CHARACTER(len=5), ALLOCATABLE :: str(:)
+  END SUBROUTINE test
+
+  SUBROUTINE test2 (n)
+    IMPLICIT NONE
+    INTEGER :: n
+    CHARACTER(len=n), ALLOCATABLE :: str(:)
+    CALL test (str)
+  END SUBROUTINE test2
+
+END MODULE m
+
+PROGRAM main
+  USE m
+  IMPLICIT NONE
+  CALL test2 (7) ! Too long.
+END PROGRAM main
+
+! { dg-output "does not match the declared one for dummy argument 'str' \\(7/5\\)" }
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_strlen_5.f90 b/gcc/testsuite/gfortran.dg/bounds_check_strlen_5.f90
new file mode 100644
index 000000000..36fda721f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_strlen_5.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Character length mismatch" }
+
+! PR fortran/37746
+! Test bounds-checking for string length of dummy arguments.
+
+MODULE m
+
+CONTAINS
+
+  SUBROUTINE test (str)
+    IMPLICIT NONE
+    CHARACTER(len=5) :: str(:) ! Assumed shape.
+  END SUBROUTINE test
+
+  SUBROUTINE test2 (n)
+    IMPLICIT NONE
+    INTEGER :: n
+    CHARACTER(len=n) :: str(2)
+    CALL test (str)
+  END SUBROUTINE test2
+
+END MODULE m
+
+PROGRAM main
+  USE m
+  IMPLICIT NONE
+  CALL test2 (7) ! Too long.
+END PROGRAM main
+
+! { dg-output "does not match the declared one for dummy argument 'str' \\(7/5\\)" }
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_strlen_6.f90 b/gcc/testsuite/gfortran.dg/bounds_check_strlen_6.f90
new file mode 100644
index 000000000..550cca843
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_strlen_6.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+
+! PR fortran/37746
+! Ensure that too long or matching string lengths don't trigger the runtime
+! error for matching string lengths, if the dummy argument is neither
+! POINTER nor ALLOCATABLE or assumed-shape.
+! Also check that absent OPTIONAL arguments don't trigger the check.
+
+MODULE m
+CONTAINS
+
+  SUBROUTINE test (str, opt)
+    IMPLICIT NONE
+    CHARACTER(len=5) :: str
+    CHARACTER(len=5), OPTIONAL :: opt
+  END SUBROUTINE test
+
+END MODULE m
+
+PROGRAM main
+  USE m
+  IMPLICIT NONE
+  CALL test ('abcde')  ! String length matches.
+  CALL test ('abcdef') ! String too long, is ok.
+END PROGRAM main
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_strlen_7.f90 b/gcc/testsuite/gfortran.dg/bounds_check_strlen_7.f90
new file mode 100644
index 000000000..9f08ba1ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_strlen_7.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Character length mismatch" }
+
+! PR fortran/37746
+! Test bounds-checking for string length of dummy arguments.
+
+MODULE m
+CONTAINS
+
+  SUBROUTINE test (opt)
+    IMPLICIT NONE
+    CHARACTER(len=5), OPTIONAL :: opt
+  END SUBROUTINE test
+
+END MODULE m
+
+PROGRAM main
+  USE m
+  IMPLICIT NONE
+  CALL test ('') ! 0 length, but not absent argument.
+END PROGRAM main
+
+! { dg-output "shorter than the declared one for dummy argument 'opt' \\(0/5\\)" }
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_strlen_8.f90 b/gcc/testsuite/gfortran.dg/bounds_check_strlen_8.f90
new file mode 100644
index 000000000..c54f14144
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_strlen_8.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+!
+! PR fortran/40383
+! Gave before a bogus out of bounds.
+! Contributed by Joost VandeVondele.
+!
+MODULE M1
+  INTEGER, PARAMETER :: default_string_length=80
+END MODULE M1
+MODULE M2
+ USE M1
+ IMPLICIT NONE
+CONTAINS
+ FUNCTION F1(a,b,c,d) RESULT(RES)
+   CHARACTER(LEN=default_string_length), OPTIONAL :: a,b,c,d
+   LOGICAL :: res
+ END FUNCTION F1
+END MODULE M2
+
+MODULE M3
+ USE M1
+ USE M2
+ IMPLICIT NONE
+CONTAINS
+ SUBROUTINE S1
+   CHARACTER(LEN=default_string_length) :: a,b
+   LOGICAL :: L1
+   INTEGER :: i
+   DO I=1,10
+      L1=F1(a,b)
+   ENDDO
+ END SUBROUTINE
+END MODULE M3
+
+USE M3
+CALL S1
+END
+
+! { dg-final { cleanup-modules "m1 m2 m3" } }
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_strlen_9.f90 b/gcc/testsuite/gfortran.dg/bounds_check_strlen_9.f90
new file mode 100644
index 000000000..89622e249
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_strlen_9.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+!
+! PR fortran/40452
+! The following program is valid Fortran 90 and later.
+! The storage-sequence association of the dummy argument
+! allows that the actual argument ["ab", "cd"] is mapped
+! to the dummy argument a(1) which perfectly fits.
+! (The dummy needs to be an array, however.)
+!
+
+program test
+  implicit none
+  call sub(["ab", "cd"])
+contains
+  subroutine sub(a)
+   character(len=4) :: a(1)
+   print *, a(1)
+  end subroutine sub
+end program test
diff --git a/gcc/testsuite/gfortran.dg/bounds_temporaries_1.f90 b/gcc/testsuite/gfortran.dg/bounds_temporaries_1.f90
new file mode 100644
index 000000000..44b5a7dba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_temporaries_1.f90
@@ -0,0 +1,64 @@
+! { dg-do compile }
+! This tests the fix for PRs 26834, 25669 and 18803, in which
+! shape information for the lbound and ubound intrinsics was not
+! transferred to the scalarizer.  For this reason, an ICE would
+! ensue, whenever these functions were used in temporaries.
+!
+! The tests are lifted from the PRs and some further checks are
+! done to make sure that nothing is broken.
+!
+! This is PR26834
+subroutine gfcbug34 ()
+  implicit none
+  type t
+     integer, pointer :: i (:) => NULL ()
+  end type t
+  type(t), save :: gf
+  allocate (gf%i(20))
+  write(*,*) 'ubound:', ubound (gf% i)
+  write(*,*) 'lbound:', lbound (gf% i)
+end subroutine gfcbug34
+
+! This is PR25669
+subroutine foo (a)
+  real a(*)
+  call bar (a, LBOUND(a),2) ! { dg-error "Rank mismatch in argument" }
+end subroutine foo
+subroutine bar (b, i, j)
+  real b(i:j)
+  print *, i, j
+  print *, b(i:j)
+end subroutine bar
+
+! This is PR18003
+subroutine io_bug()
+  integer :: a(10)
+  print *, ubound(a)
+end subroutine io_bug
+
+! This checks that lbound and ubound are OK in  temporary
+! expressions.
+subroutine io_bug_plus()
+  integer :: a(10, 10), b(2)
+  print *, ubound(a)*(/1,2/)
+  print *, (/1,2/)*ubound(a)
+end subroutine io_bug_plus
+
+  character(4) :: ch(2), ech(2) = (/'ABCD', 'EFGH'/)
+  real(4) :: a(2)
+  equivalence (ech,a)  ! { dg-warning "default CHARACTER EQUIVALENCE statement" }
+  integer(1) :: i(8) = (/(j, j = 1,8)/)
+
+! Check that the bugs have gone
+  call io_bug ()
+  call io_bug_plus ()
+  call foo ((/1.0,2.0,3.0/))
+  call gfcbug34 ()
+
+! Check that we have not broken other intrinsics.
+  print *, cos ((/1.0,2.0/))
+  print *, transfer (a, ch)
+  print *, i(1:4) * transfer (a, i, 4) * 2
+end
+
+
diff --git a/gcc/testsuite/gfortran.dg/boz_1.f90 b/gcc/testsuite/gfortran.dg/boz_1.f90
new file mode 100644
index 000000000..d3fa7c7ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_1.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+! Test the boz handling
+program boz
+
+   implicit none
+
+   integer(1), parameter :: b1 = b'00000001'
+   integer(2), parameter :: b2 = b'0101010110101010'
+   integer(4), parameter :: b4 = b'01110000111100001111000011110000'
+   integer(8), parameter :: &
+   &  b8 = b'0111000011110000111100001111000011110000111100001111000011110000'
+
+   integer(1), parameter :: o1 = o'12'
+   integer(2), parameter :: o2 = o'4321'
+   integer(4), parameter :: o4 = o'43210765'
+   integer(8), parameter :: o8 = o'1234567076543210'
+
+   integer(1), parameter :: z1 = z'a'
+   integer(2), parameter :: z2 = z'ab'
+   integer(4), parameter :: z4 = z'dead'
+   integer(8), parameter :: z8 = z'deadbeef'
+
+   if (z1 /= 10_1) call abort
+   if (z2 /= 171_2) call abort
+   if (z4 /= 57005_4) call abort
+   if (z8 /= 3735928559_8) call abort
+
+   if (b1 /= 1_1) call abort
+   if (b2 /= 21930_2) call abort
+   if (b4 /= 1894838512_4) call abort
+   if (b8 /= 8138269444283625712_8) call abort
+
+   if (o1 /= 10_1) call abort
+   if (o2 /= 2257_2) call abort
+   if (o4 /= 9245173_4) call abort
+   if (o8 /= 45954958542472_8) call abort
+
+end program boz
diff --git a/gcc/testsuite/gfortran.dg/boz_10.f90 b/gcc/testsuite/gfortran.dg/boz_10.f90
new file mode 100644
index 000000000..a88bbde65
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_10.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/34342
+!
+! Diagnose BOZ literal for non-integer variables in
+! a DATA statement. And outside DATA statements.
+!
+real :: r
+integer :: i
+r = real(z'FFFF') ! { dg-error "outside a DATA statement" }
+i = int(z'4455')  ! { dg-error "outside a DATA statement" }
+r = z'FFFF' + 1.0 ! { dg-error "outside a DATA statement" }
+i = z'4455' + 1   ! { dg-error "outside a DATA statement" }
+end
diff --git a/gcc/testsuite/gfortran.dg/boz_11.f90 b/gcc/testsuite/gfortran.dg/boz_11.f90
new file mode 100644
index 000000000..2bbf02219
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_11.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+!
+program test0
+   implicit none
+   real, parameter :: &
+     r = transfer(int(b'01000000001010010101001111111101',kind=4),0.)
+   complex, parameter :: z = r * (0, 1.)
+   real(kind=8), parameter :: rd = dble(b'00000000000000000000000000000000&
+                                         &01000000001010010101001111111101')
+   complex(kind=8), parameter :: zd = (0._8, 1._8) * rd
+   integer :: x = 0
+
+   if (cmplx(b'01000000001010010101001111111101',x,4) /= r) call abort
+   if (cmplx(x,b'01000000001010010101001111111101',4) /= z) call abort
+   if (complex(b'01000000001010010101001111111101',0) /= r) call abort
+   if (complex(0,b'01000000001010010101001111111101') /= z) call abort
+
+   !if (cmplx(b'00000000000000000000000000000000&
+   !           &01000000001010010101001111111101',x,8) /= rd) call abort
+   !if (cmplx(x,b'00000000000000000000000000000000&
+   !             &01000000001010010101001111111101',8) /= zd) call abort
+   !if (dcmplx(b'00000000000000000000000000000000&
+   !            &01000000001010010101001111111101',x) /= rd) call abort
+   !if (dcmplx(x,b'00000000000000000000000000000000&
+   !              &01000000001010010101001111111101') /= zd) call abort
+
+end program test0
diff --git a/gcc/testsuite/gfortran.dg/boz_12.f90 b/gcc/testsuite/gfortran.dg/boz_12.f90
new file mode 100644
index 000000000..4c5c750d5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_12.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! 
+program test
+  implicit none
+  real x4
+  double precision x8
+
+  x4 = 1.7
+  x8 = 1.7
+  write(*,*) complex(x4,z'1FFFFFFFF') ! { dg-error "too" }
+  write(*,*) cmplx(x8,z'1FFFFFFFFFFFFFFFF') ! { dg-error "too" }
+  write(*,*) complex(x8,z'1FFFFFFFFFFFFFFFF') ! { dg-error "too" }
+  write(*,*) dcmplx(x8,z'1FFFFFFFFFFFFFFFF') ! { dg-error "too" }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/boz_13.f90 b/gcc/testsuite/gfortran.dg/boz_13.f90
new file mode 100644
index 000000000..a522f82ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_13.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+
+! PR fortran/36214
+! For BOZ-initialization of floats, the precision used to be wrong sometimes.
+
+implicit none
+   real, parameter :: r = 0.0
+   real(kind=8), parameter :: rd = real (z'00000000&
+                                          &402953FD', 8)
+
+   if (real (z'00000000&
+              &402953FD', 8) /= rd) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/boz_14.f90 b/gcc/testsuite/gfortran.dg/boz_14.f90
new file mode 100644
index 000000000..1e571780e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_14.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-add-options ieee }
+
+! PR fortran/36214
+! For BOZ-initialization of floats, the precision used to be wrong sometimes.
+
+   implicit none
+   real(4) r
+   real(8) rd
+   complex(8) z
+   rd = &
+    real (b'00000000000000000000000000000000&
+           &01000000001010010101001111111101',8)
+   z  = &
+    cmplx(b'00000000000000000000000000000000&
+           &01000000001010010101001111111101',0,8)
+   r = 0.
+   if (z /= rd) call abort
+   end
diff --git a/gcc/testsuite/gfortran.dg/boz_15.f90 b/gcc/testsuite/gfortran.dg/boz_15.f90
new file mode 100644
index 000000000..f481f16e8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_15.f90
@@ -0,0 +1,49 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+! { dg-require-effective-target fortran_large_int }
+!
+! PR fortran/41711
+!
+! Check reading and writing of real(10/16) BOZ,
+! which needs integer(16) support.
+!
+implicit none
+character(len=256) :: str
+integer,parameter :: xp = selected_real_kind (precision (0.0d0)+1)
+real(xp)    :: r1,r2
+complex(xp) :: z1,z2
+
+r2 = 5.0_xp
+r1 = 2.0_xp
+! Real B(OZ)
+write(str,'(b128)') r1
+read (str,'(b128)') r2
+if(r2 /= r1) call abort()
+! Real (B)O(Z)
+r2 = 5.0_xp
+write(str,'(o126)') r1
+read (str,'(o126)') r2
+if(r2 /= r1) call abort()
+! Real (BO)Z
+r2 = 5.0_xp
+write(str,'(z126)') r1
+read (str,'(z126)') r2
+if(r2 /= r1) call abort()
+
+z2 = cmplx(5.0_xp,7.0_xp)
+z1 = cmplx(2.0_xp,3.0_xp)
+! Complex B(OZ)
+write(str,'(2b128)') z1
+read (str,'(2b128)') z2
+if(z2 /= z1) call abort()
+! Complex (B)O(Z)
+z2 = cmplx(5.0_xp,7.0_xp)
+write(str,'(2o126)') z1
+read (str,'(2o126)') z2
+if(z2 /= z1) call abort()
+! Complex (BO)Z
+z2 = cmplx(5.0_xp,7.0_xp)
+write(str,'(2z126)') z1
+read (str,'(2z126)') z2
+if(z2 /= z1) call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/boz_3.f90 b/gcc/testsuite/gfortran.dg/boz_3.f90
new file mode 100644
index 000000000..e8a93d129
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_3.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+! Test that the BOZ constant on the RHS, which are of different KIND than
+! the LHS, are correctly converted.
+!
+program boz
+
+   implicit none
+
+   integer(1), parameter :: b1 = b'000000000001111'
+   integer(2), parameter :: b2 = b'00000000000000000111000011110000'
+   integer(4), parameter :: &
+   &  b4 = b'0000000000000000000000000000000001110000111100001111000011110000'
+
+   integer(1), parameter :: o1 = o'0012'
+   integer(2), parameter :: o2 = o'0004321'
+   integer(4), parameter :: o4 = o'0000000043210765'
+
+   integer(1), parameter :: z1 = z'0a'
+   integer(2), parameter :: z2 = z'00ab'
+   integer(4), parameter :: z4 = z'0000dead'
+
+   if (b1 /= 15_1) call abort
+   if (b2 /= 28912_2) call abort
+   if (b4 /= 1894838512_4) call abort
+
+   if (o1 /= 10_1) call abort
+   if (o2 /= 2257_2) call abort
+   if (o4 /= 9245173_4) call abort
+
+   if (z1 /= 10_1) call abort
+   if (z2 /= 171_2) call abort
+   if (z4 /= 57005_4) call abort
+
+end program boz
diff --git a/gcc/testsuite/gfortran.dg/boz_4.f90 b/gcc/testsuite/gfortran.dg/boz_4.f90
new file mode 100644
index 000000000..d016df22c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_4.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! Test that the conversion of a BOZ constant that is too large for the
+! integer variable is caught by the compiler.
+program boz
+
+   implicit none
+
+   integer(1), parameter :: &
+   &  b1 = b'0101010110101010'  ! { dg-error "overflow converting" }
+   integer(2), parameter :: &
+   &  b2 = b'01110000111100001111000011110000'  ! { dg-error "overflow converting" }
+   integer(4), parameter :: &
+   &  b4 = b'0111000011110000111100001111000011110000111100001111000011110000'  ! { dg-error "overflow converting" }
+
+   integer(1), parameter :: &
+   &  o1 = o'1234567076543210'  ! { dg-error "overflow converting" }
+   integer(2), parameter :: &
+   &  o2 = o'1234567076543210'  ! { dg-error "overflow converting" }
+   integer(4), parameter :: &
+   &  o4 = o'1234567076543210'  ! { dg-error "overflow converting" }
+
+   integer(1), parameter :: &
+   &  z1 = z'deadbeef'  ! { dg-error "overflow converting" }
+   integer(2), parameter :: &
+   &  z2 = z'deadbeef'  ! { dg-error "overflow converting" }
+   integer(4), parameter :: &
+   &  z4 = z'deadbeeffeed'  ! { dg-error "overflow converting" }
+
+end program boz
diff --git a/gcc/testsuite/gfortran.dg/boz_5.f90 b/gcc/testsuite/gfortran.dg/boz_5.f90
new file mode 100644
index 000000000..3b1994ba0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_5.f90
@@ -0,0 +1,4 @@
+! { dg-do compile }
+  integer, dimension (2) :: i
+  i = (/Z'abcde', Z'abcde/)	! { dg-error "Illegal character" }
+end
diff --git a/gcc/testsuite/gfortran.dg/boz_6.f90 b/gcc/testsuite/gfortran.dg/boz_6.f90
new file mode 100644
index 000000000..d7a287d58
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_6.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+! PR 24917
+program test
+  integer ib, io, iz, ix
+  integer jb, jo, jz, jx
+  data ib, jb /b'111', '111'b/
+  data io, jo /o'234', '234'o/
+  data iz, jz /z'abc', 'abc'z/
+  data ix, jx /x'abc', 'abc'x/
+  if (ib /= jb) call abort
+  if (io /= jo) call abort
+  if (iz /= jz) call abort
+  if (ix /= jx) call abort
+end program test
diff --git a/gcc/testsuite/gfortran.dg/boz_7.f90 b/gcc/testsuite/gfortran.dg/boz_7.f90
new file mode 100644
index 000000000..348f561d4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_7.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=f95 -pedantic" }
+!
+! PR fortran/34342
+!
+! Some BOZ extensions where not diagnosed
+!
+integer :: k, m
+integer :: j = z'000abc' ! { dg-error "BOZ used outside a DATA statement" }
+data k/x'0003'/ ! { dg-error "uses non-standard syntax" }
+data m/'0003'z/ ! { dg-error "uses non-standard postfix syntax" }
+end
diff --git a/gcc/testsuite/gfortran.dg/boz_8.f90 b/gcc/testsuite/gfortran.dg/boz_8.f90
new file mode 100644
index 000000000..effce2ddc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_8.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/34342
+!
+! Diagnose BOZ literal for non-integer variables in
+! a DATA statement. Cf. Fortran 2003, 5.2.5 DATA statement:
+! "If a data-stmt-constant is a boz-literal-constant, the
+!  corresponding variable shall be of type integer."
+!
+real :: r
+integer :: i
+data i/z'111'/, r/z'4455'/ ! { dg-error "BOZ literal at .1. used to initialize non-integer variable 'r'" }
+r = z'FFFF' ! { dg-error "outside a DATA statement" }
+i = z'4455' ! { dg-error "outside a DATA statement" }
+r = real(z'FFFFFFFFF') ! { dg-error "is too large" }
+end
diff --git a/gcc/testsuite/gfortran.dg/boz_9.f90 b/gcc/testsuite/gfortran.dg/boz_9.f90
new file mode 100644
index 000000000..ec728cc65
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_9.f90
@@ -0,0 +1,118 @@
+! { dg-do run }
+! { dg-options "-fno-range-check" }
+!
+! PR fortran/34342
+!
+! Test for Fortran 2003 BOZ.
+!
+program f2003
+implicit none
+
+real,parameter             :: r2c = real(int(z'3333'))
+real,parameter             :: rc  = real(z'50CB9F09')
+double precision,parameter :: dc  = dble(Z'3FD34413509F79FF')
+complex,parameter          :: z1c = cmplx(b'11000001010001101101110110000011', 3.049426e-10)
+complex,parameter          :: z2c = cmplx(4.160326e16, o'6503667306')
+
+real             :: r2 = real(int(z'3333'))
+real             :: r  = real(z'50CB9F09')
+double precision :: d  = dble(Z'3FD34413509F79FF')
+complex          :: z1 = cmplx(b'11000001010001101101110110000011', 3.049426e-10)
+complex          :: z2 = cmplx(4.160326e16, o'6503667306')
+
+if (r2c /= 13107.0) call abort()
+if (rc  /= 2.732958e10) call abort()
+if (dc /= 0.30102999566398120d0) call abort()
+if (real(z1c) /= -1.242908e1 .or. aimag(z1c) /= 3.049426e-10) call abort()
+if (real(z2c) /= 4.160326e16 .or. aimag(z2c) /= 5.343285e-7) call abort()
+
+if (r2 /= 13107.0) call abort()
+if (r  /= 2.732958e10) call abort()
+if (d /= 0.30102999566398120d0) call abort()
+if (real(z1) /= -1.242908e1 .or. aimag(z1) /= 3.049426e-10) call abort()
+if (real(z2) /= 4.160326e16 .or. aimag(z2) /= 5.343285e-7) call abort()
+
+r2 = dble(int(z'3333'))
+r = real(z'50CB9F09')
+d = dble(Z'3FD34413509F79FF')
+z1 = cmplx(b'11000001010001101101110110000011', 3.049426e-10)
+z2 = cmplx(4.160326e16, o'6503667306')
+
+if (r2 /= 13107d0) call abort()
+if (r  /= 2.732958e10) call abort()
+if (d /= 0.30102999566398120d0) call abort()
+if (real(z1) /= -1.242908e1 .or. aimag(z1) /= 3.049426e-10) call abort()
+if (real(z2) /= 4.160326e16 .or. aimag(z2) /= 5.343285e-7) call abort()
+
+call test4()
+call test8()
+
+contains
+
+subroutine test4
+real,parameter             :: r2c = real(int(z'3333', kind=4), kind=4)
+real,parameter             :: rc  = real(z'50CB9F09', kind=4)
+complex,parameter          :: z1c = cmplx(b'11000001010001101101110110000011', 3.049426e-10, kind=4)
+complex,parameter          :: z2c = cmplx(4.160326e16, o'6503667306', kind=4)
+
+real             :: r2 = real(int(z'3333', kind=4), kind=4)
+real             :: r  = real(z'50CB9F09', kind=4)
+complex          :: z1 = cmplx(b'11000001010001101101110110000011', 3.049426e-10, kind=4)
+complex          :: z2 = cmplx(4.160326e16, o'6503667306', kind=4)
+
+if (r2c /= 13107.0) call abort()
+if (rc  /= 2.732958e10) call abort()
+if (real(z1) /= -1.242908e1 .or. aimag(z1) /= 3.049426e-10) call abort()
+if (real(z2) /= 4.160326e16 .or. aimag(z2) /= 5.343285e-7) call abort()
+
+if (r2 /= 13107.0) call abort()
+if (r  /= 2.732958e10) call abort()
+if (real(z1) /= -1.242908e1 .or. aimag(z1) /= 3.049426e-10) call abort()
+if (real(z2) /= 4.160326e16 .or. aimag(z2) /= 5.343285e-7) call abort()
+
+r2 = real(int(z'3333'), kind=4)
+r = real(z'50CB9F09', kind=4)
+z1 = cmplx(b'11000001010001101101110110000011', 3.049426e-10, kind=4)
+z2 = cmplx(4.160326e16, o'6503667306', kind=4)
+
+if (r2 /= 13107.0) call abort()
+if (r  /= 2.732958e10) call abort()
+if (real(z1) /= -1.242908e1 .or. aimag(z1) /= 3.049426e-10) call abort()
+if (real(z2) /= 4.160326e16 .or. aimag(z2) /= 5.343285e-7) call abort()
+end subroutine test4
+
+
+subroutine test8
+real(8),parameter     :: r2c = real(int(z'FFFFFF3333', kind=8), kind=8)
+real(8),parameter     :: rc  = real(z'AAAAAFFFFFFF3333', kind=8)
+complex(8),parameter  :: z1c = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
+complex(8),parameter  :: z2c = cmplx(5.0, o'442222222222233301245', kind=8)
+
+real(8)             :: r2 = real(int(z'FFFFFF3333',kind=8),kind=8)
+real(8)             :: r  = real(z'AAAAAFFFFFFF3333', kind=8)
+complex(8)          :: z1 = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
+complex(8)          :: z2 = cmplx(5.0, o'442222222222233301245', kind=8)
+
+if (r2c /= 1099511575347.0d0) call abort()
+if (rc  /= -3.72356884822177915d-103) call abort()
+if (real(z1c) /= 3.05175781249999627d-5 .or. aimag(z1c) /= -4.0) call abort()
+if (real(z2c) /= 5.0 .or. aimag(z2c) /= 3.98227593015308981d41) call abort()
+
+if (r2 /= 1099511575347.0d0) call abort()
+if (r  /= -3.72356884822177915d-103) call abort()
+if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) call abort()
+if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) call abort()
+
+r2 = real(int(z'FFFFFF3333',kind=8),kind=8)
+r  = real(z'AAAAAFFFFFFF3333', kind=8)
+z1 = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
+z2 = cmplx(5.0, o'442222222222233301245', kind=8)
+
+if (r2 /= 1099511575347.0d0) call abort()
+if (r  /= -3.72356884822177915d-103) call abort()
+if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) call abort()
+if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) call abort()
+
+end subroutine test8
+
+end program f2003
diff --git a/gcc/testsuite/gfortran.dg/btest_1.f90 b/gcc/testsuite/gfortran.dg/btest_1.f90
new file mode 100644
index 000000000..8a72c314c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/btest_1.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+program a
+   integer :: i = 42
+   logical l
+   l = btest(i, -1)  ! { dg-error "must be nonnegative" }
+   l = btest(i, 65)  ! { dg-error "must be less than" }
+end program a
diff --git a/gcc/testsuite/gfortran.dg/byte_1.f90 b/gcc/testsuite/gfortran.dg/byte_1.f90
new file mode 100644
index 000000000..6cac4216f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/byte_1.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-fall-intrinsics -std=f95" }
+program testbyte
+  integer(1) :: ii = 7
+  call foo(ii)
+end program testbyte
+
+subroutine foo(ii)
+  integer(1) ii
+  byte b          ! { dg-error "BYTE type" }
+  b = ii
+  call bar(ii,b)
+end subroutine foo
+
+subroutine bar(ii,b)
+  integer (1) ii
+  byte b          ! { dg-error "BYTE type" }
+  if (b.ne.ii) then
+!     print *,"Failed"
+     call abort
+  end if
+end subroutine bar
diff --git a/gcc/testsuite/gfortran.dg/byte_2.f90 b/gcc/testsuite/gfortran.dg/byte_2.f90
new file mode 100644
index 000000000..a41005557
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/byte_2.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+program testbyte
+  integer(1) :: ii = 7
+  call foo(ii)
+end program testbyte
+
+subroutine foo(ii)
+  integer(1) ii
+  byte b
+  b = ii
+  call bar(ii,b)
+end subroutine foo
+
+subroutine bar(ii,b)
+  integer (1) ii
+  byte b
+  if (b.ne.ii) then
+!     print *,"Failed"
+     call abort
+  end if
+end subroutine bar
diff --git a/gcc/testsuite/gfortran.dg/c_assoc.f90 b/gcc/testsuite/gfortran.dg/c_assoc.f90
new file mode 100644
index 000000000..7b34663a3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_assoc.f90
@@ -0,0 +1,70 @@
+! { dg-do run }
+! { dg-additional-sources test_c_assoc.c }
+module c_assoc
+  use, intrinsic :: iso_c_binding
+  implicit none
+
+contains
+
+  function test_c_assoc_0(my_c_ptr) bind(c)
+    use, intrinsic :: iso_c_binding, only: c_ptr, c_int, c_associated
+    integer(c_int) :: test_c_assoc_0
+    type(c_ptr), value :: my_c_ptr
+
+    if(c_associated(my_c_ptr)) then
+       test_c_assoc_0 = 1
+    else
+       test_c_assoc_0 = 0
+    endif
+  end function test_c_assoc_0
+
+  function test_c_assoc_1(my_c_ptr_1, my_c_ptr_2) bind(c)
+    use, intrinsic :: iso_c_binding, only: c_ptr, c_int, c_associated
+    integer(c_int) :: test_c_assoc_1
+    type(c_ptr), value :: my_c_ptr_1
+    type(c_ptr), value :: my_c_ptr_2
+
+    if(c_associated(my_c_ptr_1, my_c_ptr_2)) then
+       test_c_assoc_1 = 1
+    else
+       test_c_assoc_1 = 0
+    endif
+  end function test_c_assoc_1
+
+  function test_c_assoc_2(my_c_ptr_1, my_c_ptr_2, num_ptrs) bind(c)
+    integer(c_int) :: test_c_assoc_2
+    type(c_ptr), value :: my_c_ptr_1
+    type(c_ptr), value :: my_c_ptr_2
+    integer(c_int), value :: num_ptrs
+    
+    if(num_ptrs .eq. 1) then
+       if(c_associated(my_c_ptr_1)) then
+          test_c_assoc_2 = 1
+       else
+          test_c_assoc_2 = 0
+       endif
+    else
+       if(c_associated(my_c_ptr_1, my_c_ptr_2)) then
+          test_c_assoc_2 = 1
+       else
+          test_c_assoc_2 = 0
+       endif
+    endif
+  end function test_c_assoc_2
+
+  subroutine verify_assoc(my_c_ptr_1, my_c_ptr_2) bind(c)
+    type(c_ptr), value :: my_c_ptr_1
+    type(c_ptr), value :: my_c_ptr_2
+
+    if(.not. c_associated(my_c_ptr_1)) then
+       call abort()
+    else if(.not. c_associated(my_c_ptr_2)) then
+       call abort()
+    else if(.not. c_associated(my_c_ptr_1, my_c_ptr_2)) then
+       call abort()
+    endif
+  end subroutine verify_assoc
+  
+end module c_assoc
+
+! { dg-final { cleanup-modules "c_assoc" } }
diff --git a/gcc/testsuite/gfortran.dg/c_assoc_2.f03 b/gcc/testsuite/gfortran.dg/c_assoc_2.f03
new file mode 100644
index 000000000..4b3b7963a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_assoc_2.f03
@@ -0,0 +1,36 @@
+! { dg-do compile }
+module c_assoc_2
+  use, intrinsic :: iso_c_binding, only: c_ptr, c_associated
+
+contains
+  subroutine sub0(my_c_ptr) bind(c)
+    type(c_ptr), value :: my_c_ptr
+    type(c_ptr), pointer :: my_c_ptr_2
+    integer :: my_integer
+    
+    if(.not. c_associated(my_c_ptr)) then
+       call abort()
+    end if
+    
+    if(.not. c_associated(my_c_ptr, my_c_ptr)) then
+       call abort()
+    end if
+
+    if(.not. c_associated(my_c_ptr, my_c_ptr, my_c_ptr)) then ! { dg-error "More actual than formal arguments" }
+       call abort()
+    end if
+
+    if(.not. c_associated()) then ! { dg-error "Missing argument" }
+       call abort()
+    end if ! { dg-error "Expecting END SUBROUTINE" }
+
+    if(.not. c_associated(my_c_ptr_2)) then
+       call abort()
+    end if
+
+    if(.not. c_associated(my_integer)) then ! { dg-error "Type mismatch" }
+       call abort()
+    end if
+  end subroutine sub0
+
+end module c_assoc_2
diff --git a/gcc/testsuite/gfortran.dg/c_assoc_3.f90 b/gcc/testsuite/gfortran.dg/c_assoc_3.f90
new file mode 100644
index 000000000..0aceb42ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_assoc_3.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+!
+! PR fortran/43303
+!
+! Contributed by Dennis Wassel
+!
+PROGRAM c_assoc
+  use iso_c_binding
+  type(c_ptr) :: x
+  x = c_null_ptr
+  print *, C_ASSOCIATED(x) ! <<< was ICEing here
+  if (C_ASSOCIATED(x)) call abort ()
+END PROGRAM c_assoc
diff --git a/gcc/testsuite/gfortran.dg/c_by_val.c b/gcc/testsuite/gfortran.dg/c_by_val.c
new file mode 100644
index 000000000..617668619
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_by_val.c
@@ -0,0 +1,76 @@
+/*  Passing from fortran to C by value, using %VAL.  */
+
+#include <inttypes.h>
+
+/* We used to #include <complex.h>, but this fails for some platforms
+   (like cygwin) who don't have it yet.  */
+#define complex __complex__
+#define _Complex_I (1.0iF)
+
+extern void f_to_f__ (float*, float, float*, float**);
+extern void f_to_f8__ (double*, double, double*, double**);
+extern void i_to_i__ (int*, int, int*, int**);
+extern void i_to_i8__ (int64_t*, int64_t, int64_t*, int64_t**);
+extern void c_to_c__ (complex float*, complex float, complex float*, complex float**);
+extern void c_to_c8__ (complex double*, complex double, complex double*, complex double**);
+extern void abort (void);
+
+void
+f_to_f__(float *retval, float a1, float *a2, float **a3)
+{
+  if ( a1 != *a2 ) abort();
+  if ( a1 != **a3 ) abort();
+  a1 = 0.0;
+  *retval = *a2 * 2.0;
+  return;
+}
+
+void
+f_to_f8__(double *retval, double a1, double *a2, double **a3)
+{
+  if ( a1 != *a2 ) abort();
+  if ( a1 != **a3 ) abort();
+  a1 = 0.0;
+  *retval = *a2 * 2.0;
+  return;
+}
+
+void
+i_to_i__(int *retval, int i1, int *i2, int **i3)
+{
+  if ( i1 != *i2 ) abort();
+  if ( i1 != **i3 ) abort();
+  i1 = 0;
+  *retval = *i2 * 3;
+  return;
+}
+
+void
+i_to_i8__(int64_t *retval, int64_t i1, int64_t *i2, int64_t **i3)
+{
+  if ( i1 != *i2 ) abort();
+  if ( i1 != **i3 ) abort();
+  i1 = 0;
+  *retval = *i2 * 3;
+  return;
+}
+
+void
+c_to_c__(complex float *retval, complex float c1, complex float *c2, complex float **c3)
+{
+  if ( c1 != *c2    ) abort();
+  if ( c1 != *(*c3) ) abort();
+  c1 = 0.0 + 0.0 * _Complex_I;
+  *retval = (*c2) * 4.0;
+  return;
+}
+
+void
+c_to_c8__(complex double *retval, complex double c1, complex double *c2, complex double **c3)
+{
+  if ( c1 != *c2    ) abort();
+  if ( c1 != *(*c3) ) abort();
+  c1 = 0.0 +  0.0 * _Complex_I;;
+  *retval = (*c2) * 4.0;
+  return;
+}
diff --git a/gcc/testsuite/gfortran.dg/c_by_val_1.f b/gcc/testsuite/gfortran.dg/c_by_val_1.f
new file mode 100644
index 000000000..af1e25a6b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_by_val_1.f
@@ -0,0 +1,53 @@
+C { dg-do run }
+C { dg-additional-sources c_by_val.c }
+C { dg-options "-ff2c -w -O0" }
+
+      program c_by_val_1
+      external   f_to_f, i_to_i, c_to_c
+      external   f_to_f8, i_to_i8, c_to_c8
+      real       a, b, c
+      real(8)    a8, b8, c8
+      integer(4) i, j, k
+      integer(8) i8, j8, k8
+      complex    u, v, w, c_to_c
+      complex(8) u8, v8, w8, c_to_c8
+
+      a = 42.0
+      b = 0.0
+      c = a
+      call  f_to_f (b, %VAL (a), %REF (c), %LOC (c))
+      if ((2.0 * a).ne.b) call abort ()
+
+      a8 = 43.0
+      b8 = 1.0
+      c8 = a8
+      call  f_to_f8 (b8, %VAL (a8), %REF (c8), %LOC (c8))
+      if ((2.0 * a8).ne.b8) call abort ()
+
+      i = 99
+      j = 0
+      k = i
+      call i_to_i (j, %VAL (i), %REF (k), %LOC (k))
+      if ((3 * i).ne.j) call abort ()
+
+      i8 = 199
+      j8 = 10
+      k8 = i8
+      call i_to_i8 (j8, %VAL (i8), %REF (k8), %LOC (k8))
+      if ((3 * i8).ne.j8) call abort ()
+
+      u = (-1.0, 2.0)
+      v = (1.0, -2.0)
+      w = u
+      v = c_to_c (%VAL (u), %REF (w), %LOC (w))
+      if ((4.0 * u).ne.v) call abort ()
+
+      u8 = (-1.0, 2.0)
+      v8 = (1.0, -2.0)
+      w8 = u8
+      v8 = c_to_c8 (%VAL (u8), %REF (w8), %LOC (w8))
+      if ((4.0 * u8).ne.v8) call abort ()
+
+      stop
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/c_by_val_2.f90 b/gcc/testsuite/gfortran.dg/c_by_val_2.f90
new file mode 100644
index 000000000..5d638cbda
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_by_val_2.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-options "-w" }
+
+program c_by_val_2
+  external bar
+  real (4) :: bar, ar(2) = (/1.0,2.0/)
+  type     :: mytype
+    integer  :: i
+  end type mytype
+  type(mytype)  :: z
+  character(8)  :: c = "blooey"
+  real :: stmfun, x
+  stmfun(x)=x**2
+
+  x = 5
+  print *, stmfun(%VAL(x))   ! { dg-error "not allowed in this context" }
+  print *, sin (%VAL(2.0))   ! { dg-error "not allowed in this context" }
+  print *, foo (%VAL(1.0))   ! { dg-error "not allowed in this context" }
+  call  foobar (%VAL(0.5))   ! { dg-error "not allowed in this context" }
+  print *, bar (%VAL(z))     ! { dg-error "not of numeric type" }
+  print *, bar (%VAL(c))     ! { dg-error "not of numeric type" }
+  print *, bar (%VAL(ar))    ! { dg-error "cannot be an array" }
+  print *, bar (%VAL(0.0))
+contains
+  function foo (a)
+    real(4) :: a, foo
+    foo = cos (a)
+  end function foo
+  subroutine foobar (a)
+    real(4) :: a
+    print *, a
+  end subroutine foobar
+end program c_by_val_2
+
diff --git a/gcc/testsuite/gfortran.dg/c_by_val_3.f90 b/gcc/testsuite/gfortran.dg/c_by_val_3.f90
new file mode 100644
index 000000000..bf7aedf8b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_by_val_3.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+program c_by_val_3
+  external bar
+  real (4) :: bar
+  print *, bar (%VAL(0.0)) ! { dg-error "argument list function" }
+end program c_by_val_3
diff --git a/gcc/testsuite/gfortran.dg/c_by_val_4.f b/gcc/testsuite/gfortran.dg/c_by_val_4.f
new file mode 100644
index 000000000..c8f4b0484
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_by_val_4.f
@@ -0,0 +1,17 @@
+C { dg-do compile }
+C Tests the fix for PR30888, in which the dummy procedure would
+C generate an error with the %VAL argument, even though it is
+C declared EXTERNAL.
+C
+C Contributed by Peter W. Draper <p.w.draper@durham.ac.uk>
+C
+      SUBROUTINE VALTEST( DOIT )
+      EXTERNAL DOIT
+      INTEGER P
+      INTEGER I
+      I = 0
+      P = 0
+      CALL DOIT( %VAL( P ) ) ! { dg-warning "Extension: argument list function" }
+      CALL DOIT( I )
+      CALL DOIT( %VAL( P ) ) ! { dg-warning "Extension: argument list function" }
+      END
diff --git a/gcc/testsuite/gfortran.dg/c_by_val_5.f90 b/gcc/testsuite/gfortran.dg/c_by_val_5.f90
new file mode 100644
index 000000000..90ef299aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_by_val_5.f90
@@ -0,0 +1,69 @@
+! { dg-do run }
+! Overwrite -pedantic setting:
+! { dg-options "-Wall" }
+!
+! Tests the fix for PR31668, in which %VAL was rejected for
+! module and internal procedures.
+! 
+
+subroutine bmp_write(nx)
+  implicit none
+  integer, value :: nx
+  if(nx /= 10) call abort()
+  nx = 11
+  if(nx /= 11) call abort()
+end subroutine bmp_write
+
+module x
+ implicit none
+ ! The following interface does in principle
+ ! not match the procedure (missing VALUE attribute)
+ ! However, this occures in real-world code calling
+ ! C routines where an interface is better than
+ ! "external" only.
+ interface
+   subroutine bmp_write(nx)
+     integer :: nx
+   end subroutine bmp_write
+ end interface
+contains
+   SUBROUTINE Grid2BMP(NX)
+     INTEGER, INTENT(IN) :: NX
+     if(nx /= 10) call abort()
+     call bmp_write(%val(nx))
+     if(nx /= 10) call abort()
+   END SUBROUTINE Grid2BMP
+END module x
+
+! The following test is possible and
+! accepted by other compilers, but
+! does not make much sense.
+! Either one uses VALUE then %VAL is
+! not needed or the function will give
+! wrong results.
+!
+!subroutine test()
+!    implicit none
+!    integer :: n
+!    n = 5
+!    if(n /= 5) call abort()
+!    call test2(%VAL(n))
+!    if(n /= 5) call abort()
+!  contains
+!    subroutine test2(a)
+!      integer, value :: a
+!      if(a /= 5) call abort()
+!      a = 2
+!      if(a /= 2) call abort()
+!    end subroutine test2
+!end subroutine test
+
+program main
+  use x
+  implicit none
+!  external test
+  call Grid2BMP(10)
+!  call test()
+end program main
+
+! { dg-final { cleanup-modules "x" } }
diff --git a/gcc/testsuite/gfortran.dg/c_char_driver.c b/gcc/testsuite/gfortran.dg/c_char_driver.c
new file mode 100644
index 000000000..ca41ab1ed
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_char_driver.c
@@ -0,0 +1,14 @@
+void param_test(char my_char, char my_char_2);
+void sub0(void);
+void sub1(char *my_char);
+
+int main(int argc, char **argv)
+{
+  char my_char = 'y';
+  
+  param_test('y', 'z');
+  sub0();
+  sub1(&my_char);
+  
+  return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/c_char_tests.f03 b/gcc/testsuite/gfortran.dg/c_char_tests.f03
new file mode 100644
index 000000000..72b136e01
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_char_tests.f03
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-additional-sources c_char_driver.c }
+! Verify that character dummy arguments for bind(c) procedures can work both 
+! by-value and by-reference when called by either C or Fortran.
+! PR fortran/32732
+module c_char_tests
+  use, intrinsic :: iso_c_binding, only: c_char
+  implicit none
+contains
+  subroutine param_test(my_char, my_char_2) bind(c)
+    character(c_char), value :: my_char
+    character(c_char), value :: my_char_2
+    if(my_char /= c_char_'y') call abort()
+    if(my_char_2 /= c_char_'z') call abort()
+    
+    call sub1(my_char)
+  end subroutine param_test
+
+  subroutine sub0() bind(c)
+    call param_test('y', 'z')
+  end subroutine sub0
+
+  subroutine sub1(my_char_ref) bind(c)
+    character(c_char) :: my_char_ref
+    if(my_char_ref /= c_char_'y') call abort()
+  end subroutine sub1
+end module c_char_tests
+
+! { dg-final { cleanup-modules "c_char_tests" } }
diff --git a/gcc/testsuite/gfortran.dg/c_char_tests_2.f03 b/gcc/testsuite/gfortran.dg/c_char_tests_2.f03
new file mode 100644
index 000000000..4e5edb085
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_char_tests_2.f03
@@ -0,0 +1,33 @@
+! { dg-do run }
+! Verify that the changes made to character dummy arguments for bind(c) 
+! procedures doesn't break non-bind(c) routines.
+! PR fortran/32732
+subroutine bar(a)
+  use, intrinsic :: iso_c_binding, only: c_char
+  character(c_char), value :: a
+  if(a /= c_char_'a') call abort()
+end subroutine bar
+
+subroutine bar2(a)
+  use, intrinsic :: iso_c_binding, only: c_char
+  character(c_char) :: a
+  if(a /= c_char_'a') call abort()
+end subroutine bar2
+
+use iso_c_binding
+implicit none
+interface
+  subroutine bar(a)
+    import
+    character(c_char),value :: a
+  end subroutine bar
+  subroutine bar2(a)
+    import
+    character(c_char) :: a
+  end subroutine bar2
+end interface
+ character(c_char) :: z
+ z = 'a'
+ call bar(z)
+ call bar2(z)
+end
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_complex.f03 b/gcc/testsuite/gfortran.dg/c_f_pointer_complex.f03
new file mode 100644
index 000000000..fd9703139
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_complex.f03
@@ -0,0 +1,61 @@
+! { dg-do run }
+! { dg-additional-sources c_f_pointer_complex_driver.c }
+! { dg-options "-std=gnu -w" }
+! Test c_f_pointer for the different types of interoperable complex values.
+module c_f_pointer_complex
+  use, intrinsic :: iso_c_binding, only: c_float_complex, c_double_complex, &
+       c_long_double_complex, c_f_pointer, c_ptr, c_long_double, c_int
+  implicit none
+
+contains
+  subroutine test_complex_scalars(my_c_float_complex, my_c_double_complex, &
+       my_c_long_double_complex) bind(c)
+    type(c_ptr), value :: my_c_float_complex
+    type(c_ptr), value :: my_c_double_complex
+    type(c_ptr), value :: my_c_long_double_complex
+    complex(c_float_complex), pointer :: my_f03_float_complex
+    complex(c_double_complex), pointer :: my_f03_double_complex
+    complex(c_long_double_complex), pointer :: my_f03_long_double_complex
+    
+    call c_f_pointer(my_c_float_complex, my_f03_float_complex)
+    call c_f_pointer(my_c_double_complex, my_f03_double_complex)
+    call c_f_pointer(my_c_long_double_complex, my_f03_long_double_complex)
+
+    if(my_f03_float_complex /= (1.0, 0.0)) call abort ()
+    if(my_f03_double_complex /= (2.0d0, 0.0d0)) call abort ()
+    if(my_f03_long_double_complex /= (3.0_c_long_double, &
+         0.0_c_long_double)) call abort ()
+  end subroutine test_complex_scalars
+
+  subroutine test_complex_arrays(float_complex_array, double_complex_array, &
+       long_double_complex_array, num_elems) bind(c)
+    type(c_ptr), value :: float_complex_array
+    type(c_ptr), value :: double_complex_array
+    type(c_ptr), value :: long_double_complex_array    
+    complex(c_float_complex), pointer, dimension(:) :: f03_float_complex_array
+    complex(c_double_complex), pointer, dimension(:) :: &
+         f03_double_complex_array
+    complex(c_long_double_complex), pointer, dimension(:) :: &
+         f03_long_double_complex_array
+    integer(c_int), value :: num_elems
+    integer :: i
+
+    call c_f_pointer(float_complex_array, f03_float_complex_array, &
+         (/ num_elems /))
+    call c_f_pointer(double_complex_array, f03_double_complex_array, &
+         (/ num_elems /))
+    call c_f_pointer(long_double_complex_array, &
+         f03_long_double_complex_array, (/ num_elems /))
+
+    do i = 1, num_elems
+       if(f03_float_complex_array(i) &
+            /= (i*(1.0, 0.0))) call abort ()
+       if(f03_double_complex_array(i) &
+            /= (i*(1.0d0, 0.0d0))) call abort ()
+       if(f03_long_double_complex_array(i) &
+            /= (i*(1.0_c_long_double, 0.0_c_long_double))) call abort ()
+    end do
+  end subroutine test_complex_arrays
+end module c_f_pointer_complex
+! { dg-final { cleanup-modules "c_f_pointer_complex" } }
+
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_complex_driver.c b/gcc/testsuite/gfortran.dg/c_f_pointer_complex_driver.c
new file mode 100644
index 000000000..6286c3411
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_complex_driver.c
@@ -0,0 +1,41 @@
+/* { dg-options "-std=c99 -w" } */
+/* From c_by_val.c in gfortran.dg.  */
+#define _Complex_I (1.0iF)
+
+#define NUM_ELEMS 10
+
+void test_complex_scalars (float _Complex *float_complex_ptr,
+                           double _Complex *double_complex_ptr,
+                           long double _Complex *long_double_complex_ptr);
+void test_complex_arrays (float _Complex *float_complex_array,
+                          double _Complex *double_complex_array,
+                          long double _Complex *long_double_complex_array,
+                          int num_elems);
+
+int main (int argc, char **argv)
+{
+  float _Complex c1;
+  double _Complex c2;
+  long double _Complex c3;
+  float _Complex c1_array[NUM_ELEMS];
+  double _Complex c2_array[NUM_ELEMS];
+  long double _Complex c3_array[NUM_ELEMS];
+  int i;
+
+  c1 = 1.0 + 0.0 * _Complex_I;
+  c2 = 2.0 + 0.0 * _Complex_I;
+  c3 = 3.0 + 0.0 * _Complex_I;
+
+  test_complex_scalars (&c1, &c2, &c3);
+
+  for (i = 0; i < NUM_ELEMS; i++)
+    {
+      c1_array[i] = 1.0 * (i+1) + 0.0 * _Complex_I;
+      c2_array[i] = 1.0 * (i+1) + 0.0 * _Complex_I;
+      c3_array[i] = 1.0 * (i+1) + 0.0 * _Complex_I;
+    }
+
+  test_complex_arrays (c1_array, c2_array, c3_array, NUM_ELEMS);
+
+  return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_logical.f03 b/gcc/testsuite/gfortran.dg/c_f_pointer_logical.f03
new file mode 100644
index 000000000..977c4cb07
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_logical.f03
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-additional-sources c_f_pointer_logical_driver.c }
+! Verify that c_f_pointer exists for C logicals (_Bool).
+module c_f_pointer_logical
+  use, intrinsic :: iso_c_binding, only: c_bool, c_f_pointer, c_ptr, c_int
+contains
+  subroutine test_scalar(c_logical_ptr) bind(c)
+    type(c_ptr), value :: c_logical_ptr
+    logical(c_bool), pointer :: f03_logical_ptr
+    call c_f_pointer(c_logical_ptr, f03_logical_ptr)
+    
+    if(f03_logical_ptr .neqv. .true.) call abort ()
+  end subroutine test_scalar
+
+  subroutine test_array(c_logical_array, num_elems) bind(c)
+    type(c_ptr), value :: c_logical_array
+    integer(c_int), value :: num_elems
+    logical(c_bool), pointer, dimension(:) :: f03_logical_array
+    integer :: i
+
+    call c_f_pointer(c_logical_array, f03_logical_array, (/ num_elems /))
+
+    ! Odd numbered locations are true (even numbered offsets in C)
+    do i = 1, num_elems, 2
+       if(f03_logical_array(i) .neqv. .true.) call abort ()
+    end do
+    
+    ! Even numbered locations are false.
+    do i = 2, num_elems, 2
+       if(f03_logical_array(i) .neqv. .false.) call abort ()
+    end do
+  end subroutine test_array
+end module c_f_pointer_logical
+! { dg-final { cleanup-modules "c_f_pointer_logical" } }
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_logical_driver.c b/gcc/testsuite/gfortran.dg/c_f_pointer_logical_driver.c
new file mode 100644
index 000000000..e3044c92e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_logical_driver.c
@@ -0,0 +1,26 @@
+/* { dg-options "-std=c99 -w" } */
+
+#include <stdbool.h>
+
+#define NUM_ELEMS 10
+
+void test_scalar(_Bool *my_c_bool_ptr);
+void test_array(_Bool *my_bool_array, int num_elems);
+
+int main(int argc, char **argv)
+{
+  _Bool my_bool = true;
+  _Bool my_bool_array[NUM_ELEMS];
+  int i;
+
+  test_scalar(&my_bool);
+
+  for(i = 0; i < NUM_ELEMS; i+=2)
+    my_bool_array[i] = true;
+  for(i = 1; i < NUM_ELEMS; i+=2)
+    my_bool_array[i] = false;
+
+  test_array(my_bool_array, NUM_ELEMS);
+  
+  return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_test.f90 b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_test.f90
new file mode 100644
index 000000000..c6204bdac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_test.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! verify that the compiler catches the error in the call to c_f_pointer 
+! because it is missing the required SHAPE parameter.  the SHAPE parameter 
+! is optional, in general, but must exist if given a fortran pointer 
+! to a non-zero rank object.  --Rickett, 09.26.06
+module c_f_pointer_shape_test
+contains
+  subroutine test_0(myAssumedArray, cPtr)
+    use, intrinsic :: iso_c_binding
+    integer, dimension(*) :: myAssumedArray
+    integer, dimension(:), pointer :: myArrayPtr
+    integer, dimension(1:2), target :: myArray
+    type(c_ptr), value :: cPtr
+    
+    myArrayPtr => myArray
+    call c_f_pointer(cPtr, myArrayPtr) ! { dg-error "Missing SHAPE parameter" }
+  end subroutine test_0
+end module c_f_pointer_shape_test
+
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_2.f03 b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_2.f03
new file mode 100644
index 000000000..662908931
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_2.f03
@@ -0,0 +1,114 @@
+! { dg-do run }
+! { dg-additional-sources c_f_pointer_shape_tests_2_driver.c }
+! Verify that the optional SHAPE parameter to c_f_pointer can be of any
+! valid integer kind.  We don't test all kinds here since it would be 
+! difficult to know what kinds are valid for the architecture we're running on.
+! However, testing ones that should be different should be sufficient.
+module c_f_pointer_shape_tests_2
+  use, intrinsic :: iso_c_binding
+  implicit none
+contains
+  subroutine test_long_long_1d(cPtr, num_elems) bind(c)
+    use, intrinsic :: iso_c_binding
+    type(c_ptr), value :: cPtr
+    integer(c_int), value :: num_elems
+    integer, dimension(:), pointer :: myArrayPtr
+    integer(c_long_long), dimension(1) :: shape
+    integer :: i
+    
+    shape(1) = num_elems
+    call c_f_pointer(cPtr, myArrayPtr, shape) 
+    do i = 1, num_elems
+       if(myArrayPtr(i) /= (i-1)) call abort ()
+    end do
+  end subroutine test_long_long_1d
+
+  subroutine test_long_long_2d(cPtr, num_rows, num_cols) bind(c)
+    use, intrinsic :: iso_c_binding
+    type(c_ptr), value :: cPtr
+    integer(c_int), value :: num_rows
+    integer(c_int), value :: num_cols
+    integer, dimension(:,:), pointer :: myArrayPtr
+    integer(c_long_long), dimension(2) :: shape
+    integer :: i,j
+    
+    shape(1) = num_rows
+    shape(2) = num_cols
+    call c_f_pointer(cPtr, myArrayPtr, shape) 
+    do j = 1, num_cols
+       do i = 1, num_rows
+          if(myArrayPtr(i,j) /= ((j-1)*num_rows)+(i-1)) call abort ()
+       end do
+    end do
+  end subroutine test_long_long_2d
+
+  subroutine test_long_1d(cPtr, num_elems) bind(c)
+    use, intrinsic :: iso_c_binding
+    type(c_ptr), value :: cPtr
+    integer(c_int), value :: num_elems
+    integer, dimension(:), pointer :: myArrayPtr
+    integer(c_long), dimension(1) :: shape
+    integer :: i
+    
+    shape(1) = num_elems
+    call c_f_pointer(cPtr, myArrayPtr, shape) 
+    do i = 1, num_elems
+       if(myArrayPtr(i) /= (i-1)) call abort ()
+    end do
+  end subroutine test_long_1d
+
+  subroutine test_int_1d(cPtr, num_elems) bind(c)
+    use, intrinsic :: iso_c_binding
+    type(c_ptr), value :: cPtr
+    integer(c_int), value :: num_elems
+    integer, dimension(:), pointer :: myArrayPtr
+    integer(c_int), dimension(1) :: shape
+    integer :: i
+    
+    shape(1) = num_elems
+    call c_f_pointer(cPtr, myArrayPtr, shape) 
+    do i = 1, num_elems
+       if(myArrayPtr(i) /= (i-1)) call abort ()
+    end do
+  end subroutine test_int_1d
+
+  subroutine test_short_1d(cPtr, num_elems) bind(c)
+    use, intrinsic :: iso_c_binding
+    type(c_ptr), value :: cPtr
+    integer(c_int), value :: num_elems
+    integer, dimension(:), pointer :: myArrayPtr
+    integer(c_short), dimension(1) :: shape
+    integer :: i
+    
+    shape(1) = num_elems
+    call c_f_pointer(cPtr, myArrayPtr, shape) 
+    do i = 1, num_elems
+       if(myArrayPtr(i) /= (i-1)) call abort ()
+    end do
+  end subroutine test_short_1d
+
+  subroutine test_mixed(cPtr, num_elems) bind(c)
+    use, intrinsic :: iso_c_binding
+    type(c_ptr), value :: cPtr
+    integer(c_int), value :: num_elems
+    integer, dimension(:), pointer :: myArrayPtr
+    integer(c_int), dimension(1) :: shape1
+    integer(c_long_long), dimension(1) :: shape2
+    integer :: i
+
+    shape1(1) = num_elems
+    call c_f_pointer(cPtr, myArrayPtr, shape1) 
+    do i = 1, num_elems
+       if(myArrayPtr(i) /= (i-1)) call abort ()
+    end do
+
+    nullify(myArrayPtr)
+    shape2(1) = num_elems
+    call c_f_pointer(cPtr, myArrayPtr, shape2) 
+    do i = 1, num_elems
+       if(myArrayPtr(i) /= (i-1)) call abort ()
+    end do
+  end subroutine test_mixed
+end module c_f_pointer_shape_tests_2
+! { dg-final { cleanup-modules "c_f_pointer_shape_tests_2" } } 
+
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_2_driver.c b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_2_driver.c
new file mode 100644
index 000000000..1282beb12
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_2_driver.c
@@ -0,0 +1,46 @@
+#define NUM_ELEMS 10
+#define NUM_ROWS 2
+#define NUM_COLS 3
+
+void test_long_long_1d(int *array, int num_elems);
+void test_long_long_2d(int *array, int num_rows, int num_cols);
+void test_long_1d(int *array, int num_elems);
+void test_int_1d(int *array, int num_elems);
+void test_short_1d(int *array, int num_elems);
+void test_mixed(int *array, int num_elems);
+
+int main(int argc, char **argv)
+{
+  int my_array[NUM_ELEMS];
+  int my_2d_array[NUM_ROWS][NUM_COLS];
+  int i, j;
+
+  for(i = 0; i < NUM_ELEMS; i++)
+    my_array[i] = i;
+
+  for(i = 0; i < NUM_ROWS; i++)
+    for(j = 0; j < NUM_COLS; j++)
+      my_2d_array[i][j] = (i*NUM_COLS) + j;
+
+  /* Test c_f_pointer where SHAPE is of type integer, kind=c_long_long.  */
+  test_long_long_1d(my_array, NUM_ELEMS);
+
+  /* Test c_f_pointer where SHAPE is of type integer, kind=c_long_long.  
+     The indices are transposed for Fortran.  */
+  test_long_long_2d(my_2d_array[0], NUM_COLS, NUM_ROWS);
+
+  /* Test c_f_pointer where SHAPE is of type integer, kind=c_long.  */
+  test_long_1d(my_array, NUM_ELEMS);
+
+  /* Test c_f_pointer where SHAPE is of type integer, kind=c_int.  */
+  test_int_1d(my_array, NUM_ELEMS);
+
+  /* Test c_f_pointer where SHAPE is of type integer, kind=c_short.  */
+  test_short_1d(my_array, NUM_ELEMS);
+
+  /* Test c_f_pointer where SHAPE is of type integer, kind=c_int and
+	  kind=c_long_long.  */
+  test_mixed(my_array, NUM_ELEMS);
+
+  return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_3.f03 b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_3.f03
new file mode 100644
index 000000000..31fd93810
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_3.f03
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! Verify that the type and rank of the SHAPE argument are enforced.
+module c_f_pointer_shape_tests_3
+  use, intrinsic :: iso_c_binding
+  
+contains
+  subroutine sub0(my_c_array) bind(c)
+    type(c_ptr), value :: my_c_array
+    integer(c_int), dimension(:), pointer :: my_array_ptr
+    
+    call c_f_pointer(my_c_array, my_array_ptr, (/ 10.0 /)) ! { dg-error "must be a rank 1 INTEGER array" }
+  end subroutine sub0
+
+  subroutine sub1(my_c_array) bind(c)
+    type(c_ptr), value :: my_c_array
+    integer(c_int), dimension(:), pointer :: my_array_ptr
+    integer(c_int), dimension(1,1) :: shape
+
+    shape(1,1) = 10
+    call c_f_pointer(my_c_array, my_array_ptr, shape) ! { dg-error "must be a rank 1 INTEGER array" }
+  end subroutine sub1
+end module c_f_pointer_shape_tests_3
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_4.f03 b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_4.f03
new file mode 100644
index 000000000..89b8666d7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_4.f03
@@ -0,0 +1,115 @@
+! { dg-do run }
+! { dg-additional-sources c_f_pointer_shape_tests_2_driver.c }
+! Verify that the optional SHAPE parameter to c_f_pointer can be of any
+! valid integer kind.  We don't test all kinds here since it would be 
+! difficult to know what kinds are valid for the architecture we're running on.
+! However, testing ones that should be different should be sufficient.
+module c_f_pointer_shape_tests_4
+  use, intrinsic :: iso_c_binding
+  implicit none
+contains
+  subroutine test_long_long_1d(cPtr, num_elems) bind(c)
+    use, intrinsic :: iso_c_binding
+    type(c_ptr), value :: cPtr
+    integer(c_int), value :: num_elems
+    integer, dimension(:), pointer :: myArrayPtr
+    integer(c_long_long), dimension(1) :: shape
+    integer :: i
+    
+    shape(1) = num_elems
+    call c_f_pointer(cPtr, myArrayPtr, shape) 
+    do i = 1, num_elems
+       if(myArrayPtr(i) /= (i-1)) call abort ()
+    end do
+  end subroutine test_long_long_1d
+
+  subroutine test_long_long_2d(cPtr, num_rows, num_cols) bind(c)
+    use, intrinsic :: iso_c_binding
+    type(c_ptr), value :: cPtr
+    integer(c_int), value :: num_rows
+    integer(c_int), value :: num_cols
+    integer, dimension(:,:), pointer :: myArrayPtr
+    integer(c_long_long), dimension(3) :: shape
+    integer :: i,j
+    
+    shape(1) = num_rows
+    shape(2) = -3;
+    shape(3) = num_cols
+    call c_f_pointer(cPtr, myArrayPtr, shape(1:3:2)) 
+    do j = 1, num_cols
+       do i = 1, num_rows
+          if(myArrayPtr(i,j) /= ((j-1)*num_rows)+(i-1)) call abort ()
+       end do
+    end do
+  end subroutine test_long_long_2d
+
+  subroutine test_long_1d(cPtr, num_elems) bind(c)
+    use, intrinsic :: iso_c_binding
+    type(c_ptr), value :: cPtr
+    integer(c_int), value :: num_elems
+    integer, dimension(:), pointer :: myArrayPtr
+    integer(c_long), dimension(1) :: shape
+    integer :: i
+    
+    shape(1) = num_elems
+    call c_f_pointer(cPtr, myArrayPtr, shape) 
+    do i = 1, num_elems
+       if(myArrayPtr(i) /= (i-1)) call abort ()
+    end do
+  end subroutine test_long_1d
+
+  subroutine test_int_1d(cPtr, num_elems) bind(c)
+    use, intrinsic :: iso_c_binding
+    type(c_ptr), value :: cPtr
+    integer(c_int), value :: num_elems
+    integer, dimension(:), pointer :: myArrayPtr
+    integer(c_int), dimension(1) :: shape
+    integer :: i
+    
+    shape(1) = num_elems
+    call c_f_pointer(cPtr, myArrayPtr, shape) 
+    do i = 1, num_elems
+       if(myArrayPtr(i) /= (i-1)) call abort ()
+    end do
+  end subroutine test_int_1d
+
+  subroutine test_short_1d(cPtr, num_elems) bind(c)
+    use, intrinsic :: iso_c_binding
+    type(c_ptr), value :: cPtr
+    integer(c_int), value :: num_elems
+    integer, dimension(:), pointer :: myArrayPtr
+    integer(c_short), dimension(1) :: shape
+    integer :: i
+    
+    shape(1) = num_elems
+    call c_f_pointer(cPtr, myArrayPtr, shape) 
+    do i = 1, num_elems
+       if(myArrayPtr(i) /= (i-1)) call abort ()
+    end do
+  end subroutine test_short_1d
+
+  subroutine test_mixed(cPtr, num_elems) bind(c)
+    use, intrinsic :: iso_c_binding
+    type(c_ptr), value :: cPtr
+    integer(c_int), value :: num_elems
+    integer, dimension(:), pointer :: myArrayPtr
+    integer(c_int), dimension(1) :: shape1
+    integer(c_long_long), dimension(1) :: shape2
+    integer :: i
+
+    shape1(1) = num_elems
+    call c_f_pointer(cPtr, myArrayPtr, shape1) 
+    do i = 1, num_elems
+       if(myArrayPtr(i) /= (i-1)) call abort ()
+    end do
+
+    nullify(myArrayPtr)
+    shape2(1) = num_elems
+    call c_f_pointer(cPtr, myArrayPtr, shape2) 
+    do i = 1, num_elems
+       if(myArrayPtr(i) /= (i-1)) call abort ()
+    end do
+  end subroutine test_mixed
+end module c_f_pointer_shape_tests_4
+! { dg-final { cleanup-modules "c_f_pointer_shape_tests_4" } } 
+
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_4_driver.c b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_4_driver.c
new file mode 100644
index 000000000..1282beb12
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_4_driver.c
@@ -0,0 +1,46 @@
+#define NUM_ELEMS 10
+#define NUM_ROWS 2
+#define NUM_COLS 3
+
+void test_long_long_1d(int *array, int num_elems);
+void test_long_long_2d(int *array, int num_rows, int num_cols);
+void test_long_1d(int *array, int num_elems);
+void test_int_1d(int *array, int num_elems);
+void test_short_1d(int *array, int num_elems);
+void test_mixed(int *array, int num_elems);
+
+int main(int argc, char **argv)
+{
+  int my_array[NUM_ELEMS];
+  int my_2d_array[NUM_ROWS][NUM_COLS];
+  int i, j;
+
+  for(i = 0; i < NUM_ELEMS; i++)
+    my_array[i] = i;
+
+  for(i = 0; i < NUM_ROWS; i++)
+    for(j = 0; j < NUM_COLS; j++)
+      my_2d_array[i][j] = (i*NUM_COLS) + j;
+
+  /* Test c_f_pointer where SHAPE is of type integer, kind=c_long_long.  */
+  test_long_long_1d(my_array, NUM_ELEMS);
+
+  /* Test c_f_pointer where SHAPE is of type integer, kind=c_long_long.  
+     The indices are transposed for Fortran.  */
+  test_long_long_2d(my_2d_array[0], NUM_COLS, NUM_ROWS);
+
+  /* Test c_f_pointer where SHAPE is of type integer, kind=c_long.  */
+  test_long_1d(my_array, NUM_ELEMS);
+
+  /* Test c_f_pointer where SHAPE is of type integer, kind=c_int.  */
+  test_int_1d(my_array, NUM_ELEMS);
+
+  /* Test c_f_pointer where SHAPE is of type integer, kind=c_short.  */
+  test_short_1d(my_array, NUM_ELEMS);
+
+  /* Test c_f_pointer where SHAPE is of type integer, kind=c_int and
+	  kind=c_long_long.  */
+  test_mixed(my_array, NUM_ELEMS);
+
+  return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_tests.f90 b/gcc/testsuite/gfortran.dg/c_f_pointer_tests.f90
new file mode 100644
index 000000000..d35f9d1c1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_tests.f90
@@ -0,0 +1,70 @@
+! { dg-do run }
+! { dg-additional-sources c_f_tests_driver.c }
+module c_f_pointer_tests
+  use, intrinsic :: iso_c_binding
+
+  type myF90Derived
+     integer(c_int) :: cInt
+     real(c_double) :: cDouble
+     real(c_float) :: cFloat
+     integer(c_short) :: cShort
+     type(c_funptr) :: myFunPtr
+  end type myF90Derived
+
+  type dummyDerived
+     integer(c_int) :: myInt
+  end type dummyDerived
+
+  contains
+
+  subroutine testDerivedPtrs(myCDerived, derivedArray, arrayLen, &
+       derived2DArray, dim1, dim2) &
+       bind(c, name="testDerivedPtrs")
+    implicit none
+    type(c_ptr), value :: myCDerived
+    type(c_ptr), value :: derivedArray
+    integer(c_int), value :: arrayLen
+    type(c_ptr), value :: derived2DArray
+    integer(c_int), value :: dim1
+    integer(c_int), value :: dim2
+    type(myF90Derived), pointer :: myF90Type
+    type(myF90Derived), dimension(:), pointer :: myF90DerivedArray
+    type(myF90Derived), dimension(:,:), pointer :: derivedArray2D
+    ! one dimensional array coming in (derivedArray)
+    integer(c_int), dimension(1:1) :: shapeArray
+    integer(c_int), dimension(1:2) :: shapeArray2
+    type(myF90Derived), dimension(1:10), target :: tmpArray
+
+    call c_f_pointer(myCDerived, myF90Type)
+    ! make sure numbers are ok.  initialized in c_f_tests_driver.c
+    if(myF90Type%cInt .ne. 1) then
+       call abort()
+    endif
+    if(myF90Type%cDouble .ne. 2.0d0) then
+       call abort()
+    endif
+    if(myF90Type%cFloat .ne. 3.0) then
+       call abort()
+    endif
+    if(myF90Type%cShort .ne. 4) then
+       call abort()
+    endif
+
+    shapeArray(1) = arrayLen
+    call c_f_pointer(derivedArray, myF90DerivedArray, shapeArray)
+
+    ! upper bound of each dim is arrayLen2
+    shapeArray2(1) = dim1
+    shapeArray2(2) = dim2
+    call c_f_pointer(derived2DArray, derivedArray2D, shapeArray2)
+    ! make sure the last element is ok
+    if((derivedArray2D(dim1, dim2)%cInt .ne. 4) .or. &
+         (derivedArray2D(dim1, dim2)%cDouble .ne. 4.0d0) .or. &
+         (derivedArray2D(dim1, dim2)%cFloat .ne. 4.0) .or. &
+         (derivedArray2D(dim1, dim2)%cShort .ne. 4)) then
+       call abort()
+    endif
+  end subroutine testDerivedPtrs
+end module c_f_pointer_tests
+
+! { dg-final { cleanup-modules "c_f_pointer_tests" } }
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_tests_2.f03 b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_2.f03
new file mode 100644
index 000000000..3fe6dd66b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_2.f03
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! This should compile.  There was a bug in resolving c_f_pointer that was 
+! caused by not sorting the actual args to match the order of the formal args.
+! PR fortran/32800
+!
+FUNCTION C_F_STRING(CPTR) RESULT(FPTR)
+  USE ISO_C_BINDING
+  implicit none
+  TYPE(C_PTR), INTENT(IN) :: CPTR ! The C address
+  CHARACTER(KIND=C_CHAR), DIMENSION(:), POINTER :: FPTR
+  INTERFACE
+     FUNCTION strlen(string) RESULT(len) BIND(C,NAME="strlen")
+       import
+       TYPE(C_PTR), VALUE :: string ! A C pointer
+       integer(c_int) :: len
+     END FUNCTION strlen
+  END INTERFACE
+  CALL C_F_POINTER(FPTR=FPTR, CPTR=CPTR,SHAPE=[strlen(cptr)])
+END FUNCTION C_F_STRING
+
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90 b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90
new file mode 100644
index 000000000..3b28f52b4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+!
+! PR fortran/32600 c_f_pointer w/o shape
+! PR fortran/32580 c_f_procpointer
+!
+! Verify that c_f_prointer [w/o shape] and c_f_procpointer generate
+! the right code - and no library call
+
+program test
+  use iso_c_binding
+  implicit none
+  type(c_ptr)    :: cptr
+  type(c_funptr) :: cfunptr
+  integer(4), pointer :: fptr
+  integer(4), pointer :: fptr_array(:)
+  procedure(integer(4)), pointer :: fprocptr
+
+  call c_f_pointer(cptr, fptr)
+  call c_f_pointer(cptr, fptr_array, [ 1 ])
+  call c_f_procpointer(cfunptr, fprocptr)
+end program test
+
+! Make sure there is only a single function call:
+! { dg-final { scan-tree-dump-times "c_f" 1 "original" } }
+! { dg-final { scan-tree-dump-times "c_f_pointer" 1 "original" } }
+! { dg-final { scan-tree-dump-times "c_f_pointer_i4" 1 "original" } }
+!
+! Check scalar c_f_pointer
+! { dg-final { scan-tree-dump-times "  fptr = .integer.kind=4. .. cptr" 1 "original" } }
+!
+! Check c_f_procpointer
+! { dg-final { scan-tree-dump-times "  fprocptr = .integer.kind=4. .\\*<.*>. .void.. cfunptr;" 1 "original" } }
+!
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_tests_4.f90 b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_4.f90
new file mode 100644
index 000000000..4f5338d60
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_4.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+program main
+   use iso_c_binding, only: c_ptr, c_loc, c_f_pointer
+   implicit none
+   integer, dimension(2,1,2), target :: table
+   table = reshape ( (/ 1,2,-1,-2/), (/2,1,2/))
+   call set_table (c_loc (table))
+contains
+   subroutine set_table (cptr)
+     type(c_ptr), intent(in) :: cptr
+     integer, dimension(:,:,:), pointer :: table_tmp
+     call c_f_pointer (cptr, table_tmp, (/2,1,2/))
+     if (any(table_tmp /= table)) call abort
+   end subroutine set_table
+end program main
diff --git a/gcc/testsuite/gfortran.dg/c_f_tests_driver.c b/gcc/testsuite/gfortran.dg/c_f_tests_driver.c
new file mode 100644
index 000000000..5079cf799
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_f_tests_driver.c
@@ -0,0 +1,66 @@
+extern void abort(void);
+
+typedef struct myCDerived
+{
+   int cInt;
+   double cDouble;
+   float cFloat;
+   short cShort;
+   void *ptr;
+}myCDerived_t;
+
+#define DERIVED_ARRAY_LEN 10
+#define ARRAY_LEN_2 3
+#define DIM1 2
+#define DIM2 3
+
+void testDerivedPtrs(myCDerived_t *cDerivedPtr,
+                     myCDerived_t *derivedArray, int arrayLen,
+                     myCDerived_t *derived2d, int dim1, int dim2);
+
+int main(int argc, char **argv)
+{
+   myCDerived_t cDerived;
+   myCDerived_t derivedArray[DERIVED_ARRAY_LEN];
+   myCDerived_t derived2DArray[DIM1][DIM2];
+   int i = 0;
+   int j = 0;
+
+   cDerived.cInt = 1;
+   cDerived.cDouble = 2.0;
+   cDerived.cFloat = 3.0;
+   cDerived.cShort = 4;
+/*    cDerived.ptr = NULL; */
+   /* nullify the ptr */
+   cDerived.ptr = 0;
+
+   for(i = 0; i < DERIVED_ARRAY_LEN; i++)
+   {
+      derivedArray[i].cInt = (i+1) * 1;
+      derivedArray[i].cDouble = (i+1) * 1.0; /* 2.0; */
+      derivedArray[i].cFloat = (i+1) * 1.0; /* 3.0; */
+      derivedArray[i].cShort = (i+1) * 1; /* 4; */
+/*       derivedArray[i].ptr = NULL; */
+      derivedArray[i].ptr = 0;
+   }
+
+   for(i = 0; i < DIM1; i++)
+   {
+      for(j = 0; j < DIM2; j++)
+      {
+         derived2DArray[i][j].cInt = ((i*DIM1) * 1) + j;
+         derived2DArray[i][j].cDouble = ((i*DIM1) * 1.0) + j;
+         derived2DArray[i][j].cFloat = ((i*DIM1) * 1.0) + j;
+         derived2DArray[i][j].cShort = ((i*DIM1) * 1) + j;
+/*          derived2DArray[i][j].ptr = NULL; */
+         derived2DArray[i][j].ptr = 0;
+      }
+   }
+
+   /* send in the transpose size (dim2 is dim1, dim1 is dim2) */
+   testDerivedPtrs(&cDerived, derivedArray, DERIVED_ARRAY_LEN,
+                   derived2DArray[0], DIM2, DIM1);
+   
+   return 0;
+}/* end main() */
+
diff --git a/gcc/testsuite/gfortran.dg/c_funloc_tests.f03 b/gcc/testsuite/gfortran.dg/c_funloc_tests.f03
new file mode 100644
index 000000000..8ba07b9fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_funloc_tests.f03
@@ -0,0 +1,21 @@
+! { dg-do run }
+! This test case simply checks that c_funloc exists, accepts arguments of 
+! flavor FL_PROCEDURE, and returns the type c_funptr
+module c_funloc_tests
+  use, intrinsic :: iso_c_binding, only: c_funptr, c_funloc
+
+contains
+  recursive subroutine sub0() bind(c)
+    type(c_funptr) :: my_c_funptr
+
+    my_c_funptr = c_funloc(sub0)
+  end subroutine sub0
+end module c_funloc_tests
+
+program driver
+  use c_funloc_tests
+  
+  call sub0()
+end program driver
+
+! { dg-final { cleanup-modules "c_funloc_tests" } }
diff --git a/gcc/testsuite/gfortran.dg/c_funloc_tests_2.f03 b/gcc/testsuite/gfortran.dg/c_funloc_tests_2.f03
new file mode 100644
index 000000000..d3ed265ea
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_funloc_tests_2.f03
@@ -0,0 +1,16 @@
+! { dg-do compile }
+module c_funloc_tests_2
+  use, intrinsic :: iso_c_binding, only: c_funptr, c_funloc
+  implicit none
+
+contains
+  recursive subroutine sub0() bind(c)
+    type(c_funptr) :: my_c_funptr
+    integer :: my_local_variable
+    
+    my_c_funptr = c_funloc() ! { dg-error "Missing argument" }
+    my_c_funptr = c_funloc(sub0)
+    my_c_funptr = c_funloc(sub0, sub0) ! { dg-error "More actual than formal" }
+    my_c_funptr = c_funloc(my_local_variable) ! { dg-error "must be a procedure" }
+  end subroutine sub0
+end module c_funloc_tests_2
diff --git a/gcc/testsuite/gfortran.dg/c_funloc_tests_3.f03 b/gcc/testsuite/gfortran.dg/c_funloc_tests_3.f03
new file mode 100644
index 000000000..2d23efb24
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_funloc_tests_3.f03
@@ -0,0 +1,36 @@
+! { dg-do run }
+! { dg-additional-sources c_funloc_tests_3_funcs.c }
+! This testcase tests c_funloc and c_funptr from iso_c_binding.  It uses 
+! functions defined in c_funloc_tests_3_funcs.c.
+module c_funloc_tests_3
+ implicit none
+contains
+  function ffunc(j) bind(c)
+    use iso_c_binding, only: c_funptr, c_int
+    integer(c_int)        :: ffunc
+    integer(c_int), value :: j
+    ffunc = -17*j
+  end function ffunc
+end module c_funloc_tests_3
+program main
+  use iso_c_binding, only: c_funptr, c_funloc
+  use c_funloc_tests_3, only: ffunc
+  implicit none
+  interface
+    function returnFunc() bind(c,name="returnFunc")
+       use iso_c_binding, only: c_funptr
+       type(c_funptr) :: returnFunc
+    end function returnFunc
+    subroutine callFunc(func,pass,compare) bind(c,name="callFunc")
+       use iso_c_binding, only: c_funptr, c_int
+       type(c_funptr), value :: func
+       integer(c_int), value :: pass,compare
+    end subroutine callFunc
+  end interface
+  type(c_funptr) :: p
+  p = returnFunc()
+  call callFunc(p, 13,3*13)
+  p = c_funloc(ffunc)
+  call callFunc(p, 21,-17*21)
+end program main
+! { dg-final { cleanup-modules "c_funloc_tests_3" } }
diff --git a/gcc/testsuite/gfortran.dg/c_funloc_tests_3_funcs.c b/gcc/testsuite/gfortran.dg/c_funloc_tests_3_funcs.c
new file mode 100644
index 000000000..994da0a50
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_funloc_tests_3_funcs.c
@@ -0,0 +1,25 @@
+/* These functions support the test case c_funloc_tests_3.  */
+#include <stdlib.h>
+#include <stdio.h>
+
+int printIntC(int i)
+{
+  return 3*i;
+}
+
+int (*returnFunc(void))(int)
+{
+  return &printIntC;
+}
+
+void callFunc(int(*func)(int), int pass, int compare)
+{
+  int result = (*func)(pass);
+  if(result != compare)
+    {
+       printf("FAILED: Got %d, expected %d\n", result, compare);
+       abort();
+    }
+  else
+    printf("SUCCESS: Got %d, expected %d\n", result, compare);
+}
diff --git a/gcc/testsuite/gfortran.dg/c_funloc_tests_4.f03 b/gcc/testsuite/gfortran.dg/c_funloc_tests_4.f03
new file mode 100644
index 000000000..0733c5e20
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_funloc_tests_4.f03
@@ -0,0 +1,40 @@
+! { dg-do run }
+! { dg-additional-sources c_funloc_tests_4_driver.c }
+! Test that the inlined c_funloc works.
+module c_funloc_tests_4
+  use, intrinsic :: iso_c_binding, only: c_funloc, c_funptr
+  interface
+     subroutine c_sub0(fsub_ptr) bind(c)
+       use, intrinsic :: iso_c_binding, only: c_funptr
+       type(c_funptr), value :: fsub_ptr
+     end subroutine c_sub0
+     subroutine c_sub1(ffunc_ptr) bind(c)
+       use, intrinsic :: iso_c_binding, only: c_funptr
+       type(c_funptr), value :: ffunc_ptr
+     end subroutine c_sub1
+  end interface
+contains
+  subroutine sub0() bind(c)
+    type(c_funptr) :: my_c_funptr
+
+    my_c_funptr = c_funloc(sub1)
+    call c_sub0(my_c_funptr)
+
+    my_c_funptr = c_funloc(func0)
+    call c_sub1(my_c_funptr)
+  end subroutine sub0
+
+  subroutine sub1() bind(c)
+    print *, 'hello from sub1'
+  end subroutine sub1
+
+  function func0(desired_retval) bind(c)
+    use, intrinsic :: iso_c_binding, only: c_int
+    integer(c_int), value :: desired_retval
+    integer(c_int) :: func0
+    print *, 'hello from func0'
+    func0 = desired_retval
+  end function func0
+end module c_funloc_tests_4
+! { dg-final { cleanup-modules "c_funloc_tests_4" } }
+
diff --git a/gcc/testsuite/gfortran.dg/c_funloc_tests_4_driver.c b/gcc/testsuite/gfortran.dg/c_funloc_tests_4_driver.c
new file mode 100644
index 000000000..17e4e6501
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_funloc_tests_4_driver.c
@@ -0,0 +1,39 @@
+#include <stdio.h>
+
+void sub0(void);
+void c_sub0(void (*sub)(void));
+void c_sub1(int (*func)(int));
+
+extern void abort(void);
+
+int main(int argc, char **argv)
+{
+  printf("hello from C main\n");
+  
+  sub0();
+  return 0;
+}
+
+void c_sub0(void (*sub)(void))
+{
+  printf("hello from c_sub0\n");
+  sub();
+  
+  return;
+}
+
+void c_sub1(int (*func)(int))
+{
+  int retval;
+  
+  printf("hello from c_sub1\n");
+
+  retval = func(10);
+  if(retval != 10)
+  {
+    fprintf(stderr, "Fortran function did not return expected value!\n");
+    abort();
+  }
+
+  return;
+}
diff --git a/gcc/testsuite/gfortran.dg/c_funloc_tests_5.f03 b/gcc/testsuite/gfortran.dg/c_funloc_tests_5.f03
new file mode 100644
index 000000000..bbb418de6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_funloc_tests_5.f03
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! Test that the arg checking for c_funloc verifies the procedures are 
+! C interoperable.
+module c_funloc_tests_5
+  use, intrinsic :: iso_c_binding, only: c_funloc, c_funptr
+contains
+  subroutine sub0() bind(c)
+    type(c_funptr) :: my_c_funptr
+
+    my_c_funptr = c_funloc(sub1) ! { dg-error "must be BIND.C." }
+
+    my_c_funptr = c_funloc(func0) ! { dg-error "must be BIND.C." }
+  end subroutine sub0
+
+  subroutine sub1() 
+  end subroutine sub1
+
+  function func0(desired_retval) 
+    use, intrinsic :: iso_c_binding, only: c_int
+    integer(c_int), value :: desired_retval
+    integer(c_int) :: func0
+    func0 = desired_retval
+  end function func0
+end module c_funloc_tests_5
+
+
diff --git a/gcc/testsuite/gfortran.dg/c_kind_int128_test1.f03 b/gcc/testsuite/gfortran.dg/c_kind_int128_test1.f03
new file mode 100644
index 000000000..b1919614b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_kind_int128_test1.f03
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! { dg-require-effective-target fortran_integer_16 }
+!
+
+subroutine c_kind_int128_1
+  use, intrinsic :: iso_c_binding
+  implicit none
+
+  integer(c_int128_t) :: a   ! { dg-error "has no IMPLICIT type" }
+  integer(c_int_least128_t) :: b   ! { dg-error "has no IMPLICIT type" }
+  integer(c_int_fast128_t) :: c   ! { dg-error "has no IMPLICIT type" }
+
+end subroutine c_kind_int128_1
+
+
+subroutine c_kind_int128_2
+  use, intrinsic :: iso_c_binding
+
+  integer(c_int128_t) :: a   ! { dg-error "has not been declared or is a variable" }
+  integer(c_int_least128_t) :: b   ! { dg-error "has not been declared or is a variable" }
+  integer(c_int_fast128_t) :: c   ! { dg-error "has not been declared or is a variable" }
+
+end subroutine c_kind_int128_2
diff --git a/gcc/testsuite/gfortran.dg/c_kind_int128_test2.f03 b/gcc/testsuite/gfortran.dg/c_kind_int128_test2.f03
new file mode 100644
index 000000000..4fe2dac29
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_kind_int128_test2.f03
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+! { dg-require-effective-target fortran_integer_16 }
+!
+! Note: int_fast128_t currently not supported.
+
+program c_kind_int128
+  use, intrinsic :: iso_c_binding
+  integer(c_int128_t) :: a  
+  integer(c_int_least128_t) :: b  
+! integer(c_int_fast128_t) :: c
+    
+  if (sizeof (a) /= 16) call abort 
+  if (sizeof (b) /= 16) call abort 
+!  if (sizeof (c) /= 16) call abort 
+end program c_kind_int128
diff --git a/gcc/testsuite/gfortran.dg/c_kind_params.f90 b/gcc/testsuite/gfortran.dg/c_kind_params.f90
new file mode 100644
index 000000000..417615788
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_kind_params.f90
@@ -0,0 +1,77 @@
+! { dg-do run }
+! { dg-require-effective-target stdint_types }
+! { dg-additional-sources c_kinds.c }
+! { dg-options "-w -std=c99" }
+! the -w option is needed to make f951 not report a warning for 
+! the -std=c99 option that the C file needs.
+!
+module c_kind_params
+  use, intrinsic :: iso_c_binding
+  implicit none
+
+contains
+  subroutine param_test(my_short, my_int, my_long, my_long_long, &
+       my_int8_t, my_int_least8_t, my_int_fast8_t, &
+       my_int16_t, my_int_least16_t, my_int_fast16_t, &
+       my_int32_t, my_int_least32_t, my_int_fast32_t, &
+       my_int64_t, my_int_least64_t, my_int_fast64_t, &
+       my_intmax_t, my_intptr_t, my_float, my_double, my_long_double, &
+       my_char, my_bool) bind(c)
+    integer(c_short), value :: my_short
+    integer(c_int), value :: my_int
+    integer(c_long), value :: my_long
+    integer(c_long_long), value :: my_long_long
+    integer(c_int8_t), value :: my_int8_t
+    integer(c_int_least8_t), value :: my_int_least8_t
+    integer(c_int_fast8_t), value :: my_int_fast8_t
+    integer(c_int16_t), value :: my_int16_t
+    integer(c_int_least16_t), value :: my_int_least16_t
+    integer(c_int_fast16_t), value :: my_int_fast16_t
+    integer(c_int32_t), value :: my_int32_t
+    integer(c_int_least32_t), value :: my_int_least32_t
+    integer(c_int_fast32_t), value :: my_int_fast32_t
+    integer(c_int64_t), value :: my_int64_t
+    integer(c_int_least64_t), value :: my_int_least64_t
+    integer(c_int_fast64_t), value :: my_int_fast64_t
+    integer(c_intmax_t), value :: my_intmax_t
+    integer(c_intptr_t), value :: my_intptr_t
+    real(c_float), value :: my_float
+    real(c_double), value :: my_double
+    real(c_long_double), value :: my_long_double
+    character(c_char), value :: my_char
+    logical(c_bool), value :: my_bool
+
+    if(my_short     /= 1_c_short)     call abort()
+    if(my_int       /= 2_c_int)       call abort()
+    if(my_long      /= 3_c_long)      call abort()
+    if(my_long_long /= 4_c_long_long) call abort()
+
+    if(my_int8_t      /= 1_c_int8_t)        call abort()
+    if(my_int_least8_t  /= 2_c_int_least8_t ) call abort()
+    if(my_int_fast8_t  /= 3_c_int_fast8_t ) call abort()
+
+    if(my_int16_t     /= 1_c_int16_t)       call abort()
+    if(my_int_least16_t /= 2_c_int_least16_t) call abort()
+    if(my_int_fast16_t  /= 3_c_int_fast16_t ) call abort()
+
+    if(my_int32_t     /= 1_c_int32_t)       call abort()
+    if(my_int_least32_t /= 2_c_int_least32_t) call abort()
+    if(my_int_fast32_t  /= 3_c_int_fast32_t ) call abort()
+
+    if(my_int64_t     /= 1_c_int64_t)       call abort()
+    if(my_int_least64_t /= 2_c_int_least64_t) call abort()
+    if(my_int_fast64_t  /= 3_c_int_fast64_t ) call abort()
+
+    if(my_intmax_t /= 1_c_intmax_t) call abort()
+    if(my_intptr_t /= 0_c_intptr_t) call abort()
+
+    if(my_float       /= 1.0_c_float) call abort()
+    if(my_double      /= 2.0_c_double) call abort()
+    if(my_long_double /= 3.0_c_long_double) call abort()
+
+    if(my_char        /= c_char_'y') call abort()
+    if(my_bool      .neqv. .true._c_bool) call abort()
+  end subroutine param_test
+    
+end module c_kind_params
+! { dg-final { cleanup-modules "c_kind_params" } }
diff --git a/gcc/testsuite/gfortran.dg/c_kind_tests_2.f03 b/gcc/testsuite/gfortran.dg/c_kind_tests_2.f03
new file mode 100644
index 000000000..a8cdbdff5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_kind_tests_2.f03
@@ -0,0 +1,15 @@
+! { dg-do compile }
+module c_kind_tests_2
+  use, intrinsic :: iso_c_binding
+
+  integer, parameter :: myF = c_float
+  real(myF), bind(c) :: myCFloat
+  integer(myF), bind(c) :: myCInt       ! { dg-warning "is for type REAL" }
+  integer(c_double), bind(c) :: myCInt2 ! { dg-warning "is for type REAL" }
+
+  integer, parameter :: myI = c_int
+  real(myI) :: myReal             ! { dg-warning "is for type INTEGER" }
+  real(myI), bind(c) :: myCFloat2 ! { dg-warning "is for type INTEGER" }
+  real(4), bind(c) :: myFloat     ! { dg-warning "may not be a C interoperable" }
+end module c_kind_tests_2
+! { dg-final { cleanup-modules "c_kind_tests_2" } }
diff --git a/gcc/testsuite/gfortran.dg/c_kind_tests_3.f03 b/gcc/testsuite/gfortran.dg/c_kind_tests_3.f03
new file mode 100644
index 000000000..5d5f3ab19
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_kind_tests_3.f03
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! PR 47023: [4.6/4.7 regression] C_Sizeof: Rejects valid code
+!
+! Contributed by <florian.rathgeber@gmail.com>
+
+  use iso_c_binding
+  real(c_double) x
+  print *, c_sizeof(x)
+  print *, c_sizeof(0.0_c_double)
+end 
diff --git a/gcc/testsuite/gfortran.dg/c_kinds.c b/gcc/testsuite/gfortran.dg/c_kinds.c
new file mode 100644
index 000000000..8fb658a98
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_kinds.c
@@ -0,0 +1,53 @@
+/* { dg-do compile } */
+/* { dg-options "-std=c99" } */
+
+#include <stdint.h>
+
+void param_test(short int my_short, int my_int, long int my_long,
+                long long int my_long_long, int8_t my_int8_t,
+                int_least8_t my_int_least8_t, int_fast8_t my_int_fast8_t,
+                int16_t my_int16_t, int_least16_t my_int_least16_t,
+                int_fast16_t my_int_fast16_t, int32_t my_int32_t,
+                int_least32_t my_int_least32_t, int_fast32_t my_int_fast32_t,
+                int64_t my_int64_t, int_least64_t my_int_least64_t,
+                int_fast64_t my_int_fast64_t, intmax_t my_intmax_t,
+                intptr_t my_intptr_t, float my_float, double my_double,
+                long double my_long_double, char my_char, _Bool my_bool);
+   
+
+int main(int argc, char **argv)
+{
+   short int my_short = 1;
+   int my_int = 2;
+   long int my_long = 3;
+   long long int my_long_long = 4;
+   int8_t my_int8_t = 1;
+   int_least8_t my_int_least8_t = 2;
+   int_fast8_t my_int_fast8_t = 3;
+   int16_t my_int16_t = 1;
+   int_least16_t my_int_least16_t = 2;
+   int_fast16_t my_int_fast16_t = 3;
+   int32_t my_int32_t = 1;
+   int_least32_t my_int_least32_t = 2;
+   int_fast32_t my_int_fast32_t = 3;
+   int64_t my_int64_t = 1;
+   int_least64_t my_int_least64_t = 2;
+   int_fast64_t my_int_fast64_t = 3;
+   intmax_t my_intmax_t = 1;
+   intptr_t my_intptr_t = 0;  
+   float my_float = 1.0;
+   double my_double = 2.0;
+   long double my_long_double = 3.0;
+   char my_char = 'y';
+   _Bool my_bool = 1;
+
+   param_test(my_short, my_int, my_long, my_long_long, my_int8_t,
+              my_int_least8_t, my_int_fast8_t, my_int16_t,
+              my_int_least16_t, my_int_fast16_t, my_int32_t,
+              my_int_least32_t, my_int_fast32_t, my_int64_t,
+              my_int_least64_t, my_int_fast64_t, my_intmax_t,
+              my_intptr_t, my_float, my_double, my_long_double, my_char,
+              my_bool);
+
+   return 0;
+}/* end main() */
diff --git a/gcc/testsuite/gfortran.dg/c_loc_driver.c b/gcc/testsuite/gfortran.dg/c_loc_driver.c
new file mode 100644
index 000000000..9e0104396
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_driver.c
@@ -0,0 +1,17 @@
+/* in fortran module */
+void test0(void);
+
+extern void abort(void);
+
+int main(int argc, char **argv)
+{
+   test0();
+   return 0;
+}/* end main() */
+
+void test_address(void *c_ptr, int expected_value)
+{
+   if((*(int *)(c_ptr)) != expected_value)
+      abort();
+   return;
+}/* end test_address() */
diff --git a/gcc/testsuite/gfortran.dg/c_loc_pure_1.f90 b/gcc/testsuite/gfortran.dg/c_loc_pure_1.f90
new file mode 100644
index 000000000..911f5429d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_pure_1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-Wimplicit-interface" }
+! PR 38220 - c_loc is pure and has an explicit interface
+USE ISO_C_BINDING, ONLY: C_PTR, C_LOC
+CONTAINS
+  PURE SUBROUTINE F(x)
+    INTEGER, INTENT(in), TARGET :: x
+    TYPE(C_PTR) :: px
+    px = C_LOC(x)
+  END SUBROUTINE
+END
diff --git a/gcc/testsuite/gfortran.dg/c_loc_test.f90 b/gcc/testsuite/gfortran.dg/c_loc_test.f90
new file mode 100644
index 000000000..673e6f728
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_test.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-additional-sources c_loc_driver.c }
+module c_loc_test
+implicit none
+
+contains
+  subroutine test0() bind(c)
+    use, intrinsic :: iso_c_binding
+    implicit none
+    integer, target :: x
+    type(c_ptr) :: my_c_ptr
+    interface
+       subroutine test_address(x, expected_value) bind(c)
+         use, intrinsic :: iso_c_binding
+         type(c_ptr), value :: x
+         integer(c_int), value :: expected_value
+       end subroutine test_address
+    end interface
+    x = 100
+    my_c_ptr = c_loc(x)
+    call test_address(my_c_ptr, 100)
+  end subroutine test0
+end module c_loc_test
+! { dg-final { cleanup-modules "c_loc_test" } }
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03
new file mode 100644
index 000000000..867ba18cc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03
@@ -0,0 +1,8 @@
+! { dg-do compile }
+subroutine aaa(in)
+  use iso_c_binding
+  implicit none
+  integer(KIND=C_int), DIMENSION(:), TARGET  :: in
+  type(c_ptr) :: cptr
+  cptr = c_loc(in) ! { dg-error "not C interoperable" }
+end subroutine aaa
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03
new file mode 100644
index 000000000..197666d30
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03
@@ -0,0 +1,49 @@
+! { dg-do compile }
+! Test argument checking for C_LOC with subcomponent parameters.
+module c_vhandle_mod
+  use iso_c_binding
+  
+  type double_vector_item
+    real(kind(1.d0)), allocatable :: v(:)
+  end type double_vector_item
+  type(double_vector_item), allocatable, target :: dbv_pool(:)
+  real(kind(1.d0)), allocatable, target :: vv(:)
+
+  type foo
+     integer :: i
+  end type foo
+  type foo_item
+     type(foo), pointer  :: v => null()
+  end type foo_item
+  type(foo_item), allocatable :: foo_pool(:)
+
+  type foo_item2
+     type(foo), pointer  :: v(:) => null()
+  end type foo_item2
+  type(foo_item2), allocatable :: foo_pool2(:)
+
+
+contains 
+
+  type(c_ptr) function get_double_vector_address(handle)
+    integer(c_int), intent(in) :: handle
+    
+    if (.true.) then   ! The ultimate component is an allocatable target 
+      get_double_vector_address = c_loc(dbv_pool(handle)%v)
+    else
+      get_double_vector_address = c_loc(vv)
+    endif
+    
+  end function get_double_vector_address
+
+
+  type(c_ptr) function get_foo_address(handle)
+    integer(c_int), intent(in) :: handle    
+    get_foo_address = c_loc(foo_pool(handle)%v)    
+
+    get_foo_address = c_loc(foo_pool2(handle)%v) ! { dg-error "must be a scalar" } 
+  end function get_foo_address
+
+    
+end module c_vhandle_mod
+
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_12.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_12.f03
new file mode 100644
index 000000000..252c1c527
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_12.f03
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! 
+! Test for PR 35150, reduced testcases by Tobias Burnus
+!
+module test1
+  use, intrinsic :: iso_c_binding
+  implicit none
+contains
+  subroutine sub1(argv) bind(c,name="sub1")
+    type(c_ptr), intent(in) :: argv
+  end subroutine
+
+  subroutine sub2
+    type(c_ptr), dimension(1), target :: argv = c_null_ptr
+    character(c_char), dimension(1), target :: s = c_null_char
+    call sub1(c_loc(argv))
+  end subroutine
+end module test1
+
+program test2
+  use iso_c_binding
+  type(c_ptr), target, save :: argv
+  interface
+    subroutine sub1(argv) bind(c)
+      import
+      type(c_ptr) :: argv
+    end subroutine sub1
+  end interface
+  call sub1(c_loc(argv))
+end program test2
+!
+! { dg-final { cleanup-modules "test1" } }
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_13.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_13.f90
new file mode 100644
index 000000000..62bfe0a3c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_13.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! PR fortran/38536  
+! Consecutive array and substring references rejected as C_LOC argument
+!
+! contributed by Scot Breitenfield <brtnfld@hdfgroup.org>
+
+  USE ISO_C_BINDING
+  TYPE test
+     CHARACTER(LEN=2), DIMENSION(1:2) :: c
+  END TYPE test
+  TYPE(test), TARGET :: chrScalar
+  TYPE(C_PTR) :: f_ptr
+
+  f_ptr = C_LOC(chrScalar%c(1)(1:1))
+  END
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_14.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_14.f90
new file mode 100644
index 000000000..ec455eca9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_14.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+!
+! PR fortran/38536
+! Accept as argument to C_LOC a subcomponent accessed through a pointer.
+
+  USE ISO_C_BINDING
+
+  IMPLICIT NONE
+  TYPE test3
+          INTEGER, DIMENSION(5) :: b
+  END TYPE test3
+
+  TYPE test2
+          TYPE(test3), DIMENSION(:), POINTER :: a
+  END TYPE test2
+
+  TYPE test
+          TYPE(test2), DIMENSION(2) :: c
+  END TYPE test
+
+  TYPE(test) :: chrScalar
+  TYPE(C_PTR) :: f_ptr
+  TYPE(test3), TARGET :: d(3)
+
+
+  chrScalar%c(1)%a => d
+  f_ptr = C_LOC(chrScalar%c(1)%a(1)%b(1))
+  end
+
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_15.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_15.f90
new file mode 100644
index 000000000..63f881637
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_15.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! PR 44925: [OOP] C_LOC with CLASS pointer
+!
+! Contributed by Barron Bichon <barron.bichon@swri.org>
+
+  use iso_c_binding
+
+  type :: t
+  end type t
+
+  type(c_ptr) :: tt_cptr
+  class(t), pointer :: tt_fptr
+  if (associated(tt_fptr)) tt_cptr = c_loc(tt_fptr)  ! { dg-error "must not be polymorphic" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90
new file mode 100644
index 000000000..1c86a1f9c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+! PR 38536 - array sections as arguments to c_loc are illegal.
+  use iso_c_binding
+  type, bind(c) :: t1
+     integer(c_int) :: i(5)
+  end type t1
+  type, bind(c):: t2
+     type(t1) :: t(5)
+  end type t2
+  type, bind(c) :: t3
+     type(t1) :: t(5,5)
+  end type t3
+
+  type(t2), target :: tt
+  type(t3), target :: ttt
+  integer(c_int), target :: n(3)
+  integer(c_int), target :: x[*]
+  type(C_PTR) :: p
+
+  p = c_loc(tt%t%i(1))  ! { dg-error "Array section not permitted" }
+  p = c_loc(n(1:2))  ! { dg-warning "Array section" }
+  p = c_loc(ttt%t(5,1:2)%i(1)) ! { dg-error "Array section not permitted" }
+  p = c_loc(x[1]) ! { dg-error "Coindexed argument not permitted" }
+  end
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_2.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_2.f03
new file mode 100644
index 000000000..4bdf395d1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_2.f03
@@ -0,0 +1,88 @@
+! { dg-do run }
+! { dg-additional-sources c_loc_tests_2_funcs.c }
+module c_loc_tests_2
+use, intrinsic :: iso_c_binding
+implicit none
+
+interface 
+   function test_scalar_address(cptr) bind(c)
+     use, intrinsic :: iso_c_binding, only: c_ptr, c_int
+     type(c_ptr), value :: cptr
+     integer(c_int) :: test_scalar_address
+   end function test_scalar_address
+
+   function test_array_address(cptr, num_elements) bind(c)
+     use, intrinsic :: iso_c_binding, only: c_ptr, c_int
+     type(c_ptr), value :: cptr
+     integer(c_int), value :: num_elements
+     integer(c_int) :: test_array_address
+   end function test_array_address
+
+   function test_type_address(cptr) bind(c)
+     use, intrinsic :: iso_c_binding, only: c_ptr, c_int
+     type(c_ptr), value :: cptr
+     integer(c_int) :: test_type_address
+   end function test_type_address
+end interface
+
+contains
+  subroutine test0() bind(c)
+    integer, target :: xtar
+    integer, pointer :: xptr
+    type(c_ptr) :: my_c_ptr_1 = c_null_ptr
+    type(c_ptr) :: my_c_ptr_2 = c_null_ptr
+    xtar = 100
+    xptr => xtar
+    my_c_ptr_1 = c_loc(xtar)
+    my_c_ptr_2 = c_loc(xptr)
+    if(test_scalar_address(my_c_ptr_1) .ne. 1) then
+       call abort()
+    end if
+    if(test_scalar_address(my_c_ptr_2) .ne. 1) then
+       call abort()
+    end if
+  end subroutine test0
+
+  subroutine test1() bind(c)
+    integer, target, dimension(100) :: int_array_tar
+    type(c_ptr) :: my_c_ptr_1 = c_null_ptr
+    type(c_ptr) :: my_c_ptr_2 = c_null_ptr
+    
+    int_array_tar = 100
+    my_c_ptr_1 = c_loc(int_array_tar)
+    if(test_array_address(my_c_ptr_1, 100) .ne. 1) then
+       call abort()
+    end if
+  end subroutine test1
+
+  subroutine test2() bind(c)
+    type, bind(c) :: f90type
+       integer(c_int) :: i
+       real(c_double) :: x
+    end type f90type
+    type(f90type), target :: type_tar
+    type(f90type), pointer :: type_ptr
+    type(c_ptr) :: my_c_ptr_1 = c_null_ptr
+    type(c_ptr) :: my_c_ptr_2 = c_null_ptr
+    
+    type_ptr => type_tar
+    type_tar%i = 100
+    type_tar%x = 1.0d0
+    my_c_ptr_1 = c_loc(type_tar)
+    my_c_ptr_2 = c_loc(type_ptr)
+    if(test_type_address(my_c_ptr_1) .ne. 1) then
+       call abort()
+    end if
+    if(test_type_address(my_c_ptr_2) .ne. 1) then
+       call abort()
+    end if
+  end subroutine test2
+end module c_loc_tests_2
+
+program driver
+  use c_loc_tests_2
+  call test0()
+  call test1()
+  call test2()
+end program driver
+! { dg-final { cleanup-modules "c_loc_tests_2" } }
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_2_funcs.c b/gcc/testsuite/gfortran.dg/c_loc_tests_2_funcs.c
new file mode 100644
index 000000000..d47ac81ae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_2_funcs.c
@@ -0,0 +1,42 @@
+double fabs (double);
+
+typedef struct ctype
+{
+  int i;
+  double x;
+}ctype_t;
+
+int test_scalar_address(int *ptr)
+{
+  /* The value in Fortran should be initialized to 100. */
+  if(*ptr != 100)
+    return 0;
+  else
+    return 1;
+}
+
+int test_array_address(int *int_array, int num_elements)
+{
+  int i = 0;
+
+  for(i = 0; i < num_elements; i++)
+    /* Fortran will init all of the elements to 100; verify that here. */
+    if(int_array[i] != 100)
+      return 0;
+
+  /* all elements were equal to 100 */
+  return 1;
+}
+
+int test_type_address(ctype_t *type_ptr)
+{
+  /* i was set to 100 by Fortran */
+  if(type_ptr->i != 100)
+    return 0;
+  
+  /* x was set to 1.0d0 by Fortran */
+  if(fabs(type_ptr->x - 1.0) > 0.00000000)
+    return 0;
+  
+  return 1;
+}
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_3.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_3.f03
new file mode 100644
index 000000000..95eac4af3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_3.f03
@@ -0,0 +1,8 @@
+! { dg-do compile }
+use iso_c_binding
+implicit none
+character(kind=c_char,len=256),target :: arg
+type(c_ptr),pointer :: c
+c = c_loc(arg) ! { dg-error "must have a length of 1" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_4.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_4.f03
new file mode 100644
index 000000000..8453ec772
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_4.f03
@@ -0,0 +1,15 @@
+! { dg-do compile }
+module c_loc_tests_4
+  use, intrinsic :: iso_c_binding
+  implicit none
+
+contains
+  subroutine sub0() bind(c)
+    integer(c_int), target, dimension(10) :: my_array
+    integer(c_int), pointer, dimension(:) :: my_array_ptr
+    type(c_ptr) :: my_c_ptr
+
+    my_array_ptr => my_array
+    my_c_ptr = c_loc(my_array_ptr) ! { dg-error "must be an associated scalar POINTER" }
+  end subroutine sub0
+end module c_loc_tests_4
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_5.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_5.f03
new file mode 100644
index 000000000..a389437ce
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_5.f03
@@ -0,0 +1,19 @@
+! { dg-do compile }
+module c_loc_tests_5
+  use, intrinsic :: iso_c_binding, only: c_char, c_ptr, c_loc, c_int
+
+contains
+  subroutine sub0() bind(c)
+    type(c_ptr) :: f_ptr, my_c_ptr
+    character(kind=c_char, len=20), target :: format
+    integer(c_int), dimension(:), pointer :: int_ptr
+    integer(c_int), dimension(10), target :: int_array
+
+    f_ptr = c_loc(format(1:1))
+
+    int_ptr => int_array
+    my_c_ptr = c_loc(int_ptr(0))
+
+  end subroutine sub0
+end module c_loc_tests_5
+! { dg-final { cleanup-modules "c_loc_tests_5" } }
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_6.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_6.f03
new file mode 100644
index 000000000..c82a2adbf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_6.f03
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! Verifies that the c_loc scalar pointer tests recognize the string of length
+! one as being allowable for the parameter to c_loc.
+module x
+use iso_c_binding
+contains
+SUBROUTINE glutInit_f03()
+  TYPE(C_PTR), DIMENSION(1), TARGET :: argv=C_NULL_PTR
+  CHARACTER(C_CHAR), DIMENSION(10), TARGET :: empty_string=C_NULL_CHAR
+  argv(1)=C_LOC(empty_string)
+END SUBROUTINE
+end module x
+! { dg-final { cleanup-modules "x" } }  
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_7.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_7.f03
new file mode 100644
index 000000000..78f5276bd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_7.f03
@@ -0,0 +1,11 @@
+! { dg-do compile }
+module c_loc_tests_7
+use iso_c_binding
+contains
+SUBROUTINE glutInit_f03()
+  TYPE(C_PTR), DIMENSION(1), TARGET :: argv=C_NULL_PTR
+  CHARACTER(C_CHAR), DIMENSION(1), TARGET :: empty_string=C_NULL_CHAR
+  argv(1)=C_LOC(empty_string)
+END SUBROUTINE
+end module c_loc_tests_7
+! { dg-final { cleanup-modules "c_loc_tests_7" } }
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_8.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_8.f03
new file mode 100644
index 000000000..a094d690b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_8.f03
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! Verifies that the c_loc scalar pointer tests recognize the string of length
+! greater than one as not being allowable for the parameter to c_loc.
+module x
+use iso_c_binding
+contains
+SUBROUTINE glutInit_f03()
+  TYPE(C_PTR), DIMENSION(1), TARGET :: argv=C_NULL_PTR
+  character(kind=c_char, len=5), target :: string="hello"
+  argv(1)=C_LOC(string) ! { dg-error "must have a length of 1" }
+END SUBROUTINE
+end module x
+
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_9.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_9.f03
new file mode 100644
index 000000000..fa3238139
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_9.f03
@@ -0,0 +1,10 @@
+! { dg-do compile }
+subroutine aaa(in)
+  use iso_c_binding
+  implicit none
+  CHARACTER(KIND=C_CHAR), DIMENSION(*), TARGET  :: in
+  type(c_ptr) :: cptr
+  cptr = c_loc(in)
+end subroutine aaa
+
+
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests.f03 b/gcc/testsuite/gfortran.dg/c_ptr_tests.f03
new file mode 100644
index 000000000..f0c9a3329
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests.f03
@@ -0,0 +1,46 @@
+! { dg-do run }
+! { dg-additional-sources c_ptr_tests_driver.c }
+module c_ptr_tests
+  use, intrinsic :: iso_c_binding
+
+  ! TODO::
+  ! in order to be associated with a C address, 
+  ! the derived type needs to be C interoperable, 
+  ! which requires bind(c) and all fields interoperable.
+  type, bind(c) :: myType
+     type(c_ptr) :: myServices
+     type(c_funptr) :: mySetServices
+     type(c_ptr) :: myPort
+  end type myType
+
+  type, bind(c) :: f90Services
+     integer(c_int) :: compId
+     type(c_ptr) :: globalServices = c_null_ptr
+  end type f90Services
+
+  contains
+    
+    subroutine sub0(c_self, services) bind(c)
+      use, intrinsic :: iso_c_binding
+      implicit none
+      type(c_ptr), value :: c_self, services
+      type(myType), pointer :: self
+      type(f90Services), pointer :: localServices
+!      type(c_ptr) :: my_cptr 
+      type(c_ptr), save :: my_cptr = c_null_ptr
+
+      call c_f_pointer(c_self, self)
+      if(.not. associated(self)) then
+         print *, 'self is not associated'
+      end if
+      self%myServices = services
+
+      ! c_null_ptr is defined in iso_c_binding
+      my_cptr = c_null_ptr
+
+      ! get access to the local services obj from C
+      call c_f_pointer(self%myServices, localServices)
+    end subroutine sub0
+end module c_ptr_tests
+
+! { dg-final { cleanup-modules "c_ptr_tests" } }
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_10.f03 b/gcc/testsuite/gfortran.dg/c_ptr_tests_10.f03
new file mode 100644
index 000000000..fe4162275
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_10.f03
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+! This test case exists because gfortran had an error in converting the 
+! expressions for the derived types from iso_c_binding in some cases.
+module c_ptr_tests_10
+  use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr
+
+contains
+  subroutine sub0() bind(c)
+    print *, 'c_null_ptr is: ', c_null_ptr
+  end subroutine sub0
+end module c_ptr_tests_10
+
+program main
+  use c_ptr_tests_10
+  call sub0()
+end program main
+
+! { dg-final { cleanup-modules "c_ptr_tests_10" } }
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_11.f03 b/gcc/testsuite/gfortran.dg/c_ptr_tests_11.f03
new file mode 100644
index 000000000..9448f82ba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_11.f03
@@ -0,0 +1,42 @@
+! { dg-do compile }
+! Verify that initialization of c_ptr components works.
+module fgsl
+  use, intrinsic :: iso_c_binding
+  implicit none
+  type, public :: fgsl_matrix
+     private
+     type(c_ptr) :: gsl_matrix = c_null_ptr
+  end type fgsl_matrix
+  type, public :: fgsl_multifit_fdfsolver
+     private
+     type(c_ptr) :: gsl_multifit_fdfsolver = c_null_ptr
+  end type fgsl_multifit_fdfsolver
+interface
+  function gsl_multifit_fdfsolver_jac(s) bind(c)
+    import :: c_ptr
+    type(c_ptr), value :: s
+    type(c_ptr) :: gsl_multifit_fdfsolver_jac
+  end function gsl_multifit_fdfsolver_jac
+end interface
+contains
+  function fgsl_multifit_fdfsolver_jac(s)
+    type(fgsl_multifit_fdfsolver), intent(in) :: s
+    type(fgsl_matrix) :: fgsl_multifit_fdfsolver_jac
+    fgsl_multifit_fdfsolver_jac%gsl_matrix = &
+         gsl_multifit_fdfsolver_jac(s%gsl_multifit_fdfsolver)
+  end function fgsl_multifit_fdfsolver_jac
+end module fgsl
+
+module m
+  use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr
+  implicit none
+  type t
+    type(c_ptr) :: matrix  = c_null_ptr
+  end type t
+contains
+  subroutine func(a)
+    type(t), intent(out) :: a
+  end subroutine func
+end module m
+! { dg-final { cleanup-modules "fgsl m" } } 
+
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_12.f03 b/gcc/testsuite/gfortran.dg/c_ptr_tests_12.f03
new file mode 100644
index 000000000..71e817093
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_12.f03
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! Verify that initialization of c_ptr components works.  This is based on 
+! code from fgsl: 
+! http://www.lrz-muenchen.de/services/software/mathematik/gsl/fortran/
+! and tests PR 33395.
+module fgsl
+  use, intrinsic :: iso_c_binding
+  implicit none
+!
+!
+! Kind and length parameters are default integer
+!
+  integer, parameter, public :: fgsl_double = c_double
+
+!
+! Types : Array support
+!
+  type, public :: fgsl_vector
+     private
+     type(c_ptr) :: gsl_vector = c_null_ptr
+  end type fgsl_vector
+
+contains
+  function fgsl_vector_align(p_x, f_x)
+    real(fgsl_double), pointer :: p_x(:)
+    type(fgsl_vector) :: f_x
+    integer :: fgsl_vector_align
+    fgsl_vector_align = 4
+  end function fgsl_vector_align
+end module fgsl
+
+module tmod
+  use fgsl
+  implicit none
+contains
+  subroutine expb_df() bind(c)
+    type(fgsl_vector) :: f_x
+    real(fgsl_double), pointer :: p_x(:)
+    integer :: status
+    status = fgsl_vector_align(p_x, f_x)
+  end subroutine expb_df
+end module tmod
+
+! { dg-final { cleanup-modules "fgsl tmod" } } 
+
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_13.f03 b/gcc/testsuite/gfortran.dg/c_ptr_tests_13.f03
new file mode 100644
index 000000000..c7a603bcc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_13.f03
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! Ensure that the user cannot call the structure constructor for one of 
+! the iso_c_binding derived types.
+!
+! PR fortran/33760
+!
+program main
+   use ISO_C_BINDING
+   implicit none
+   integer(C_INTPTR_T) p
+   type(C_PTR) cptr
+   p = 0
+   cptr = C_PTR(p+1) ! { dg-error "Components of structure constructor" }
+   cptr = C_PTR(1) ! { dg-error "Components of structure constructor" } 
+end program main
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_14.f90 b/gcc/testsuite/gfortran.dg/c_ptr_tests_14.f90
new file mode 100644
index 000000000..c4101fb03
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_14.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/41298
+!
+! Check that c_null_ptr default initializer is really applied
+
+module m
+  use iso_c_binding
+  type, public :: fgsl_file
+     type(c_ptr)    :: gsl_file = c_null_ptr
+     type(c_funptr) :: gsl_func = c_null_funptr
+     type(c_ptr)    :: NIptr
+     type(c_funptr) :: NIfunptr
+  end type fgsl_file
+contains
+  subroutine sub(aaa,bbb)
+    type(fgsl_file), intent(out)   :: aaa
+    type(fgsl_file), intent(inout) :: bbb
+  end subroutine
+  subroutine proc() bind(C)
+  end subroutine proc
+end module m
+
+program test
+  use m
+  implicit none
+  type(fgsl_file) :: file, noreinit
+  integer, target :: tgt
+
+  call sub(file, noreinit)
+  if(c_associated(file%gsl_file)) call abort()
+  if(c_associated(file%gsl_func)) call abort()
+
+  file%gsl_file = c_loc(tgt)
+  file%gsl_func = c_funloc(proc)
+  call sub(file, noreinit)
+  if(c_associated(file%gsl_file)) call abort()
+  if(c_associated(file%gsl_func)) call abort()
+end program test
+
+! { dg-final { scan-tree-dump-times "gsl_file = 0B" 1 "original" } }
+! { dg-final { scan-tree-dump-times "gsl_func = 0B" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "NIptr = 0B"    0 "original" } }
+! { dg-final { scan-tree-dump-times "NIfunptr = 0B" 0 "original" } }
+
+! { dg-final { scan-tree-dump-times "bbb =" 0 "original" } }
+
+! { dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_15.f90 b/gcc/testsuite/gfortran.dg/c_ptr_tests_15.f90
new file mode 100644
index 000000000..1ce0c15fd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_15.f90
@@ -0,0 +1,53 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file -fdump-tree-original" }
+!
+! PR fortran/43042 - fix ICE with c_null_ptr when using
+! -fwhole-file (or -flto, which implies -fwhole-file).
+!
+! Testcase based on c_ptr_tests_14.f90  (PR fortran/41298)
+! Check that c_null_ptr default initializer is really applied
+
+module m
+  use iso_c_binding
+  type, public :: fgsl_file
+     type(c_ptr)    :: gsl_file = c_null_ptr
+     type(c_funptr) :: gsl_func = c_null_funptr
+     type(c_ptr)    :: NIptr
+     type(c_funptr) :: NIfunptr
+  end type fgsl_file
+contains
+  subroutine sub(aaa,bbb)
+    type(fgsl_file), intent(out)   :: aaa
+    type(fgsl_file), intent(inout) :: bbb
+  end subroutine
+  subroutine proc() bind(C)
+  end subroutine proc
+end module m
+
+program test
+  use m
+  implicit none
+  type(fgsl_file) :: file, noreinit
+  integer, target :: tgt
+
+  call sub(file, noreinit)
+  if(c_associated(file%gsl_file)) call abort()
+  if(c_associated(file%gsl_func)) call abort()
+
+  file%gsl_file = c_loc(tgt)
+  file%gsl_func = c_funloc(proc)
+  call sub(file, noreinit)
+  if(c_associated(file%gsl_file)) call abort()
+  if(c_associated(file%gsl_func)) call abort()
+end program test
+
+! { dg-final { scan-tree-dump-times "gsl_file = 0B" 1 "original" } }
+! { dg-final { scan-tree-dump-times "gsl_func = 0B" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "NIptr = 0B"    0 "original" } }
+! { dg-final { scan-tree-dump-times "NIfunptr = 0B" 0 "original" } }
+
+! { dg-final { scan-tree-dump-times "bbb =" 0 "original" } }
+
+! { dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_16.f90 b/gcc/testsuite/gfortran.dg/c_ptr_tests_16.f90
new file mode 100644
index 000000000..8855d62ab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_16.f90
@@ -0,0 +1,62 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-optimized -O" }
+!
+! 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'4142434500000000',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" } }
+! { dg-final { cleanup-tree-dump "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_5.f03 b/gcc/testsuite/gfortran.dg/c_ptr_tests_5.f03
new file mode 100644
index 000000000..a9fbbd60e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_5.f03
@@ -0,0 +1,16 @@
+! { dg-do compile }
+module c_ptr_tests_5
+use, intrinsic :: iso_c_binding
+
+type, bind(c) :: my_f90_type
+   integer(c_int) :: i
+end type my_f90_type
+
+contains
+  subroutine sub0(c_struct) bind(c)
+    type(c_ptr), value :: c_struct
+    type(my_f90_type) :: f90_type
+
+    call c_f_pointer(c_struct, f90_type) ! { dg-error "must be a pointer" }
+  end subroutine sub0
+end module c_ptr_tests_5
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_7.f03 b/gcc/testsuite/gfortran.dg/c_ptr_tests_7.f03
new file mode 100644
index 000000000..04cb8b22a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_7.f03
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-additional-sources c_ptr_tests_7_driver.c }
+module c_ptr_tests_7
+  use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr
+
+contains
+  function func0() bind(c)
+    type(c_ptr) :: func0
+    func0 = c_null_ptr
+  end function func0
+end module c_ptr_tests_7
+! { dg-final { cleanup-modules "c_ptr_tests_7" } }
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_7_driver.c b/gcc/testsuite/gfortran.dg/c_ptr_tests_7_driver.c
new file mode 100644
index 000000000..7d8b1e328
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_7_driver.c
@@ -0,0 +1,14 @@
+/* This is the driver for c_ptr_test_7.  */
+extern void abort(void);
+
+void *func0();
+
+int main(int argc, char **argv)
+{
+  /* The Fortran module c_ptr_tests_7 contains function func0, which has
+     return type of c_ptr, and should set the return value to c_null_ptr.  */
+  if (func0() != 0)
+    abort();
+
+  return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_8.f03 b/gcc/testsuite/gfortran.dg/c_ptr_tests_8.f03
new file mode 100644
index 000000000..3b99ee8bb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_8.f03
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-additional-sources c_ptr_tests_8_funcs.c }
+program main
+use iso_c_binding, only: c_ptr
+implicit none
+interface
+  function create() bind(c)
+    use iso_c_binding, only: c_ptr
+    type(c_ptr) :: create
+  end function create
+  subroutine show(a) bind(c)
+    import :: c_ptr
+    type(c_ptr), VALUE :: a
+  end subroutine show
+end interface
+
+type(c_ptr) :: ptr
+ptr = create()
+call show(ptr)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_8_funcs.c b/gcc/testsuite/gfortran.dg/c_ptr_tests_8_funcs.c
new file mode 100644
index 000000000..2ad012116
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_8_funcs.c
@@ -0,0 +1,26 @@
+/* This file provides auxilliary functions for c_ptr_tests_8.  */
+
+#include <stdio.h>
+#include <stdlib.h>
+
+extern void abort (void);
+
+void *create (void)
+{
+  int *a;
+  a = malloc (sizeof (a));
+  *a = 444;
+  return a;
+
+}
+
+void show (int *a)
+{
+  if (*a == 444)
+    printf ("SUCCESS (%d)\n", *a);
+  else
+  {
+    printf ("FAILED: Expected 444, received %d\n", *a);
+    abort ();
+  }
+}
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_9.f03 b/gcc/testsuite/gfortran.dg/c_ptr_tests_9.f03
new file mode 100644
index 000000000..f72349264
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_9.f03
@@ -0,0 +1,32 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+! This test is pretty simple but is here just to make sure that the changes 
+! done to c_ptr and c_funptr (translating them to void *) works in the case 
+! where a component of a type is of type c_ptr or c_funptr.  
+module c_ptr_tests_9
+  use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr
+
+  type myF90Derived
+     type(c_ptr) :: my_c_ptr
+  end type myF90Derived
+
+contains
+  subroutine sub0() bind(c)
+    type(myF90Derived), target :: my_f90_type
+    type(myF90Derived), pointer :: my_f90_type_ptr
+
+    my_f90_type%my_c_ptr = c_null_ptr
+    print *, 'my_f90_type is: ', my_f90_type
+    my_f90_type_ptr => my_f90_type
+    print *, 'my_f90_type_ptr is: ', my_f90_type_ptr
+  end subroutine sub0
+end module c_ptr_tests_9
+
+
+program main
+  use c_ptr_tests_9
+
+  call sub0()
+end program main
+
+! { dg-final { cleanup-modules "c_ptr_tests_9" } }
diff --git a/gcc/testsuite/gfortran.dg/c_ptr_tests_driver.c b/gcc/testsuite/gfortran.dg/c_ptr_tests_driver.c
new file mode 100644
index 000000000..cd81c7bcc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_ptr_tests_driver.c
@@ -0,0 +1,34 @@
+/* this is the driver for c_ptr_test.f03 */
+
+typedef struct services
+{
+   int compId;
+   void *globalServices;
+}services_t;
+
+typedef struct comp
+{
+   void *myServices;
+   void (*setServices)(struct comp *self, services_t *myServices);
+   void *myPort;
+}comp_t;
+
+/* prototypes for f90 functions */
+void sub0(comp_t *self, services_t *myServices);
+
+int main(int argc, char **argv)
+{
+   services_t servicesObj;
+   comp_t myComp;
+
+   servicesObj.compId = 17;
+   servicesObj.globalServices = 0; /* NULL; */
+   myComp.myServices = &servicesObj;
+   myComp.setServices = 0; /* NULL; */
+   myComp.myPort = 0; /* NULL; */
+   
+   sub0(&myComp, &servicesObj);
+   
+   return 0;
+}/* end main() */
+
diff --git a/gcc/testsuite/gfortran.dg/c_size_t_driver.c b/gcc/testsuite/gfortran.dg/c_size_t_driver.c
new file mode 100644
index 000000000..b2d499171
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_size_t_driver.c
@@ -0,0 +1,12 @@
+#include <stdlib.h>
+void sub0(int my_c_size);
+
+int main(int argc, char **argv)
+{
+  int my_c_size;
+
+  my_c_size = (int)sizeof(size_t);
+  sub0(my_c_size);
+
+  return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/c_size_t_test.f03 b/gcc/testsuite/gfortran.dg/c_size_t_test.f03
new file mode 100644
index 000000000..68064d78b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_size_t_test.f03
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-additional-sources c_size_t_driver.c }
+module c_size_t_test
+  use, intrinsic :: iso_c_binding
+
+contains
+  subroutine sub0(my_c_size) bind(c)
+    integer(c_int), value :: my_c_size ! value of C's sizeof(size_t)
+
+    ! if the value of c_size_t isn't equal to the value of C's sizeof(size_t) 
+    ! we call abort.
+    if(c_size_t .ne. my_c_size) then
+       call abort ()
+    end if
+  end subroutine sub0
+end module c_size_t_test
+
+! { dg-final { cleanup-modules "c_size_t_test" } }
diff --git a/gcc/testsuite/gfortran.dg/c_sizeof_1.f90 b/gcc/testsuite/gfortran.dg/c_sizeof_1.f90
new file mode 100644
index 000000000..e0ac06f94
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_sizeof_1.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+! Support F2008's c_sizeof()
+!
+use iso_c_binding, only: c_int, c_char, c_ptr, c_intptr_t, c_null_ptr, c_sizeof
+
+integer(kind=c_int) :: i, j(10)
+character(kind=c_char,len=4),parameter :: str(1) = "abcd"
+type(c_ptr) :: cptr
+integer(c_intptr_t) :: iptr
+
+! Using F2008's C_SIZEOF
+i = c_sizeof(i)
+if (i /= 4) call abort()
+
+i = c_sizeof(j)
+if (i /= 40) call abort()
+
+i = c_sizeof(str)
+if (i /= 4) call abort()
+
+i = c_sizeof(str(1))
+if (i /= 4) call abort()
+
+i = c_sizeof(str(1)(1:3))
+if (i /= 3) call abort()
+
+write(*,*) c_sizeof(cptr), c_sizeof(iptr), c_sizeof(C_NULL_PTR)
+
+! Using GNU's SIZEOF
+i = sizeof(i)
+if (i /= 4) call abort()
+
+i = sizeof(j)
+if (i /= 40) call abort()
+
+i = sizeof(str)
+if (i /= 4) call abort()
+
+i = sizeof(str(1))
+if (i /= 4) call abort()
+
+i = sizeof(str(1)(1:3))
+if (i /= 3) call abort()
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/c_sizeof_2.f90 b/gcc/testsuite/gfortran.dg/c_sizeof_2.f90
new file mode 100644
index 000000000..e16379747
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_sizeof_2.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-std=f2003 -Wall -Wno-conversion" }
+! Support F2008's c_sizeof()
+!
+USE ISO_C_BINDING, only: C_SIZE_T, c_sizeof ! { dg-error "new in Fortran 2008" }
+integer(C_SIZE_T) :: i
+i = c_sizeof(i)           
+end
+
diff --git a/gcc/testsuite/gfortran.dg/c_sizeof_3.f90 b/gcc/testsuite/gfortran.dg/c_sizeof_3.f90
new file mode 100644
index 000000000..8a68cb94c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_sizeof_3.f90
@@ -0,0 +1,18 @@
+! { dg-do link }
+!
+! PR fortran/40568
+!
+! Module checks for C_SIZEOF (part of ISO_C_BINDING)
+!
+subroutine test
+use iso_c_binding, only: foo => c_sizeof, bar=> c_sizeof, c_sizeof, c_int
+integer(c_int) :: i
+print *, c_sizeof(i), bar(i), foo(i)
+end
+
+use iso_c_binding
+implicit none
+integer(c_int) :: i
+print *, c_sizeof(i)
+call test()
+end
diff --git a/gcc/testsuite/gfortran.dg/c_sizeof_4.f90 b/gcc/testsuite/gfortran.dg/c_sizeof_4.f90
new file mode 100644
index 000000000..16172f05f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/c_sizeof_4.f90
@@ -0,0 +1,10 @@
+! { dg-do link }
+!
+! PR fortran/40568
+!
+! Module checks for C_SIZEOF (part of ISO_C_BINDING)
+!
+
+implicit none
+intrinsic c_sizeof ! { dg-error "does not exist" }
+end
diff --git a/gcc/testsuite/gfortran.dg/change_symbol_attributes_1.f90 b/gcc/testsuite/gfortran.dg/change_symbol_attributes_1.f90
new file mode 100644
index 000000000..9b6ed3769
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/change_symbol_attributes_1.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! Fix for PR21730 - declarations used to produce the error:
+!   target        :: x                ! these 2 lines interchanged
+!                    1
+! Error: Cannot change attributes of symbol at (1) after it has been used.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+!
+subroutine gfcbug27 (x)
+  real, intent(inout) :: x(:)
+
+  real          :: tmp(size (x,1))  ! gfc produces an error unless
+  target        :: x                ! these 2 lines interchanged
+  real, pointer :: p(:)
+
+  p => x(:)
+end subroutine gfcbug27
diff --git a/gcc/testsuite/gfortran.dg/char4_iunit_1.f03 b/gcc/testsuite/gfortran.dg/char4_iunit_1.f03
new file mode 100644
index 000000000..5b1b285ad
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char4_iunit_1.f03
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+! PR37077 Implement Internal Unit I/O for character KIND=4
+! Test case prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program char4_iunit_1
+  implicit none
+  character(kind=4,len=42) :: string
+  integer(kind=4) :: i,j
+  real(kind=4) :: inf, nan, large
+
+  large = huge(large)
+  inf = 2 * large
+  nan = 0
+  nan = nan / nan
+
+  string = 4_"123456789x"
+  write(string,'(a11)') 4_"abcdefg"
+  if (string .ne. 4_"    abcdefg                               ") call abort
+  write(string,*) 12345
+  if (string .ne. 4_"       12345                              ") call abort
+  write(string, '(i6,5x,i8,a5)') 78932, 123456, "abc"
+  if (string .ne. 4_" 78932       123456  abc                  ") call abort
+  write(string, *) .true., .false. , .true.
+  if (string .ne. 4_" T F T                                    ") call abort
+  write(string, *) 1.2345e-06, 4.2846e+10_8
+  if (string .ne. 4_"  1.23450002E-06   42846000000.000000     ") call abort
+  write(string, *) nan, inf
+  if (string .ne. 4_"             NaN        Infinity          ") call abort
+  write(string, '(10x,f3.1,3x,f9.1)') nan, inf
+  if (string .ne. 4_"          NaN    Infinity                 ") call abort
+  write(string, *) (1.2, 3.4 )
+  if (string .ne. 4_" (  1.2000000    ,  3.4000001    )        ") call abort
+end program char4_iunit_1
diff --git a/gcc/testsuite/gfortran.dg/char4_iunit_2.f03 b/gcc/testsuite/gfortran.dg/char4_iunit_2.f03
new file mode 100644
index 000000000..074321274
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char4_iunit_2.f03
@@ -0,0 +1,47 @@
+! { dg-do run }
+! PR37077 Implement Internal Unit I/O for character KIND=4
+! Test case prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program char4_iunit_2
+  implicit none
+  integer, parameter :: k = 4
+  character(kind=4,len=80) :: widestring, str_char4
+  character(kind=1,len=80) :: skinnystring
+  integer :: i,j
+  real :: x
+  character(9) :: str_default
+
+  widestring = k_"12345 2.54360 hijklmnop qwertyuiopasdfg"
+  skinnystring = "12345 2.54360 hijklmnop qwertyuiopasdfg"
+  i = 77777
+  x = 0.0
+  str_default = "xxxxxxxxx"
+  str_char4 = k_"xyzzy"
+  read(widestring,'(i5,1x,f7.5,1x,a9,1x,a15)') i, x, str_default, str_char4
+  if (i /= 12345 .or. (x - 2.5436001) > epsilon(x) .or. &
+      str_default /= "hijklmnop" .or. str_char4 /= k_"qwertyuiopasdfg")&
+      call abort
+  i = 77777
+  x = 0.0
+  str_default = "xxxxxxxxx"
+  str_char4 = k_"xyzzy"
+  read(widestring,'(2x,i4,tl3,1x,f7.5,1x,a9,1x,a15)')i, x, str_default,&
+       str_char4
+  if (i /= 345 .or. (x - 52.542999) > epsilon(x) .or. &
+      str_default /= "0 hijklmn" .or. str_char4 /= k_"p qwertyuiopasd")&
+      call abort
+  read(skinnystring,'(2x,i4,tl3,1x,f7.5,1x,a9,1x,a15)')i, x, str_default,&
+   str_char4
+  if (i /= 345 .or. (x - 52.542999) > epsilon(x) .or. &
+      str_default /= "0 hijklmn" .or. str_char4 /= k_"p qwertyuiopasd")&
+      call abort
+  write(widestring,'(2x,i4,tl3,1x,f10.5,1x,a9,1x,a15)')i, x, str_default,&
+   trim(str_char4)
+  if (widestring .ne. k_"   3  52.54300 0 hijklmn p qwertyuiopasd") call abort
+  write(skinnystring,'(2x,i4,tl3,1x,f10.5,1x,a9,1x,a15)')i, x, str_default,&
+   trim(str_char4)
+  if (skinnystring .ne. "   3  52.54300 0 hijklmn p qwertyuiopasd") call abort
+  write(widestring,*)"test",i, x, str_default,&
+   trim(str_char4)
+  if (widestring .ne. &
+    k_" test         345   52.542999     0 hijklmnp qwertyuiopasd") call abort
+end program char4_iunit_2
diff --git a/gcc/testsuite/gfortran.dg/char_allocation_1.f90 b/gcc/testsuite/gfortran.dg/char_allocation_1.f90
new file mode 100644
index 000000000..119badb4d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_allocation_1.f90
@@ -0,0 +1,11 @@
+! PR fortran/31974
+! { dg-do run }
+  subroutine foo (n)
+    integer :: n
+    character (len = n) :: v(n)
+    v = ''
+    if (any (v /= '')) call abort
+  end subroutine foo
+
+  call foo(7)
+  end
diff --git a/gcc/testsuite/gfortran.dg/char_array_arg_1.f90 b/gcc/testsuite/gfortran.dg/char_array_arg_1.f90
new file mode 100644
index 000000000..097fbc6f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_array_arg_1.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! Test the fix for pr41167, in which the first argument of 'pack', below,
+! was simplified incorrectly, with the results indicated.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+!
+program gfcbug88
+  implicit none
+  type t
+     character(len=8) :: name
+  end type t
+  type(t) ,parameter :: obstyp(2)= (/ t ('A'), t ('B') /)
+  character(9) :: chr(1)
+
+  print *, pack (" "//obstyp(:)% name, (/ .true., .false. /))  ! Used to ICE on compilation
+  chr = pack (" "//obstyp(:)% name, (/ .true., .false. /))  ! Used to give conversion error
+end program gfcbug88
diff --git a/gcc/testsuite/gfortran.dg/char_array_constructor.f90 b/gcc/testsuite/gfortran.dg/char_array_constructor.f90
new file mode 100644
index 000000000..5f562e9fa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_array_constructor.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+module z
+   integer :: i
+   character(6) :: a(2) = (/ ('main  ' , i = 1, 2) /)
+   character(6) :: b(2) = (/ 'abcd  ' , 'efghij' /)
+end module
+
+program y
+  use z
+  if (a(1) /= 'main  ') call abort
+  if (a(2) /= 'main  ') call abort
+  if (b(1) /= 'abcd  ') call abort
+  if (b(2) /= 'efghij') call abort
+end program y
+
+! { dg-final { cleanup-modules "z" } }
diff --git a/gcc/testsuite/gfortran.dg/char_array_constructor_2.f90 b/gcc/testsuite/gfortran.dg/char_array_constructor_2.f90
new file mode 100644
index 000000000..766eb5290
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_array_constructor_2.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! Tests the fix for PR30319, in which the use of the parameter 'aa' in
+! the array constructor that initialises bb would cause an internal
+! error in resolution.
+!
+! Contributed by Vivek Rao <vivekrao4@yahoo.com>
+!
+module foomod
+  character (len=1), parameter :: aa = "z", bb(1) = (/aa/)
+end module foomod
+  use foomod
+  print *, aa, bb
+end
+! { dg-final { cleanup-modules "foomod" } }
diff --git a/gcc/testsuite/gfortran.dg/char_array_constructor_3.f90 b/gcc/testsuite/gfortran.dg/char_array_constructor_3.f90
new file mode 100644
index 000000000..d4c49643f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_array_constructor_3.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! tests the fix for PR32156, in which the character length of the compound
+! expression got lost.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+write (*,'(2A3)') 'X'//(/"1","2"/)//'Y'
+END
diff --git a/gcc/testsuite/gfortran.dg/char_array_structure_constructor.f90 b/gcc/testsuite/gfortran.dg/char_array_structure_constructor.f90
new file mode 100644
index 000000000..22669363e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_array_structure_constructor.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+! { dg-options "-fwhole-file" }
+!
+! PR fortran/19107
+! -fwhole-file flag added for PR fortran/44945
+!
+! This test the fix of PR19107, where character array actual
+! arguments in derived type constructors caused an ICE.
+! It also checks that the scalar counterparts are OK.
+! Contributed by Paul Thomas  pault@gcc.gnu.org
+!
+MODULE global
+  TYPE :: dt
+    CHARACTER(4) a
+    CHARACTER(4) b(2)
+  END TYPE
+  TYPE (dt), DIMENSION(:), ALLOCATABLE, SAVE :: c
+END MODULE global
+program char_array_structure_constructor
+  USE global
+  call alloc (2)
+  if ((any (c%a /= "wxyz")) .OR. &
+      (any (c%b(1) /= "abcd")) .OR. &
+      (any (c%b(2) /= "efgh"))) call abort ()
+contains
+  SUBROUTINE alloc (n)
+    USE global
+    ALLOCATE (c(n), STAT=IALLOC_FLAG)
+    DO i = 1,n
+      c (i) = dt ("wxyz",(/"abcd","efgh"/))
+    ENDDO
+  end subroutine alloc
+END program char_array_structure_constructor
+
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/char_assign_1.f90 b/gcc/testsuite/gfortran.dg/char_assign_1.f90
new file mode 100644
index 000000000..0d31cee7a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_assign_1.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! { dg-options "-Wcharacter-truncation" }
+! Tests the fix for PR31266: references to CHARACTER
+! components lead to the wrong length being assigned to substring
+! expressions.
+type data
+   character(len=5) :: c
+end type data
+type(data), dimension(5), target :: y
+character(len=2), dimension(5) :: p
+character(len=3), dimension(5) :: q
+
+y(:)%c = "abcdef" ! { dg-warning "in assignment \\(5/6\\)" }
+p(1) = y(1)%c(3:) ! { dg-warning "in assignment \\(2/3\\)" }
+if (p(1).ne."cd") call abort()
+
+p(1) = y(1)%c  ! { dg-warning "in assignment \\(2/5\\)" }
+if (p(1).ne."ab") call abort()
+
+q = "xyz"
+p = q ! { dg-warning "CHARACTER expression will be truncated in assignment \\(2/3\\)" }
+if (any (p.ne.q(:)(1:2))) call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/char_associated_1.f90 b/gcc/testsuite/gfortran.dg/char_associated_1.f90
new file mode 100644
index 000000000..f38f27331
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_associated_1.f90
@@ -0,0 +1,8 @@
+! Check that associated works correctly for character arrays.
+! { dg-do run }
+program main
+  character (len = 5), dimension (:), pointer :: ptr
+  character (len = 5), dimension (2), target :: a = (/ 'abcde', 'fghij' /)
+  ptr => a
+  if (.not. associated (ptr, a)) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_bounds_check_fail_1.f90 b/gcc/testsuite/gfortran.dg/char_bounds_check_fail_1.f90
new file mode 100644
index 000000000..15d702150
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_bounds_check_fail_1.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Substring out of bounds check" }
+! PR fortran/27588
+program bound_check
+      character*10 zz
+      i = 2
+      j = i+9
+      zz = ' '
+      zz(i:j) = 'abcdef'
+      print * , zz
+      end
+! { dg-output "At line 10.*Substring out of bounds: upper bound \\(11\\) of 'zz' exceeds string length" }
diff --git a/gcc/testsuite/gfortran.dg/char_cast_1.f90 b/gcc/testsuite/gfortran.dg/char_cast_1.f90
new file mode 100644
index 000000000..2eca9cfda
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_cast_1.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+!
+! Check the fix for PR31608 in all it's various manifestations:)
+! Contributed by Richard Guenther <rguenth@gcc.gnu.org>
+!
+  character(len=1) :: string = "z"
+  integer :: i(1) = (/100/)
+  print *, Up("abc")
+  print *, transfer(((transfer(string,"x",1))), "x",1)
+  print *, transfer(char(i), "x")
+  print *, Upper ("abcdefg")
+ contains
+  Character (len=20) Function Up (string)
+    Character(len=*) string
+    character(1) :: chr
+    Up = transfer(achar(iachar(transfer(string,chr,1))), "x")
+    return
+  end function Up
+  Character (len=20) Function Upper (string)
+    Character(len=*) string
+    Upper =                                                                &
+     transfer(merge(transfer(string,"x",len(string)),    &
+       string, .true.), "x")
+    return
+  end function Upper
+end
+! The sign that all is well is that [S.6][1] appears twice.
+! Platform dependent variations are [S$6][1], [__S_6][1], [S___6][1]
+! { dg-final { scan-tree-dump-times "6\\\]\\\[1\\\]" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/char_cast_2.f90 b/gcc/testsuite/gfortran.dg/char_cast_2.f90
new file mode 100644
index 000000000..4c175bd0f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_cast_2.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+! This is the same as achar_4.f90 but checks that the result of the 'merge'
+! reference is correctly cast.
+!
+! The code comes from http://www.star.le.ac.uk/~cgp/fortran.html (by Clive Page)
+! Reported by Thomas Koenig <tkoenig@gcc.gnu.org>
+!
+  if (any (Up ("AbCdEfGhIjKlM") .ne. (/"ABCDEFGHIJKLM"/))) call abort ()
+contains
+  Character (len=20) Function Up (string)
+    Character(len=*) string
+    Up =                                                                &
+     transfer(merge(achar(iachar(transfer(string,"x",len(string)))-     &
+     (ichar('a')-ichar('A')) ),                                         &
+     transfer(string,"x",len(string)) ,                                 &
+     transfer(string,"x",len(string)) >= "a" .and.                      &
+     transfer(string,"x",len(string)) <= "z"), repeat("x", len(string)))
+    return
+  end function Up
+end
+! The sign that all is well is that [S.5][1] appears twice.
+! Platform dependent variations are [S$5][1], [__S_5][1], [S___5][1]
+! so we count the occurrences of 5][1].
+! { dg-final { scan-tree-dump-times "5\\\]\\\[1\\\]" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/char_comparison_1.f b/gcc/testsuite/gfortran.dg/char_comparison_1.f
new file mode 100644
index 000000000..02f69e076
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_comparison_1.f
@@ -0,0 +1,28 @@
+C { dg-do run }
+C { dg-options "-std=legacy" }
+C
+C     PR 30525 - comparisons with padded spaces were done
+C     signed.
+      program main
+      character*2 c2
+      character*1 c1, c3, c4
+C
+C  Comparison between char(255) and space padding
+C
+      c2 = 'a' // char(255)
+      c1 = 'a'
+      if (.not. (c2 .gt. c1)) call abort
+C
+C  Comparison between char(255) and space
+C
+      c3 = ' '
+      c4 = char(255)
+      if (.not. (c4 .gt. c3)) call abort
+
+C
+C  Check constant folding
+C
+      if (.not. ('a' // char(255) .gt. 'a')) call abort
+
+      if (.not. (char(255) .gt. 'a')) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/char_component_initializer_1.f90 b/gcc/testsuite/gfortran.dg/char_component_initializer_1.f90
new file mode 100644
index 000000000..8642ddfca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_component_initializer_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! Check the fix for PR31487 in which the derived type default initializer
+! would be padded out with nulls instead of spaces.
+!
+! Reported by Harald Anlauf <anlauf@gmx.de>
+!
+program gfcbug62
+  implicit none
+  character(len=16) ::    tdefi(2) = (/'0z1jan0000','1hr       '/)
+  type t_ctl
+     character(len=16) :: tdefi(2) = (/'0z1jan0000','1hr       '/)
+  end type t_ctl
+
+  type(t_ctl) :: ctl
+  integer     :: i,k
+
+  if (tdefi(1) .ne. ctl%tdefi(1)) call abort ()
+end program gfcbug62
diff --git a/gcc/testsuite/gfortran.dg/char_component_initializer_2.f90 b/gcc/testsuite/gfortran.dg/char_component_initializer_2.f90
new file mode 100644
index 000000000..e57fc8659
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_component_initializer_2.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-Wall" }
+! Added -Wall option to make sure PR42526 does not show up again.
+program gfcbug62
+  implicit none
+  character(len=16) ::    tdefi(2) = (/'0z1jan0000','1hr       '/)
+  type t_ctl
+     character(len=16) :: tdefi(2) = (/'0z1jan0000','1hr       '/)
+  end type t_ctl
+
+  type(t_ctl) :: ctl
+  integer     :: i,k
+  i = 1
+  k = 1
+  if (tdefi(1) .ne. ctl%tdefi(1)) call abort ()
+end program gfcbug62
diff --git a/gcc/testsuite/gfortran.dg/char_cons_len.f90 b/gcc/testsuite/gfortran.dg/char_cons_len.f90
new file mode 100644
index 000000000..cf920bdfb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_cons_len.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! Tests the fix for PR24813 in which a character array
+! constructor, as an argument for LEN, would cause an ICE.
+!
+  character(11) :: chr1, chr2
+  i = len ((/chr1, chr2, "ggg        "/))
+  j = len ((/"abcdefghijk", chr1, chr2/))
+  k = len ((/'hello  ','goodbye'/))
+  l = foo ("yes siree, Bob")
+  if (any ((/11,11,7,14/) /= (/i,j,k,l/))) call abort ()
+contains
+  integer function foo (arg)
+    character(*) :: arg
+    character(len(arg)) :: ctor
+    foo = len ((/ctor/))
+  end function foo
+end
diff --git a/gcc/testsuite/gfortran.dg/char_cshift_1.f90 b/gcc/testsuite/gfortran.dg/char_cshift_1.f90
new file mode 100644
index 000000000..7ba61e709
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_cshift_1.f90
@@ -0,0 +1,40 @@
+! Test cshift0 for character arrays.
+! { dg-do run }
+program main
+  implicit none
+  integer, parameter :: n1 = 2, n2 = 3, n3 = 4, slen = 3
+  character (len = slen), dimension (n1, n2, n3) :: a
+  integer (kind = 1) :: shift1 = 3
+  integer (kind = 2) :: shift2 = 4
+  integer (kind = 4) :: shift3 = 5
+  integer (kind = 8) :: shift4 = 6
+  integer :: i1, i2, i3
+
+  do i3 = 1, n3
+    do i2 = 1, n2
+      do i1 = 1, n1
+        a (i1, i2, i3) = 'ab'(i1:i1) // 'cde'(i2:i2) // 'fghi'(i3:i3)
+      end do
+    end do
+  end do
+
+  call test (cshift (a, shift1, 1), int (shift1), 0, 0)
+  call test (cshift (a, shift2, 2), 0, int (shift2), 0)
+  call test (cshift (a, shift3, 3), 0, 0, int (shift3))
+  call test (cshift (a, shift4, 3), 0, 0, int (shift4))
+contains
+  subroutine test (b, d1, d2, d3)
+    character (len = slen), dimension (n1, n2, n3) :: b
+    integer :: d1, d2, d3
+
+    do i3 = 1, n3
+      do i2 = 1, n2
+        do i1 = 1, n1
+          if (b (i1, i2, i3) .ne. a (mod (d1 + i1 - 1, n1) + 1, &
+                                     mod (d2 + i2 - 1, n2) + 1, &
+                                     mod (d3 + i3 - 1, n3) + 1)) call abort
+        end do
+      end do
+    end do
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_cshift_2.f90 b/gcc/testsuite/gfortran.dg/char_cshift_2.f90
new file mode 100644
index 000000000..89d452f71
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_cshift_2.f90
@@ -0,0 +1,45 @@
+! Test cshift1 for character arrays.
+! { dg-do run }
+program main
+  implicit none
+  integer, parameter :: n1 = 2, n2 = 3, n3 = 4, slen = 3
+  character (len = slen), dimension (n1, n2, n3) :: a
+  integer (kind = 1), dimension (2, 4) :: shift1
+  integer (kind = 2), dimension (2, 4) :: shift2
+  integer (kind = 4), dimension (2, 4) :: shift3
+  integer (kind = 8), dimension (2, 4) :: shift4
+  integer :: i1, i2, i3
+
+  do i3 = 1, n3
+    do i2 = 1, n2
+      do i1 = 1, n1
+        a (i1, i2, i3) = 'ab'(i1:i1) // 'cde'(i2:i2) // 'fghi'(i3:i3)
+      end do
+    end do
+  end do
+
+  shift1 (1, :) = (/ 4, 11, 19, 20 /)
+  shift1 (2, :) = (/ 55, 5, 1, 2 /)
+  shift2 = shift1
+  shift3 = shift1
+  shift4 = shift1
+
+  call test (cshift (a, shift1, 2))
+  call test (cshift (a, shift2, 2))
+  call test (cshift (a, shift3, 2))
+  call test (cshift (a, shift4, 2))
+contains
+  subroutine test (b)
+    character (len = slen), dimension (n1, n2, n3) :: b
+    integer :: i2p
+
+    do i3 = 1, n3
+      do i2 = 1, n2
+        do i1 = 1, n1
+          i2p = mod (shift1 (i1, i3) + i2 - 1, n2) + 1
+          if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) call abort
+        end do
+      end do
+    end do
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_cshift_3.f90 b/gcc/testsuite/gfortran.dg/char_cshift_3.f90
new file mode 100644
index 000000000..80c0ede3a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_cshift_3.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! PR 36886 - misalignment of characters for cshift could cause
+! problems on some architectures.
+program main
+  character(len=2) :: c2
+  character(len=4), dimension(2,2) :: a, b, c, d
+  ! Force misalignment of a or b
+  common /foo/ a, c, c2, b, d
+  a = 'aa'
+  b = 'bb'
+  d = cshift(b,1)
+  c = cshift(a,1)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_decl_1.f90 b/gcc/testsuite/gfortran.dg/char_decl_1.f90
new file mode 100644
index 000000000..3bef08342
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_decl_1.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! PR32644 "CHARACTER*1, c" produces "Unclassifiable statement"
+program f
+character*1, c
+end program f
diff --git a/gcc/testsuite/gfortran.dg/char_decl_2.f90 b/gcc/testsuite/gfortran.dg/char_decl_2.f90
new file mode 100644
index 000000000..ffce6b158
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_decl_2.f90
@@ -0,0 +1,4 @@
+! { dg-do run }
+  character (kind=kind("a")) :: u
+  if (kind(u) /= kind("a")) call abort
+  end
diff --git a/gcc/testsuite/gfortran.dg/char_eoshift_1.f90 b/gcc/testsuite/gfortran.dg/char_eoshift_1.f90
new file mode 100644
index 000000000..ba51fa131
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_eoshift_1.f90
@@ -0,0 +1,50 @@
+! Test eoshift0 for character arrays.
+! { dg-do run }
+program main
+  implicit none
+  integer, parameter :: n1 = 6, n2 = 5, n3 = 4, slen = 3
+  character (len = slen), dimension (n1, n2, n3) :: a
+  character (len = slen) :: filler
+  integer (kind = 1) :: shift1 = 4
+  integer (kind = 2) :: shift2 = 2
+  integer (kind = 4) :: shift3 = 3
+  integer (kind = 8) :: shift4 = 1
+  integer :: i1, i2, i3
+
+  do i3 = 1, n3
+    do i2 = 1, n2
+      do i1 = 1, n1
+        a (i1, i2, i3) = 'abcdef'(i1:i1) // 'ghijk'(i2:i2) // 'lmno'(i3:i3)
+      end do
+    end do
+  end do
+
+  call test (eoshift (a, shift1, 'foo', 1), int (shift1), 0, 0, 'foo')
+  call test (eoshift (a, shift2, 'foo', 2), 0, int (shift2), 0, 'foo')
+  call test (eoshift (a, shift3, 'foo', 2), 0, int (shift3), 0, 'foo')
+  call test (eoshift (a, shift4, 'foo', 3), 0, 0, int (shift4), 'foo')
+
+  filler = ''
+  call test (eoshift (a, shift1, dim = 1), int (shift1), 0, 0, filler)
+  call test (eoshift (a, shift2, dim = 2), 0, int (shift2), 0, filler)
+  call test (eoshift (a, shift3, dim = 2), 0, int (shift3), 0, filler)
+  call test (eoshift (a, shift4, dim = 3), 0, 0, int (shift4), filler)
+contains
+  subroutine test (b, d1, d2, d3, filler)
+    character (len = slen), dimension (n1, n2, n3) :: b
+    character (len = slen) :: filler
+    integer :: d1, d2, d3
+
+    do i3 = 1, n3
+      do i2 = 1, n2
+        do i1 = 1, n1
+          if (i1 + d1 .gt. n1 .or. i2 + d2 .gt. n2 .or. i3 + d3 .gt. n3) then
+            if (b (i1, i2, i3) .ne. filler) call abort
+          else
+            if (b (i1, i2, i3) .ne. a (i1 + d1, i2 + d2, i3 + d3)) call abort
+          end if
+        end do
+      end do
+    end do
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_eoshift_2.f90 b/gcc/testsuite/gfortran.dg/char_eoshift_2.f90
new file mode 100644
index 000000000..bdb654c77
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_eoshift_2.f90
@@ -0,0 +1,57 @@
+! Test eoshift1 for character arrays.
+! { dg-do run }
+program main
+  implicit none
+  integer, parameter :: n1 = 2, n2 = 5, n3 = 4, slen = 3
+  character (len = slen), dimension (n1, n2, n3) :: a
+  character (len = slen) :: filler
+  integer (kind = 1), dimension (n1, n3) :: shift1
+  integer (kind = 2), dimension (n1, n3) :: shift2
+  integer (kind = 4), dimension (n1, n3) :: shift3
+  integer (kind = 8), dimension (n1, n3) :: shift4
+  integer :: i1, i2, i3
+
+  shift1 (1, :) = (/ 1, 3, 2, 2 /)
+  shift1 (2, :) = (/ 2, 1, 1, 3 /)
+  shift2 = shift1
+  shift3 = shift1
+  shift4 = shift1
+
+  do i3 = 1, n3
+    do i2 = 1, n2
+      do i1 = 1, n1
+        a (i1, i2, i3) = 'ab'(i1:i1) // 'cdefg'(i2:i2) // 'hijk'(i3:i3)
+      end do
+    end do
+  end do
+
+  call test (eoshift (a, shift1, 'foo', 2), 'foo')
+  call test (eoshift (a, shift2, 'foo', 2), 'foo')
+  call test (eoshift (a, shift3, 'foo', 2), 'foo')
+  call test (eoshift (a, shift4, 'foo', 2), 'foo')
+
+  filler = ''
+  call test (eoshift (a, shift1, dim = 2), filler)
+  call test (eoshift (a, shift2, dim = 2), filler)
+  call test (eoshift (a, shift3, dim = 2), filler)
+  call test (eoshift (a, shift4, dim = 2), filler)
+contains
+  subroutine test (b, filler)
+    character (len = slen), dimension (n1, n2, n3) :: b
+    character (len = slen) :: filler
+    integer :: i2p
+
+    do i3 = 1, n3
+      do i2 = 1, n2
+        do i1 = 1, n1
+          i2p = i2 + shift1 (i1, i3)
+          if (i2p .gt. n2) then
+            if (b (i1, i2, i3) .ne. filler) call abort
+          else
+            if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) call abort
+          end if
+        end do
+      end do
+    end do
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_eoshift_3.f90 b/gcc/testsuite/gfortran.dg/char_eoshift_3.f90
new file mode 100644
index 000000000..62bc04c80
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_eoshift_3.f90
@@ -0,0 +1,54 @@
+! Test eoshift2 for character arrays.
+! { dg-do run }
+program main
+  implicit none
+  integer, parameter :: n1 = 2, n2 = 5, n3 = 4, slen = 3
+  character (len = slen), dimension (n1, n2, n3) :: a
+  character (len = slen), dimension (n1, n3) :: filler
+  integer (kind = 1) :: shift1 = 4
+  integer (kind = 2) :: shift2 = 2
+  integer (kind = 4) :: shift3 = 3
+  integer (kind = 8) :: shift4 = 1
+  integer :: i1, i2, i3
+
+  filler (1, :) = (/ 'tic', 'tac', 'toe', 'tip' /)
+  filler (2, :) = (/ 'zzz', 'yyy', 'xxx', 'www' /)
+
+  do i3 = 1, n3
+    do i2 = 1, n2
+      do i1 = 1, n1
+        a (i1, i2, i3) = 'ab'(i1:i1) // 'cdefg'(i2:i2) // 'hijk'(i3:i3)
+      end do
+    end do
+  end do
+
+  call test (eoshift (a, shift1, filler, 2), int (shift1), .true.)
+  call test (eoshift (a, shift2, filler, 2), int (shift2), .true.)
+  call test (eoshift (a, shift3, filler, 2), int (shift3), .true.)
+  call test (eoshift (a, shift4, filler, 2), int (shift4), .true.)
+
+  call test (eoshift (a, shift1, dim = 2), int (shift1), .false.)
+  call test (eoshift (a, shift2, dim = 2), int (shift2), .false.)
+  call test (eoshift (a, shift3, dim = 2), int (shift3), .false.)
+  call test (eoshift (a, shift4, dim = 2), int (shift4), .false.)
+contains
+  subroutine test (b, d2, has_filler)
+    character (len = slen), dimension (n1, n2, n3) :: b
+    logical :: has_filler
+    integer :: d2
+
+    do i3 = 1, n3
+      do i2 = 1, n2
+        do i1 = 1, n1
+          if (i2 + d2 .le. n2) then
+            if (b (i1, i2, i3) .ne. a (i1, i2 + d2, i3)) call abort
+          else if (has_filler) then
+            if (b (i1, i2, i3) .ne. filler (i1, i3)) call abort
+          else
+            if (b (i1, i2, i3) .ne. '') call abort
+          end if
+        end do
+      end do
+    end do
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_eoshift_4.f90 b/gcc/testsuite/gfortran.dg/char_eoshift_4.f90
new file mode 100644
index 000000000..b7c867090
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_eoshift_4.f90
@@ -0,0 +1,61 @@
+! Test eoshift3 for character arrays.
+! { dg-do run }
+program main
+  implicit none
+  integer, parameter :: n1 = 2, n2 = 5, n3 = 4, slen = 3
+  character (len = slen), dimension (n1, n2, n3) :: a
+  character (len = slen), dimension (n1, n3) :: filler
+  integer (kind = 1), dimension (n1, n3) :: shift1
+  integer (kind = 2), dimension (n1, n3) :: shift2
+  integer (kind = 4), dimension (n1, n3) :: shift3
+  integer (kind = 8), dimension (n1, n3) :: shift4
+  integer :: i1, i2, i3
+
+  filler (1, :) = (/ 'tic', 'tac', 'toe', 'tip' /)
+  filler (2, :) = (/ 'zzz', 'yyy', 'xxx', 'www' /)
+
+  shift1 (1, :) = (/ 1, 3, 2, 2 /)
+  shift1 (2, :) = (/ 2, 1, 1, 3 /)
+  shift2 = shift1
+  shift3 = shift1
+  shift4 = shift1
+
+  do i3 = 1, n3
+    do i2 = 1, n2
+      do i1 = 1, n1
+        a (i1, i2, i3) = 'ab'(i1:i1) // 'cdefg'(i2:i2) // 'hijk'(i3:i3)
+      end do
+    end do
+  end do
+
+  call test (eoshift (a, shift1, filler, 2), .true.)
+  call test (eoshift (a, shift2, filler, 2), .true.)
+  call test (eoshift (a, shift3, filler, 2), .true.)
+  call test (eoshift (a, shift4, filler, 2), .true.)
+
+  call test (eoshift (a, shift1, dim = 2), .false.)
+  call test (eoshift (a, shift2, dim = 2), .false.)
+  call test (eoshift (a, shift3, dim = 2), .false.)
+  call test (eoshift (a, shift4, dim = 2), .false.)
+contains
+  subroutine test (b, has_filler)
+    character (len = slen), dimension (n1, n2, n3) :: b
+    logical :: has_filler
+    integer :: i2p
+
+    do i3 = 1, n3
+      do i2 = 1, n2
+        do i1 = 1, n1
+          i2p = i2 + shift1 (i1, i3)
+          if (i2p .le. n2) then
+            if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) call abort
+          else if (has_filler) then
+            if (b (i1, i2, i3) .ne. filler (i1, i3)) call abort
+          else
+            if (b (i1, i2, i3) .ne. '') call abort
+          end if
+        end do
+      end do
+    end do
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_eoshift_5.f90 b/gcc/testsuite/gfortran.dg/char_eoshift_5.f90
new file mode 100644
index 000000000..a3bbd40d5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_eoshift_5.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+
+! PR fortran/36403
+! Check that the string length of BOUNDARY is added to the library-eoshift
+! call even if BOUNDARY is missing (as it is optional).
+! This is the original test from the PR.
+
+! Contributed by Kazumoto Kojima.
+
+  CHARACTER(LEN=3), DIMENSION(10) :: Z
+  call test_eoshift
+contains
+  subroutine test_eoshift 
+    CHARACTER(LEN=1), DIMENSION(10) :: chk
+    chk(1:8) = "5"
+    chk(9:10) = " "
+    Z(:)="456"
+    if (any (EOSHIFT(Z(:)(2:2),2) .ne. chk)) call abort 
+  END subroutine
+END
+
+! Check that _gfortran_eoshift* is called with 8 arguments:
+! { dg-final { scan-tree-dump "_gfortran_eoshift\[0-9_\]+char \\(\[&a-zA-Z0-9._\]*, \[&a-zA-Z0-9._\]*, \[&a-zA-Z0-9._\]*, \[&a-zA-Z0-9._\]*, \[&a-zA-Z0-9._\]*, \[&a-zA-Z0-9._\]*, \[&a-zA-Z0-9._\]*, \[&a-zA-Z0-9._\]*\\)" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/char_expr_1.f90 b/gcc/testsuite/gfortran.dg/char_expr_1.f90
new file mode 100644
index 000000000..35bfe3477
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_expr_1.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! PR fortran/36795
+! "(str)" (= an expression) was regarded as "str" (= a variable)
+! and thus when yy was deallocated so was xx. Result: An invalid
+! memory access.
+!
+program main
+  implicit none
+  character (len=10), allocatable :: str(:)
+  allocate (str(1))
+  str(1)      = "dog"
+  if (size(str) /= 1 .or. str(1) /= "dog") call abort()
+contains
+  subroutine foo(xx,yy)
+    character (len=*), intent(in)               :: xx(:)
+    character (len=*), intent(out), allocatable :: yy(:)
+    allocate (yy(size(xx)))
+    yy = xx
+  end subroutine foo
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_expr_2.f90 b/gcc/testsuite/gfortran.dg/char_expr_2.f90
new file mode 100644
index 000000000..f3bfb04b2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_expr_2.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! PR fortran/36803
+! PR fortran/36795
+!
+! "(n)" was simplified to the EXPR_VARIABLE "n"
+! and thus "(n)" was judged as definable.
+!
+interface
+  subroutine foo(x)
+    character, intent(out) :: x(:)  ! or INTENT(INOUT)
+  end subroutine foo
+end interface
+character :: n(5)
+call foo( (n) ) ! { dg-error "Non-variable expression" }
+end
diff --git a/gcc/testsuite/gfortran.dg/char_expr_3.f90 b/gcc/testsuite/gfortran.dg/char_expr_3.f90
new file mode 100644
index 000000000..fed0f3c78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_expr_3.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! Check the fix for PR36795, where the parentheses in the call to foo were
+! simplified out ie. foo((xx), xx) simplified to foo (xx, xx)
+!
+! Conributed by Vivek Rao <vivekrao4@yahoo.com>
+!
+program main
+  implicit none
+  character(len=10), allocatable :: xx(:)
+  character(len=10)              :: yy
+  allocate (xx(2))
+  xx(1)      = ""
+  xx(2)      = "dog"
+  call foo ((xx),xx)
+  if (trim (xx(1)) .ne. "dog") call abort
+  if (size (xx, 1) .ne. 1) call abort
+contains
+  subroutine foo (xx,yy)
+  character(len=*), intent(in)               :: xx(:)
+  character(len=*), intent(out), allocatable :: yy(:)
+  if (allocated (yy)) deallocate (yy)
+  allocate (yy(1))
+  yy = xx(2)
+  end subroutine foo
+end program main
+
diff --git a/gcc/testsuite/gfortran.dg/char_initialiser_actual.f90 b/gcc/testsuite/gfortran.dg/char_initialiser_actual.f90
new file mode 100644
index 000000000..dbd78909e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_initialiser_actual.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! Tests passing of character array initialiser as actual argument.
+! Fixes PR18109.
+! Contributed by Paul Thomas pault@gcc.gnu.org  
+program char_initialiser
+  character*5, dimension(3) :: x
+  character*5, dimension(:), pointer :: y
+  x=(/"is Ja","ne Fo","nda  "/)
+  call sfoo ("is Ja", x(1))
+  call afoo ((/"is Ja","ne Fo","nda  "/), x)
+  y => pfoo ((/"is Ja","ne Fo","nda  "/))
+  call afoo (y, x)
+contains
+  subroutine sfoo(ch1, ch2)
+     character*(*)               :: ch1, ch2
+     if (ch1 /= ch2) call abort ()
+  end subroutine sfoo
+  subroutine afoo(ch1, ch2)
+     character*(*), dimension(:) :: ch1, ch2
+     if (any(ch1 /= ch2)) call abort ()
+  end subroutine afoo
+  function pfoo(ch2)
+     character*5, dimension(:), target  :: ch2
+     character*5, dimension(:), pointer :: pfoo
+     allocate(pfoo(size(ch2)))
+     pfoo = ch2
+  end function pfoo
+end program
diff --git a/gcc/testsuite/gfortran.dg/char_length_1.f90 b/gcc/testsuite/gfortran.dg/char_length_1.f90
new file mode 100644
index 000000000..3f92f0efa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-Wall -std=f2003" }
+! Tests the patch for PR27996 and PR27998, in which warnings
+! or errors were not emitted when the length of character
+! constants was changed silently.
+!
+! Contributed by Tobias Burnus <tobias.burnus@physik.fu-berlin.de> 
+!
+program test
+  implicit none
+  character(10) :: a(3)
+  character(10) :: b(3)= &
+       (/ 'Takata ', 'Tanaka', 'Hayashi' /) ! { dg-error "Different CHARACTER" }
+  character(4) :: c = "abcde"  ! { dg-warning "being truncated" }
+  a =  (/ 'Takata', 'Tanaka ', 'Hayashi' /) ! { dg-error "Different CHARACTER" }
+  a =  (/ 'Takata ', 'Tanaka ', 'Hayashi' /)
+  b = "abc" ! { dg-error "no IMPLICIT" }
+  c = "abcdefg"   ! { dg-warning "will be truncated" }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/char_length_10.f90 b/gcc/testsuite/gfortran.dg/char_length_10.f90
new file mode 100644
index 000000000..07f10df98
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_10.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! Checks the fix for PR33241, in which the assumed character
+! length of the parameter was never filled in with that of
+! the initializer.
+!
+! Contributed by Victor Prosolin <victor.prosolin@gmail.com>
+!
+PROGRAM fptest

+  IMPLICIT NONE

+  CHARACTER (LEN=*), DIMENSION(1),  PARAMETER :: var  = 'a'

+  CALL parsef (var)

+contains

+  SUBROUTINE parsef (Var)

+    IMPLICIT NONE

+    CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var

+  END SUBROUTINE parsef

+END PROGRAM fptest

diff --git a/gcc/testsuite/gfortran.dg/char_length_11.f90 b/gcc/testsuite/gfortran.dg/char_length_11.f90
new file mode 100644
index 000000000..e745c123e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_11.f90
@@ -0,0 +1,5 @@
+! { dg-do compile }
+
+  character(len=*), parameter :: s = "foo"
+  write (*,*) adjustr(s(:))
+end
diff --git a/gcc/testsuite/gfortran.dg/char_length_12.f90 b/gcc/testsuite/gfortran.dg/char_length_12.f90
new file mode 100644
index 000000000..f22eb6c72
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_12.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+
+  implicit none
+  character(len=3), dimension(3,3), parameter :: &
+    p = reshape(["xyz", "abc", "mkl", "vpn", "lsd", "epo", "tgv", &
+                 "bbc", "wto"], [3,3])
+  character(len=3), dimension(3,3) :: m1
+
+  m1 = p
+  if (any (spread (p, 1, 2) /= spread (m1, 1, 2))) call abort
+
+end
diff --git a/gcc/testsuite/gfortran.dg/char_length_13.f90 b/gcc/testsuite/gfortran.dg/char_length_13.f90
new file mode 100644
index 000000000..576d5be77
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_13.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+!
+! PR fortran/38095
+!
+! Contributed by Vivek Rao
+!
+! Compiling the program below gave an ICE
+!
+module bar
+  implicit none
+contains
+elemental function trim_append(xx,yy) result(xy)
+  character (len=*), intent(in) :: xx,yy
+  character (len=len(xx) + len(yy)) :: xy
+  xy = trim(xx) // yy
+end function trim_append
+function same(xx) result(yy)
+  character (len=*), intent(in) :: xx(:)
+  character (len=len(xx))       :: yy(size(xx))
+  yy = [xx]
+end function same
+subroutine foo(labels)
+  character (len=*), intent(in) :: labels(:)
+  print*,"size(labels)=",size(labels)
+end subroutine foo
+subroutine xmain()
+  call foo(trim_append(["a"],same(["b"])))
+end subroutine xmain
+end module bar
+
+program main
+  use bar
+  call xmain()
+end program main
+
+! { dg-final { cleanup-modules "bar" } }
diff --git a/gcc/testsuite/gfortran.dg/char_length_14.f90 b/gcc/testsuite/gfortran.dg/char_length_14.f90
new file mode 100644
index 000000000..5827dd95e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_14.f90
@@ -0,0 +1,23 @@
+! { dg-do run }

+! PR35937, in which letting the length of 'c' to kind = 8 would

+! screw up the interface and would cause an ICE. Note that this is

+! actually the example of comment #4.

+!

+! Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>

+!

+program main

+  implicit none

+  if (f5 ('1') .ne. "a") call abort

+  if (len (f5 ('1')) .ne. 1) call abort

+  if (f5 ('4') .ne. "abcd") call abort

+  if (len (f5 ('4')) .ne. 4) call abort

+contains

+  function f5 (c)

+    character(len=1_8) :: c

+    character(len=scan('123456789', c)) :: f5

+    integer :: i

+    do i = 1, len (f5)

+       f5(i:i) = char (i+96)

+    end do

+  end function f5

+end program main

diff --git a/gcc/testsuite/gfortran.dg/char_length_15.f90 b/gcc/testsuite/gfortran.dg/char_length_15.f90
new file mode 100644
index 000000000..700da0eb1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_15.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! Test the fix for PR38915 in which the character length of the
+! temporaries produced in the assignments marked below was set to
+! one.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+program cg0033_41
+  type t
+    sequence
+    integer i
+    character(len=9) c
+  end type t
+  type (t)  L(3),R(3), LL(4), RR(4)
+  EQUIVALENCE (L,LL)
+  integer nfv1(3), nfv2(3)
+  R(1)%c = '123456789'
+  R(2)%c = 'abcdefghi'
+  R(3)%c = '!@#$%^&*('
+  L%c = R%c
+  LL(1:3)%c = R%c
+  LL(4)%c = 'QWERTYUIO'
+  RR%c = LL%c            ! The equivalence forces a dependency
+  L%c = LL(2:4)%c
+  if (any (RR(2:4)%c .ne. L%c)) call abort
+  nfv1 = (/1,2,3/)
+  nfv2 = nfv1
+  L%c = R%c
+  L(nfv1)%c = L(nfv2)%c  ! The vector indices force a dependency
+  if (any (R%c .ne. L%c)) call abort
+end
+
diff --git a/gcc/testsuite/gfortran.dg/char_length_16.f90 b/gcc/testsuite/gfortran.dg/char_length_16.f90
new file mode 100644
index 000000000..3ff14d239
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_16.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+!
+! PR 40822: [4.5 Regression] Internal compiler error when Fortran intrinsic LEN referenced before explicit declaration
+!
+! Contributed by Mat Cross <mathewc@nag.co.uk>
+
+SUBROUTINE SEARCH(ITEMVAL)
+  CHARACTER (*) :: ITEMVAL
+  CHARACTER (LEN(ITEMVAL)) :: ITEM
+  INTRINSIC LEN
+END
+
diff --git a/gcc/testsuite/gfortran.dg/char_length_17.f90 b/gcc/testsuite/gfortran.dg/char_length_17.f90
new file mode 100644
index 000000000..5752dd1f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_17.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+! PR 34145 - the length of the string should be simplified to one,
+! no library call for string comparison is necessary.
+program main
+  character (len=5) :: c
+  integer(kind=8) :: i
+  i = 3
+  c(i:i) = 'a'
+  c(i+1:i+1) = 'b'
+  if (c(i:i) /= 'a') call abort ()
+  if (c(i+1:i+1) /= 'b') call abort ()
+end program main
+! { dg-final { scan-tree-dump-times "gfortran_compare_string" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/char_length_18.f90 b/gcc/testsuite/gfortran.dg/char_length_18.f90
new file mode 100644
index 000000000..9fd31c862
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_18.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR 45576 - no ICE for missing optional argument
+! Test case supplied by Joost VandeVondele
+SUBROUTINE get_r_val()
+  INTEGER, PARAMETER :: default_string_length=128
+  CHARACTER(len=default_string_length) :: c_val
+  LOGICAL                              :: check 
+  check = c_val(LEN_TRIM(c_val):LEN_TRIM(c_val))=="]"
+END SUBROUTINE get_r_val
diff --git a/gcc/testsuite/gfortran.dg/char_length_2.f90 b/gcc/testsuite/gfortran.dg/char_length_2.f90
new file mode 100644
index 000000000..5673a2ed5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_2.f90
@@ -0,0 +1,22 @@
+! { dg-do link }
+! { dg-options "-Wsurprising" }
+! Tests the fix for PR 31250
+! CHARACTER lengths weren't reduced early enough for all checks of
+! them to be meaningful.  Furthermore negative string lengths weren't
+! dealt with correctly.
+CHARACTER(len=0) :: c1   ! This is OK.
+CHARACTER(len=-1) :: c2  ! { dg-warning "has negative length" }
+PARAMETER(I=-100)
+CHARACTER(len=I) :: c3   ! { dg-warning "has negative length" }
+CHARACTER(len=min(I,500)) :: c4  ! { dg-warning "has negative length" }
+CHARACTER(len=max(I,500)) :: d1  ! no warning
+CHARACTER(len=5) :: d2   ! no warning
+
+if (len(c1) .ne. 0) call link_error ()
+if (len(c2) .ne. len(c1)) call link_error ()
+if (len(c3) .ne. len(c2)) call link_error ()
+if (len(c4) .ne. len(c3)) call link_error ()
+
+if (len(d1) .ne. 500) call link_error ()
+if (len(d2) .ne. 5) call link_error ()
+END
diff --git a/gcc/testsuite/gfortran.dg/char_length_3.f90 b/gcc/testsuite/gfortran.dg/char_length_3.f90
new file mode 100644
index 000000000..97f7fb4c0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_3.f90
@@ -0,0 +1,49 @@
+! { dg-do compile }
+! PR fortran/25071
+! Check if actual argument is too short
+!
+        program test
+           implicit none
+           character(len=10) :: v
+           character(len=10), target :: x
+           character(len=20), target :: y
+           character(len=30), target :: z
+           character(len=10), pointer :: ptr1
+           character(len=20), pointer :: ptr2
+           character(len=30), pointer :: ptr3
+           character(len=10), allocatable :: alloc1(:)
+           character(len=20), allocatable :: alloc2(:)
+           character(len=30), allocatable :: alloc3(:)
+           call foo(v) ! { dg-warning "actual argument shorter than of dummy" }
+           call foo(x) ! { dg-warning "actual argument shorter than of dummy" }
+           call foo(y)
+           call foo(z)
+           ptr1 => x
+           call foo(ptr1) ! { dg-warning "actual argument shorter than of dummy" }
+           call bar(ptr1) ! { dg-warning "Character length mismatch" }
+           ptr2 => y
+           call foo(ptr2)
+           call bar(ptr2)
+           ptr3 => z
+           call foo(ptr3)
+           call bar(ptr3) ! { dg-warning "Character length mismatch" }
+           allocate(alloc1(1))
+           allocate(alloc2(1))
+           allocate(alloc3(1))
+           call arr(alloc1) ! { dg-warning "Character length mismatch" }
+           call arr(alloc2)
+           call arr(alloc3) ! { dg-warning "Character length mismatch" }
+        contains
+        subroutine foo(y)
+           character(len=20) :: y
+           y = 'hello world'
+        end subroutine
+        subroutine bar(y)
+           character(len=20),pointer :: y
+           y = 'hello world'
+        end subroutine
+        subroutine arr(y)
+           character(len=20),allocatable :: y(:)
+           y(1) = 'hello world'
+        end subroutine
+       end
diff --git a/gcc/testsuite/gfortran.dg/char_length_4.f90 b/gcc/testsuite/gfortran.dg/char_length_4.f90
new file mode 100644
index 000000000..13a9b781b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_4.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! tests the fix for PR31540, in which the character lengths in
+! parentheses were not resolved.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+        subroutine pfb()
+        implicit none
+        external pfname1, pfname2
+        character ((136)) pfname1
+        character ((129+7)) pfname2
+        return
+        end
diff --git a/gcc/testsuite/gfortran.dg/char_length_5.f90 b/gcc/testsuite/gfortran.dg/char_length_5.f90
new file mode 100644
index 000000000..03a4d8560
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_5.f90
@@ -0,0 +1,61 @@
+! { dg-do run }
+! Tests the fix for PR31867, in which the interface evaluation
+! of the character length of 'join' (ie. the length available in
+! the caller) was wrong.
+!
+! Contributed by <beliavsky@aol.com> 
+!
+module util_mod
+  implicit none
+contains
+  function join (words, sep) result(str)
+    character (len=*), intent(in)        :: words(:),sep
+    character (len = (size (words) - 1) * len_trim (sep) + & 
+               sum (len_trim (words)))   :: str
+    integer                              :: i,nw
+    nw  = size (words)
+    str = ""
+    if (nw < 1) then
+      return
+    else
+      str = words(1)
+    end if
+    do i=2,nw
+      str = trim (str) // trim (sep) // words(i)
+    end do
+  end function join
+end module util_mod
+!
+program xjoin
+  use util_mod, only: join
+  implicit none
+  integer yy
+  character (len=5) :: words(5:8) = (/"two  ","three","four ","five "/), sep = "^#^"
+  character (len=5) :: words2(4) = (/"bat  ","ball ","goal ","stump"/), sep2 = "&"
+
+  if (join (words, sep) .ne. "two^#^three^#^four^#^five") call abort ()
+  if (len (join (words, sep)) .ne. 25) call abort ()
+
+  if (join (words(5:6), sep) .ne. "two^#^three") call abort ()
+  if (len (join (words(5:6), sep)) .ne. 11) call abort ()
+
+  if (join (words(7:8), sep) .ne. "four^#^five") call abort ()
+  if (len (join (words(7:8), sep)) .ne. 11) call abort ()
+
+  if (join (words(5:7:2), sep) .ne. "two^#^four") call abort ()
+  if (len (join (words(5:7:2), sep)) .ne. 10) call abort ()
+
+  if (join (words(6:8:2), sep) .ne. "three^#^five") call abort ()
+  if (len (join (words(6:8:2), sep)) .ne. 12) call abort ()
+
+  if (join (words2, sep2) .ne. "bat&ball&goal&stump") call abort ()
+  if (len (join (words2, sep2)) .ne. 19) call abort ()
+
+  if (join (words2(1:2), sep2) .ne. "bat&ball") call abort ()
+  if (len (join (words2(1:2), sep2)) .ne. 8) call abort ()
+
+  if (join (words2(2:4:2), sep2) .ne. "ball&stump") call abort ()
+  if (len (join (words2(2:4:2), sep2)) .ne. 10) call abort ()
+
+end program xjoin
+! { dg-final { cleanup-modules "util_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/char_length_6.f90 b/gcc/testsuite/gfortran.dg/char_length_6.f90
new file mode 100644
index 000000000..1a8b2f106
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_6.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+!
+program test
+  character(2_8) :: c(2)
+  logical :: l(2)
+
+  c = "aa"
+  l = c .eq. "aa"
+  if (any (.not. l)) call abort
+
+  call foo ([c(1)])
+  l = c .eq. "aa"
+  if (any (.not. l)) call abort
+
+contains
+
+  subroutine foo (c)
+    character(2) :: c(1)
+  end subroutine foo
+
+end
diff --git a/gcc/testsuite/gfortran.dg/char_length_7.f90 b/gcc/testsuite/gfortran.dg/char_length_7.f90
new file mode 100644
index 000000000..221c84090
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_7.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! Test the fix for PR31879 in which the concatenation operators below
+! would cause ICEs because the character lengths were never resolved.
+!
+! Contributed by Vivek Rao <vivekrao4@yahoo.com> 
+!
+module str_mod
+  character(3) :: mz(2) = (/"fgh","ijk"/)
+contains
+  function ccopy(yy) result(xy)
+    character (len=*), intent(in) :: yy(:)
+    character (len=5) :: xy(size(yy))
+    xy = yy
+  end function ccopy
+end module str_mod
+!
+program xx
+  use str_mod, only: ccopy, mz
+  implicit none
+  character(2) :: z = "zz"
+  character(3) :: zz(2) = (/"abc","cde"/)
+  character(2) :: ans(2)
+  integer :: i = 2, j = 3
+  if (any(ccopy("_&_"//(/"A","B"/)//"?") .ne. (/"_&_A?","_&_B?"/))) call abort ()
+  if (any(ccopy(z//zz) .ne. (/"zzabc","zzcde"/))) call abort ()
+  if (any(ccopy(z//zz(:)(1:2)) .ne. (/"zzab ","zzcd "/))) call abort ()
+  if (any(ccopy(z//mz(:)(2:3)) .ne. (/"zzgh ","zzjk "/))) call abort ()
+
+! This was another bug, uncovered when the PR was fixed.
+  if (any(ccopy(z//mz(:)(i:j)) .ne. (/"zzgh ","zzjk "/))) call abort ()
+end program xx
+! { dg-final { cleanup-modules "str_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/char_length_8.f90 b/gcc/testsuite/gfortran.dg/char_length_8.f90
new file mode 100644
index 000000000..dd91de314
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_8.f90
@@ -0,0 +1,69 @@
+! { dg-do run }
+! Test the fix for PR31197 and PR31258 in which the substrings below
+! would cause ICEs because the character lengths were never resolved.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk> 
+!            and Thomas Koenig <tkoenig@gcc.gnu.org>
+!
+  CHARACTER(LEN=3), DIMENSION(10) :: Z
+  CHARACTER(LEN=3), DIMENSION(3,3) :: W
+  integer :: ctr = 0
+  call test_reshape
+  call test_eoshift
+  call test_cshift
+  call test_spread
+  call test_transpose
+  call test_pack
+  call test_unpack
+  call test_pr31197
+  if (ctr .ne. 8) call abort
+contains
+  subroutine test_reshape 
+    Z(:)="123"
+    if (any (RESHAPE(Z(:)(2:2),(/5,2/)) .ne. "2")) call abort 
+    ctr = ctr + 1
+  end subroutine
+  subroutine test_eoshift 
+    CHARACTER(LEN=1), DIMENSION(10) :: chk
+    chk(1:8) = "5"
+    chk(9:10) = " "
+    Z(:)="456"
+    if (any (EOSHIFT(Z(:)(2:2),2) .ne. chk)) call abort 
+    ctr = ctr + 1
+  END subroutine
+  subroutine test_cshift 
+    Z(:)="901"
+    if (any (CSHIFT(Z(:)(2:2),2) .ne. "0")) call abort 
+    ctr = ctr + 1
+  end subroutine
+  subroutine test_spread 
+    Z(:)="789"
+    if (any (SPREAD(Z(:)(2:2),dim=1,ncopies=2) .ne. "8")) call abort 
+    ctr = ctr + 1
+  end subroutine
+  subroutine test_transpose 
+    W(:, :)="abc"
+    if (any (TRANSPOSE(W(:,:)(1:2)) .ne. "ab")) call abort 
+    ctr = ctr + 1
+  end subroutine
+  subroutine test_pack 
+    W(:, :)="def"
+    if (any (pack(W(:,:)(2:3),mask=.true.) .ne. "ef")) call abort 
+    ctr = ctr + 1
+  end subroutine
+  subroutine test_unpack 
+    logical, dimension(5,2) :: mask
+    Z(:)="hij"
+    mask = .true.
+    if (any (unpack(Z(:)(2:2),mask,' ') .ne. "i")) call abort 
+    ctr = ctr + 1
+  end subroutine
+  subroutine test_pr31197
+    TYPE data
+      CHARACTER(LEN=3) :: A = "xyz"
+    END TYPE
+    TYPE(data), DIMENSION(10), TARGET :: T
+    if (any (TRANSPOSE(RESHAPE(T(:)%A(2:2),(/5,2/))) .ne. "y")) call abort 
+    ctr = ctr + 1
+  end subroutine
+END
diff --git a/gcc/testsuite/gfortran.dg/char_length_9.f90 b/gcc/testsuite/gfortran.dg/char_length_9.f90
new file mode 100644
index 000000000..dbec68cd8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_9.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! Test the fix for a regression caused by the first fix of PR31879.
+! Reported by Tobias Burnus <burnus@gcc.gnu.org>
+!
+MODULE input_val_types
+  IMPLICIT NONE
+  INTEGER, PARAMETER :: default_string_length=80
+  TYPE val_type
+    CHARACTER(len=default_string_length), DIMENSION(:), POINTER :: c_val
+  END TYPE val_type
+CONTAINS
+  SUBROUTINE val_get (val, c_val)
+    TYPE(val_type), POINTER                  :: val
+    CHARACTER(LEN=*), INTENT(out)            :: c_val
+    INTEGER                                  :: i, l_out
+    i=1
+    c_val((i-1)*default_string_length+1:MIN (l_out, i*default_string_length)) = &
+               val%c_val(i)(1:MIN (80, l_out-(i-1)*default_string_length))
+  END SUBROUTINE val_get
+END MODULE input_val_types
+
+! { dg-final { cleanup-modules "input_val_types" } }
diff --git a/gcc/testsuite/gfortran.dg/char_pack_1.f90 b/gcc/testsuite/gfortran.dg/char_pack_1.f90
new file mode 100644
index 000000000..839f6c6b1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pack_1.f90
@@ -0,0 +1,59 @@
+! Test (non-scalar) pack for character arrays.
+! { dg-do run }
+program main
+  implicit none
+  integer, parameter :: n1 = 3, n2 = 4, nv = 10, slen = 9
+  character (len = slen), dimension (n1, n2) :: a
+  character (len = slen), dimension (nv) :: vector
+  logical, dimension (n1, n2) :: mask
+  integer :: i1, i2, i
+
+  do i2 = 1, n2
+    do i1 = 1, n1
+      a (i1, i2) = 'abc'(i1:i1) // 'defg'(i2:i2) // 'cantrip'
+    end do
+  end do
+  mask (1, :) = (/ .true., .false., .true., .true. /)
+  mask (2, :) = (/ .true., .false., .false., .false. /)
+  mask (3, :) = (/ .false., .true., .true., .true. /)
+
+  do i = 1, nv
+    vector (i) = 'crespo' // '0123456789'(i:i)
+  end do
+
+  call test1 (pack (a, mask))
+  call test2 (pack (a, mask, vector))
+contains
+  subroutine test1 (b)
+    character (len = slen), dimension (:) :: b
+
+    i = 0
+    do i2 = 1, n2
+      do i1 = 1, n1
+        if (mask (i1, i2)) then
+          i = i + 1
+          if (b (i) .ne. a (i1, i2)) call abort
+        end if
+      end do
+    end do
+    if (size (b, 1) .ne. i) call abort
+  end subroutine test1
+
+  subroutine test2 (b)
+    character (len = slen), dimension (:) :: b
+
+    if (size (b, 1) .ne. nv) call abort
+    i = 0
+    do i2 = 1, n2
+      do i1 = 1, n1
+        if (mask (i1, i2)) then
+          i = i + 1
+          if (b (i) .ne. a (i1, i2)) call abort
+        end if
+      end do
+    end do
+    do i = i + 1, nv
+      if (b (i) .ne. vector (i)) call abort
+    end do
+  end subroutine test2
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_pack_2.f90 b/gcc/testsuite/gfortran.dg/char_pack_2.f90
new file mode 100644
index 000000000..4bf165b29
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pack_2.f90
@@ -0,0 +1,53 @@
+! Test scalar pack for character arrays.
+! { dg-do run }
+program main
+  implicit none
+  integer, parameter :: n1 = 3, n2 = 4, nv = 16, slen = 9
+  character (len = slen), dimension (n1, n2) :: a
+  character (len = slen), dimension (nv) :: vector
+  logical :: mask
+  integer :: i1, i2, i
+
+  do i2 = 1, n2
+    do i1 = 1, n1
+      a (i1, i2) = 'abc'(i1:i1) // 'defg'(i2:i2) // 'cantrip'
+    end do
+  end do
+
+  do i = 1, nv
+    vector (i) = 'crespo' // '0123456789abcdef'(i:i)
+  end do
+
+  mask = .true.
+  call test1 (pack (a, mask))
+  call test2 (pack (a, mask, vector))
+contains
+  subroutine test1 (b)
+    character (len = slen), dimension (:) :: b
+
+    i = 0
+    do i2 = 1, n2
+      do i1 = 1, n1
+        i = i + 1
+        if (b (i) .ne. a (i1, i2)) call abort
+      end do
+    end do
+    if (size (b, 1) .ne. i) call abort
+  end subroutine test1
+
+  subroutine test2 (b)
+    character (len = slen), dimension (:) :: b
+
+    if (size (b, 1) .ne. nv) call abort
+    i = 0
+    do i2 = 1, n2
+      do i1 = 1, n1
+        i = i + 1
+        if (b (i) .ne. a (i1, i2)) call abort
+      end do
+    end do
+    do i = i + 1, nv
+      if (b (i) .ne. vector (i)) call abort
+    end do
+  end subroutine test2
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_pointer_assign.f90 b/gcc/testsuite/gfortran.dg/char_pointer_assign.f90
new file mode 100644
index 000000000..62fcf0360
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_assign.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+program char_pointer_assign

+! Test character pointer assignments, required

+! to fix PR18890 and PR21297

+! Provided by Paul Thomas pault@gcc.gnu.org

+  implicit none

+  character*4, target        :: t1

+  character*4, target        :: t2(4) =(/"lmno","lmno","lmno","lmno"/)

+  character*4                :: const

+  character*4, pointer       :: c1, c3

+  character*4, pointer       :: c2(:), c4(:)
+  allocate (c3, c4(4))

+! Scalars first.

+  c3 = "lmno"          ! pointer = constant

+  t1 = c3              ! target = pointer

+  c1 => t1             ! pointer =>target

+  c1(2:3) = "nm"

+  c3 = c1              ! pointer = pointer

+  c3(1:1) = "o"

+  c3(4:4) = "l"

+  c1 => c3             ! pointer => pointer

+  if (t1 /= "lnmo") call abort ()

+  if (c1 /= "onml") call abort ()

+

+! Now arrays.

+  c4 = "lmno"          ! pointer = constant

+  t2 = c4              ! target = pointer
+  c2 => t2             ! pointer =>target
+  const = c2(1)
+  const(2:3) ="nm"     ! c2(:)(2:3) = "nm" is still broken

+  c2 = const

+  c4 = c2              ! pointer = pointer

+  const = c4(1)
+  const(1:1) ="o"      ! c4(:)(1:1) = "o" is still broken

+  const(4:4) ="l"      ! c4(:)(4:4) = "l" is still broken

+  c4 = const

+  c2 => c4             ! pointer => pointer

+  if (any (t2 /= "lnmo")) call abort ()

+  if (any (c2 /= "onml")) call abort ()

+  deallocate (c3, c4)

+end program char_pointer_assign
+
diff --git a/gcc/testsuite/gfortran.dg/char_pointer_assign_2.f90 b/gcc/testsuite/gfortran.dg/char_pointer_assign_2.f90
new file mode 100644
index 000000000..c67bbb4af
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_assign_2.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! Tests the fix for PRs20895 and 25030, where pointer assignments
+! of different length characters were accepted.
+  character(4), target :: ch1(2)
+  character(4), pointer :: ch2(:)
+  character(5), pointer :: ch3(:)
+
+  ch2 => ch1  ! Check correct is OK
+  ch3 => ch1  ! { dg-error "Unequal character lengths \\(5/4\\)" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/char_pointer_assign_3.f90 b/gcc/testsuite/gfortran.dg/char_pointer_assign_3.f90
new file mode 100644
index 000000000..21db2df14
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_assign_3.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR fortran/31803
+! Assigning a substring to a pointer
+
+program test
+  implicit none
+  character (len = 7), target :: textt
+  character (len = 7), pointer :: textp
+  character (len = 5), pointer :: textp2
+  textp => textt
+  textp2 => textt(1:5)
+  if(len(textp)  /= 7) call abort()
+  if(len(textp2) /= 5) call abort()
+  textp  = 'aaaaaaa'
+  textp2 = 'bbbbbbb'
+  if(textp  /= 'bbbbbaa') call abort()
+  if(textp2 /= 'bbbbb') call abort()
+end program test
diff --git a/gcc/testsuite/gfortran.dg/char_pointer_assign_4.f90 b/gcc/testsuite/gfortran.dg/char_pointer_assign_4.f90
new file mode 100644
index 000000000..7dfc39b94
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_assign_4.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Unequal character length" }
+
+! PR fortran/31822
+! Verify that runtime checks for matching character length
+! in pointer assignment work.
+
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+program ptr
+  implicit none
+  character(len=10), target :: s1
+  character(len=5), pointer :: p1
+  integer, volatile :: i
+  i = 8
+  p1 => s1(1:i) 
+end program ptr
+
+! { dg-output "Unequal character lengths \\(5/8\\)" }
diff --git a/gcc/testsuite/gfortran.dg/char_pointer_assign_5.f90 b/gcc/testsuite/gfortran.dg/char_pointer_assign_5.f90
new file mode 100644
index 000000000..471f6e6b1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_assign_5.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Unequal character length" }
+
+! PR fortran/31822
+! Verify that runtime checks for matching character length
+! in pointer assignment work.
+
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+program ptr
+  implicit none
+  character(len=10), target :: s1
+  call bar((/ s1, s1 /))
+contains
+  subroutine bar(s)
+    character(len=*),target  :: s(2)
+    character(len=17),pointer :: p(:)
+    p => s
+  end subroutine bar
+end program ptr
+
+! { dg-output "Unequal character lengths \\(17/10\\)" }
diff --git a/gcc/testsuite/gfortran.dg/char_pointer_assign_6.f90 b/gcc/testsuite/gfortran.dg/char_pointer_assign_6.f90
new file mode 100644
index 000000000..cd90bfc06
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_assign_6.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! PR 31821
+program main
+  character (len=4), pointer:: s1
+  character (len=20), pointer :: p1
+  character (len=4) :: c
+  s1 = 'abcd'
+  p1 => s1(2:3) ! { dg-error "Unequal character lengths \\(20/2\\)" }
+  p1 => c(1:) ! { dg-error "Unequal character lengths \\(20/4\\)" }
+  p1 => c(:4) ! { dg-error "Unequal character lengths \\(20/4\\)" }
+end
diff --git a/gcc/testsuite/gfortran.dg/char_pointer_comp_assign.f90 b/gcc/testsuite/gfortran.dg/char_pointer_comp_assign.f90
new file mode 100644
index 000000000..4e2d853b1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_comp_assign.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! This test the fix of PR18283, where assignments of scalar,
+! character pointer components of derived types caused an ICE.
+! It also checks that the array counterparts remain operational.
+! Contributed by Paul Thomas  pault@gcc.gnu.org
+!
+program char_pointer_comp_assign
+  implicit none
+  type :: dt
+     character (len=4), pointer :: scalar
+     character (len=4), pointer :: array(:)
+  end type dt
+  type (dt) :: a 
+  character (len=4), target :: scalar_t ="abcd"
+  character (len=4), target :: array_t(2) = (/"abcd","efgh"/)
+
+! Do assignments first
+  allocate (a%scalar, a%array(2))
+  a%scalar = scalar_t
+  if (a%scalar /= "abcd") call abort ()
+  a%array = array_t
+  if (any(a%array /= (/"abcd","efgh"/))) call abort ()
+  deallocate (a%scalar, a%array)
+
+! Now do pointer assignments.
+  a%scalar => scalar_t
+  if (a%scalar /= "abcd") call abort ()
+  a%array => array_t
+  if (any(a%array /= (/"abcd","efgh"/))) call abort ()
+
+end program char_pointer_comp_assign
diff --git a/gcc/testsuite/gfortran.dg/char_pointer_dependency.f90 b/gcc/testsuite/gfortran.dg/char_pointer_dependency.f90
new file mode 100644
index 000000000..ef2d783e1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_dependency.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! Test assignments from character pointer functions with dependencies
+! are correctly resolved.
+! Provided by Paul Thomas pault@gcc.gnu.org
+program char_pointer_dependency
+  implicit none
+  character*4, pointer       :: c2(:)
+  allocate (c2(2))
+  c2 = (/"abcd","efgh"/)
+  c2 = afoo (c2)
+  if (c2(1) /= "efgh") call abort ()
+  if (c2(2) /= "abcd") call abort ()
+  deallocate (c2)
+contains
+  function afoo (ac0) result (ac1)
+    integer                    :: j
+    character*4                :: ac0(:)
+    character*4, pointer       :: ac1(:)
+    allocate (ac1(2))
+    do j = 1,2
+      ac1(j) = ac0(3-j)
+    end do
+  end function afoo
+end program char_pointer_dependency
diff --git a/gcc/testsuite/gfortran.dg/char_pointer_dummy.f90 b/gcc/testsuite/gfortran.dg/char_pointer_dummy.f90
new file mode 100644
index 000000000..b533a1cb9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_dummy.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+program char_pointer_dummy

+! Test character pointer dummy arguments, required

+! to fix PR16939 and PR18689

+! Provided by Paul Thomas pault@gcc.gnu.org

+  implicit none

+  character*4                :: c0

+  character*4, pointer       :: c1

+  character*4, pointer       :: c2(:)

+  allocate (c1, c2(1))

+! Check that we have not broken non-pointer characters.

+  c0 = "wxyz"

+  call foo (c0)

+! Now the pointers

+  c1 = "wxyz"

+  call sfoo (c1)

+  c2 = "wxyz"

+  call afoo (c2)

+  deallocate (c1, c2)

+contains

+  subroutine foo (cc1)

+    character*4                :: cc1

+    if (cc1 /= "wxyz") call abort ()

+  end subroutine foo

+  subroutine sfoo (sc1)

+    character*4, pointer       :: sc1

+    if (sc1 /= "wxyz") call abort ()

+  end subroutine sfoo

+  subroutine afoo (ac1)

+    character*4, pointer       :: ac1(:)

+    if (ac1(1) /= "wxyz") call abort ()

+  end subroutine afoo

+end program char_pointer_dummy
+
diff --git a/gcc/testsuite/gfortran.dg/char_pointer_func.f90 b/gcc/testsuite/gfortran.dg/char_pointer_func.f90
new file mode 100644
index 000000000..23f867eeb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_func.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+program char_pointer_func
+! Test assignments from character pointer functions, required
+! to fix PR17192 and PR17202
+! Provided by Paul Thomas pault@gcc.gnu.org
+  implicit none
+  character*4                :: c0
+  character*4, pointer       :: c1
+  character*4, pointer       :: c2(:)
+  allocate (c1, c2(1))
+! Check that we have not broken non-pointer characters.
+  c0 = foo ()
+  if (c0 /= "abcd") call abort ()
+! Value assignments
+  c1 = sfoo ()
+  if (c1 /= "abcd") call abort ()
+  c2 = afoo (c0)
+  if (c2(1) /= "abcd") call abort ()
+  deallocate (c1, c2)
+! Pointer assignments
+  c1 => sfoo ()
+  if (c1 /= "abcd") call abort ()
+  c2 => afoo (c0)
+  if (c2(1) /= "abcd") call abort ()
+  deallocate (c1, c2)
+contains
+  function foo () result (cc1)
+    character*4                :: cc1
+    cc1 = "abcd"
+  end function foo
+  function sfoo () result (sc1)
+    character*4, pointer       :: sc1
+    allocate (sc1)
+    sc1 = "abcd"
+  end function sfoo
+  function afoo (c0) result (ac1)
+    character*4                :: c0
+    character*4, pointer       :: ac1(:)
+    allocate (ac1(1))
+    ac1 = "abcd"
+  end function afoo
+end program char_pointer_func
diff --git a/gcc/testsuite/gfortran.dg/char_reshape_1.f90 b/gcc/testsuite/gfortran.dg/char_reshape_1.f90
new file mode 100644
index 000000000..b3b624459
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_reshape_1.f90
@@ -0,0 +1,43 @@
+! Test reshape for character arrays.
+! { dg-do run }
+program main
+  implicit none
+  integer, parameter :: n = 20, slen = 9
+  character (len = slen), dimension (n) :: a, pad
+  integer, dimension (3) :: shape, order
+  integer :: i
+
+  do i = 1, n
+    a (i) = 'abcdefghijklmnopqrstuvwxyz'(i:i+6)
+    pad (i) = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(i:i+6)
+  end do
+
+  shape = (/ 4, 6, 5 /)
+  order = (/ 3, 1, 2 /)
+  call test (reshape (a, shape, pad, order))
+contains
+  subroutine test (b)
+    character (len = slen), dimension (:, :, :) :: b
+    integer :: i1, i2, i3, ai, padi
+
+    do i = 1, 3
+      if (size (b, i) .ne. shape (i)) call abort
+    end do
+    ai = 0
+    padi = 0
+    do i2 = 1, shape (2)
+      do i1 = 1, shape (1)
+        do i3 = 1, shape (3)
+          if (ai .lt. n) then
+            ai = ai + 1
+            if (b (i1, i2, i3) .ne. a (ai)) call abort
+          else
+            padi = padi + 1
+            if (padi .gt. n) padi = 1
+            if (b (i1, i2, i3) .ne. pad (padi)) call abort
+          end if
+        end do
+      end do
+    end do
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_result_1.f90 b/gcc/testsuite/gfortran.dg/char_result_1.f90
new file mode 100644
index 000000000..2e0b4ef14
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_1.f90
@@ -0,0 +1,114 @@
+! Related to PR 15326.  Try calling string functions whose lengths depend
+! on the lengths of other strings.
+! { dg-do run }
+pure function double (string)
+  character (len = *), intent (in) :: string
+  character (len = len (string) * 2) :: double
+  double = string // string
+end function double
+
+function f1 (string)
+  character (len = *) :: string
+  character (len = len (string)) :: f1
+  f1 = ''
+end function f1
+
+function f2 (string1, string2)
+  character (len = *) :: string1
+  character (len = len (string1) - 20) :: string2
+  character (len = len (string1) + len (string2) / 2) :: f2
+  f2 = ''
+end function f2
+
+program main
+  implicit none
+
+  interface
+    pure function double (string)
+      character (len = *), intent (in) :: string
+      character (len = len (string) * 2) :: double
+    end function double
+    function f1 (string)
+      character (len = *) :: string
+      character (len = len (string)) :: f1
+    end function f1
+    function f2 (string1, string2)
+      character (len = *) :: string1
+      character (len = len (string1) - 20) :: string2
+      character (len = len (string1) + len (string2) / 2) :: f2
+    end function f2
+  end interface
+
+  integer :: a
+  character (len = 80)  :: text
+  character (len = 70), target :: textt
+  character (len = 70), pointer :: textp
+
+  a = 42
+  textp => textt
+
+  call test (f1 (text), 80)
+  call test (f2 (text, text), 110)
+  call test (f3 (text), 115)
+  call test (f4 (text), 192)
+  call test (f5 (text), 160)
+  call test (f6 (text), 39)
+
+  call test (f1 (textp), 70)
+  call test (f2 (textp, text), 95)
+  call test (f3 (textp), 105)
+  call test (f4 (textp), 192)
+  call test (f5 (textp), 140)
+  call test (f6 (textp), 29)
+
+  call indirect (textp)
+contains
+  function f3 (string)
+    integer, parameter :: l1 = 30
+    character (len = *) :: string
+    character (len = len (string) + l1 + 5) :: f3
+    f3 = ''
+  end function f3
+
+  function f4 (string)
+    character (len = len (text) - 10) :: string
+    character (len = len (string) + len (text) + a) :: f4
+    f4 = ''
+  end function f4
+
+  function f5 (string)
+    character (len = *) :: string
+    character (len = len (double (string))) :: f5
+    f5 = ''
+  end function f5
+
+  function f6 (string)
+    character (len = *) :: string
+    character (len = len (string (a:))) :: f6
+    f6 = ''
+  end function f6
+
+  subroutine indirect (text2)
+    character (len = *) :: text2
+
+    call test (f1 (text), 80)
+    call test (f2 (text, text), 110)
+    call test (f3 (text), 115)
+    call test (f4 (text), 192)
+    call test (f5 (text), 160)
+    call test (f6 (text), 39)
+
+    call test (f1 (text2), 70)
+    call test (f2 (text2, text2), 95)
+    call test (f3 (text2), 105)
+    call test (f4 (text2), 192)
+    call test (f5 (text2), 140)
+    call test (f6 (text2), 29)
+  end subroutine indirect
+
+  subroutine test (string, length)
+    character (len = *) :: string
+    integer, intent (in) :: length
+    if (len (string) .ne. length) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_result_10.f90 b/gcc/testsuite/gfortran.dg/char_result_10.f90
new file mode 100644
index 000000000..d14fd3815
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_10.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! PR 18883: Fake result variables of non-constant length, with ENTRY
+function s_to_c(chars)
+    character, pointer :: chars(:)
+    character(len=len(chars)) :: s_to_c, s_to_c_2
+    s_to_c = 'a'
+    return
+entry s_to_c_2(chars)
+    s_to_c_2 = 'b'
+    return
+end function s_to_c
+
+program huj
+
+    implicit none
+    interface
+        function s_to_c(chars)
+            character, pointer :: chars(:)
+            character(len=len(chars)) :: s_to_c
+        end function s_to_c
+
+        function s_to_c_2(chars)
+            character, pointer :: chars(:)
+            character(len=len(chars)) :: s_to_c_2
+        end function s_to_c_2
+    end interface
+
+    character, pointer :: c(:)
+    character(3) :: s
+
+    allocate(c(5))
+    c = (/"a", "b", "c" /)
+    s = s_to_c(c)
+    s = s_to_c_2(c)
+
+end program huj
diff --git a/gcc/testsuite/gfortran.dg/char_result_11.f90 b/gcc/testsuite/gfortran.dg/char_result_11.f90
new file mode 100644
index 000000000..75e68f1ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_11.f90
@@ -0,0 +1,117 @@
+! { dg-do link }
+! PR 23675: Character function of module-variable length
+! PR 25716: Implicit kind conversions in in expressions written to *.mod-files.
+module cutils
+
+    implicit none
+    private
+   
+    type t
+        integer :: k = 25
+        integer :: kk(3) = (/30, 40, 50 /)
+    end type t
+
+    integer :: m1 = 25, m2 = 25, m3 = 25, m4 = 25, m5 = 25
+    integer :: n5 = 3, n7 = 3, n9 = 3
+    integer(1) :: n1 = 3, n2 = 3, n3 = 3, n4 = 3, n6 = 3, n8 = 3
+    character(10) :: s = "abcdefghij"
+    integer :: x(4) = (/ 30, 40, 50, 60 /)
+    type(t), save :: tt1(5), tt2(5)
+
+    public :: IntToChar1, IntToChar2, IntToChar3, IntToChar4, IntToChar5, &
+                IntToChar6, IntToChar7, IntToChar8
+
+contains
+
+    pure integer function get_k(tt)
+        type(t), intent(in) :: tt
+
+        get_k = tt%k
+    end function get_k
+ 
+    function IntToChar1(integerValue) result(a)
+        integer, intent(in) :: integerValue
+        character(len=m1)  :: a
+ 
+        write(a, *) integerValue
+    end function IntToChar1
+ 
+    function IntToChar2(integerValue) result(a)
+        integer, intent(in) :: integerValue
+        character(len=m2+n1)  :: a
+ 
+        write(a, *) integerValue
+    end function IntToChar2
+ 
+    function IntToChar3(integerValue) result(a)
+        integer, intent(in) :: integerValue
+        character(len=iachar(s(n2:n3)))  :: a
+ 
+        write(a, *) integerValue
+    end function IntToChar3
+ 
+    function IntToChar4(integerValue) result(a)
+        integer, intent(in) :: integerValue
+        character(len=tt1(n4)%k)  :: a
+ 
+        write(a, *) integerValue
+    end function IntToChar4
+ 
+    function IntToChar5(integerValue) result(a)
+        integer, intent(in) :: integerValue
+        character(len=maxval((/m3, n5/)))  :: a
+ 
+        write(a, *) integerValue
+    end function IntToChar5
+ 
+    function IntToChar6(integerValue) result(a)
+        integer, intent(in) :: integerValue
+        character(len=x(n6))  :: a
+ 
+        write(a, *) integerValue
+    end function IntToChar6
+ 
+    function IntToChar7(integerValue) result(a)
+        integer, intent(in) :: integerValue
+        character(len=tt2(min(m4, n7, 2))%kk(n8))  :: a
+     
+        write(a, *) integerValue
+    end function IntToChar7
+ 
+    function IntToChar8(integerValue) result(a)
+        integer, intent(in) :: integerValue
+        character(len=get_k(t(m5, (/31, n9, 53/))))  :: a
+ 
+        write(a, *) integerValue
+    end function IntToChar8
+
+end module cutils
+
+
+program test
+
+    use cutils
+
+    implicit none
+    character(25) :: str
+    
+    str = IntToChar1(3)
+    print *, str
+    str = IntToChar2(3)
+    print *, str
+    str = IntToChar3(3)
+    print *, str
+    str = IntToChar4(3)
+    print *, str
+    str = IntToChar5(3)
+    print *, str
+    str = IntToChar6(3)
+    print *, str
+    str = IntToChar7(3)
+    print *, str
+    str = IntToChar8(3)
+    print *, str
+
+end program test
+
+! { dg-final { cleanup-modules "cutils" } }
diff --git a/gcc/testsuite/gfortran.dg/char_result_12.f90 b/gcc/testsuite/gfortran.dg/char_result_12.f90
new file mode 100644
index 000000000..6612dcf88
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_12.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! Tests the fix for PR29912, in which the call to JETTER
+! would cause a segfault because a temporary was not being written.
+!
+! Contributed by Philip Mason  <pmason@ricardo.com>
+!
+ program testat
+ character(len=4)   :: ctemp(2)
+ character(len=512) :: temper(2)
+ !
+ !------------------------
+ !'This was OK.'
+ !------------------------
+ temper(1) = 'doncaster'
+ temper(2) = 'uxbridge'
+ ctemp     = temper
+ if (any (ctemp /= ["donc", "uxbr"])) call abort ()
+ !
+ !------------------------
+ !'This went a bit wrong.'
+ !------------------------
+ ctemp = jetter(1,2)
+ if (any (ctemp /= ["donc", "uxbr"])) call abort ()
+
+ contains
+   function jetter(id1,id2)
+   character(len=512) :: jetter(id1:id2)
+   jetter(id1) = 'doncaster'
+   jetter(id2) = 'uxbridge'
+   end function jetter
+ end program testat
diff --git a/gcc/testsuite/gfortran.dg/char_result_13.f90 b/gcc/testsuite/gfortran.dg/char_result_13.f90
new file mode 100644
index 000000000..741d55f16
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_13.f90
@@ -0,0 +1,49 @@
+! { dg-do run }
+! Tests the fix for PR38538, where the character length for the
+! argument of 'func' was not calculated.
+!
+! Contributed by Vivek Rao <vivekrao4@yahoo.com>
+!
+module abc
+  implicit none
+contains
+  subroutine xmain (i, j)
+    integer i, j
+    call foo (func ("_"//bar (i)//"x"//bar (j)//"x"), "_abcxabx")  ! original was elemental
+    call foo (nfunc("_"//bar (j)//"x"//bar (i)//"x"), "_abxabcx")
+  end subroutine xmain
+!
+  function bar (i) result(yy)
+    integer i, j, k
+    character (len = i) :: yy(2)
+    do j = 1, size (yy, 1)
+      do k = 1, i
+        yy(j)(k:k) = char (96+k)
+      end do
+    end do
+  end function bar
+!
+  elemental function func (yy) result(xy)
+    character (len = *), intent(in) :: yy
+    character (len = len (yy)) :: xy
+    xy = yy
+  end function func
+!
+  function nfunc (yy) result(xy)
+    character (len = *), intent(in) :: yy(:)
+    character (len = len (yy)) :: xy(size (yy))
+    xy = yy
+  end function nfunc
+!
+  subroutine foo(cc, teststr)
+    character (len=*), intent(in) :: cc(:)
+    character (len=*), intent(in) :: teststr
+    if (any (cc .ne. teststr)) call abort
+  end subroutine foo
+end module abc
+
+  use abc
+  call xmain(3, 2)
+end
+! { dg-final { cleanup-modules "abc" } }
+
diff --git a/gcc/testsuite/gfortran.dg/char_result_2.f90 b/gcc/testsuite/gfortran.dg/char_result_2.f90
new file mode 100644
index 000000000..4127ecf94
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_2.f90
@@ -0,0 +1,107 @@
+! Like char_result_1.f90, but the string arguments are pointers.
+! { dg-do run }
+pure function double (string)
+  character (len = *), intent (in) :: string
+  character (len = len (string) * 2) :: double
+  double = string // string
+end function double
+
+function f1 (string)
+  character (len = *), pointer :: string
+  character (len = len (string)) :: f1
+  f1 = ''
+end function f1
+
+function f2 (string1, string2)
+  character (len = *), pointer :: string1
+  character (len = len (string1) - 20), pointer :: string2
+  character (len = len (string1) + len (string2) / 2) :: f2
+  f2 = ''
+end function f2
+
+program main
+  implicit none
+
+  interface
+    pure function double (string)
+      character (len = *), intent (in) :: string
+      character (len = len (string) * 2) :: double
+    end function double
+    function f1 (string)
+      character (len = *), pointer :: string
+      character (len = len (string)) :: f1
+    end function f1
+    function f2 (string1, string2)
+      character (len = *), pointer :: string1
+      character (len = len (string1) - 20), pointer :: string2
+      character (len = len (string1) + len (string2) / 2) :: f2
+    end function f2
+  end interface
+
+  integer :: a
+  character (len = 80) :: text
+  character (len = 70), target :: textt
+  character (len = 70), pointer :: textp
+  character (len = 50), pointer :: textp2
+
+  a = 42
+  textp => textt
+  textp2 => textt(1:50)
+
+  call test (f1 (textp), 70)
+  call test (f2 (textp, textp), 95)
+  call test (f3 (textp), 105)
+  call test (f4 (textp), 192)
+  call test (f5 (textp), 140)
+  call test (f6 (textp), 29)
+
+  call indirect (textp2)
+contains
+  function f3 (string)
+    integer, parameter :: l1 = 30
+    character (len = *), pointer :: string
+    character (len = len (string) + l1 + 5) :: f3
+    f3 = ''
+  end function f3
+
+  function f4 (string)
+    character (len = len (text) - 10), pointer :: string
+    character (len = len (string) + len (text) + a) :: f4
+    f4 = ''
+  end function f4
+
+  function f5 (string)
+    character (len = *), pointer :: string
+    character (len = len (double (string))) :: f5
+    f5 = ''
+  end function f5
+
+  function f6 (string)
+    character (len = *), pointer :: string
+    character (len = len (string (a:))) :: f6
+    f6 = ''
+  end function f6
+
+  subroutine indirect (textp2)
+    character (len = 50), pointer :: textp2
+
+    call test (f1 (textp), 70)
+    call test (f2 (textp, textp), 95)
+    call test (f3 (textp), 105)
+    call test (f4 (textp), 192)
+    call test (f5 (textp), 140)
+    call test (f6 (textp), 29)
+
+    call test (f1 (textp2), 50)
+    call test (f2 (textp2, textp), 65)
+    call test (f3 (textp2), 85)
+    call test (f5 (textp2), 100)
+    call test (f6 (textp2), 9)
+  end subroutine indirect
+
+  subroutine test (string, length)
+    character (len = *) :: string
+    integer, intent (in) :: length
+    if (len (string) .ne. length) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_result_3.f90 b/gcc/testsuite/gfortran.dg/char_result_3.f90
new file mode 100644
index 000000000..8b9aa9247
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_3.f90
@@ -0,0 +1,78 @@
+! Related to PR 15326.  Try calling string functions whose lengths involve
+! some sort of array calculation.
+! { dg-do run }
+pure elemental function double (x)
+  integer, intent (in) :: x
+  integer :: double
+  double = x * 2
+end function double
+
+program main
+  implicit none
+
+  interface
+    pure elemental function double (x)
+      integer, intent (in) :: x
+      integer :: double
+    end function double
+  end interface
+
+  integer, dimension (100:104), target :: a
+  integer, dimension (:), pointer :: ap
+  integer :: i, lower
+
+  a = (/ (i + 5, i = 0, 4) /)
+  ap => a
+  lower = 11
+
+  call test (f1 (a), 35)
+  call test (f1 (ap), 35)
+  call test (f1 ((/ 5, 10, 50 /)), 65)
+  call test (f1 (a (101:103)), 21)
+
+  call test (f2 (a), 115)
+  call test (f2 (ap), 115)
+  call test (f2 ((/ 5, 10, 50 /)), 119)
+  call test (f2 (a (101:103)), 116)
+
+  call test (f3 (a), 60)
+  call test (f3 (ap), 60)
+  call test (f3 ((/ 5, 10, 50 /)), 120)
+  call test (f3 (a (101:103)), 30)
+
+  call test (f4 (a, 13, 1), 21)
+  call test (f4 (ap, 13, 2), 14)
+  call test (f4 ((/ 5, 10, 50 /), 12, 1), 60)
+  call test (f4 (a (101:103), 12, 1), 15)
+contains
+  function f1 (array)
+    integer, dimension (10:) :: array
+    character (len = sum (array)) :: f1
+    f1 = ''
+  end function f1
+
+  function f2 (array)
+    integer, dimension (10:) :: array
+    character (len = array (11) + a (104) + 100) :: f2
+    f2 = ''
+  end function f2
+
+  function f3 (array)
+    integer, dimension (:) :: array
+    character (len = sum (double (array (2:)))) :: f3
+    f3 = ''
+  end function f3
+
+  function f4 (array, upper, stride)
+    integer, dimension (10:) :: array
+    integer :: upper, stride
+    character (len = sum (array (lower:upper:stride))) :: f4
+    f4 = ''
+  end function f4
+
+  subroutine test (string, length)
+    character (len = *) :: string
+    integer, intent (in) :: length
+    if (len (string) .ne. length) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_result_4.f90 b/gcc/testsuite/gfortran.dg/char_result_4.f90
new file mode 100644
index 000000000..5e4f58e18
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_4.f90
@@ -0,0 +1,62 @@
+! Like char_result_3.f90, but the array arguments are pointers.
+! { dg-do run }
+pure elemental function double (x)
+  integer, intent (in) :: x
+  integer :: double
+  double = x * 2
+end function double
+
+program main
+  implicit none
+
+  interface
+    pure elemental function double (x)
+      integer, intent (in) :: x
+      integer :: double
+    end function double
+  end interface
+
+  integer, dimension (100:104), target :: a
+  integer, dimension (:), pointer :: ap
+  integer :: i, lower
+
+  a = (/ (i + 5, i = 0, 4) /)
+  ap => a
+  lower = lbound(a,dim=1)
+
+  call test (f1 (ap), 35)
+  call test (f2 (ap), 115)
+  call test (f3 (ap), 60)
+  call test (f4 (ap, 104, 2), 21)
+contains
+  function f1 (array)
+    integer, dimension (:), pointer :: array
+    character (len = sum (array)) :: f1
+    f1 = ''
+  end function f1
+
+  function f2 (array)
+    integer, dimension (:), pointer :: array
+    character (len = array (101) + a (104) + 100) :: f2
+    f2 = ''
+  end function f2
+
+  function f3 (array)
+    integer, dimension (:), pointer :: array
+    character (len = sum (double (array (101:)))) :: f3
+    f3 = ''
+  end function f3
+
+  function f4 (array, upper, stride)
+    integer, dimension (:), pointer :: array
+    integer :: upper, stride
+    character (len = sum (array (lower:upper:stride))) :: f4
+    f4 = ''
+  end function f4
+
+  subroutine test (string, length)
+    character (len = *) :: string
+    integer, intent (in) :: length
+    if (len (string) .ne. length) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_result_5.f90 b/gcc/testsuite/gfortran.dg/char_result_5.f90
new file mode 100644
index 000000000..96832b3b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_5.f90
@@ -0,0 +1,137 @@
+! Related to PR 15326.  Test calls to string functions whose lengths
+! depend on various types of scalar value.
+! { dg-do run }
+pure function select (selector, iftrue, iffalse)
+  logical, intent (in) :: selector
+  integer, intent (in) :: iftrue, iffalse
+  integer :: select
+
+  if (selector) then
+    select = iftrue
+  else
+    select = iffalse
+  end if
+end function select
+
+program main
+  implicit none
+
+  interface
+    pure function select (selector, iftrue, iffalse)
+      logical, intent (in) :: selector
+      integer, intent (in) :: iftrue, iffalse
+      integer :: select
+    end function select
+  end interface
+
+  type pair
+    integer :: left, right
+  end type pair
+
+  integer, target :: i
+  integer, pointer :: ip
+  real, target :: r
+  real, pointer :: rp
+  logical, target :: l
+  logical, pointer :: lp
+  complex, target :: c
+  complex, pointer :: cp
+  character, target :: ch
+  character, pointer :: chp
+  type (pair), target :: p
+  type (pair), pointer :: pp
+
+  character (len = 10) :: dig
+
+  i = 100
+  r = 50.5
+  l = .true.
+  c = (10.9, 11.2)
+  ch = '1'
+  p%left = 40
+  p%right = 50
+
+  ip => i
+  rp => r
+  lp => l
+  cp => c
+  chp => ch
+  pp => p
+
+  dig = '1234567890'
+
+  call test (f1 (i), 200)
+  call test (f1 (ip), 200)
+  call test (f1 (-30), 60)
+  call test (f1 (i / (-4)), 50)
+
+  call test (f2 (r), 100)
+  call test (f2 (rp), 100)
+  call test (f2 (70.1), 140)
+  call test (f2 (r / 4), 24)
+  call test (f2 (real (i)), 200)
+
+  call test (f3 (l), 50)
+  call test (f3 (lp), 50)
+  call test (f3 (.false.), 55)
+  call test (f3 (i < 30), 55)
+
+  call test (f4 (c), 10)
+  call test (f4 (cp), 10)
+  call test (f4 (cmplx (60.0, r)), 60)
+  call test (f4 (cmplx (r, 1.0)), 50)
+
+  call test (f5 (ch), 11)
+  call test (f5 (chp), 11)
+  call test (f5 ('23'), 12)
+  call test (f5 (dig (3:)), 13)
+  call test (f5 (dig (10:)), 10)
+
+  call test (f6 (p), 145)
+  call test (f6 (pp), 145)
+  call test (f6 (pair (20, 10)), 85)
+  call test (f6 (pair (i / 2, 1)), 106)
+contains
+  function f1 (i)
+    integer :: i
+    character (len = abs (i) * 2) :: f1
+    f1 = ''
+  end function f1
+
+  function f2 (r)
+    real :: r
+    character (len = floor (r) * 2) :: f2
+    f2 = ''
+  end function f2
+
+  function f3 (l)
+    logical :: l
+    character (len = select (l, 50, 55)) :: f3
+    f3 = ''
+  end function f3
+
+  function f4 (c)
+    complex :: c
+    character (len = int (c)) :: f4
+    f4 = ''
+  end function f4
+
+  function f5 (c)
+    character :: c
+    character (len = scan ('123456789', c) + 10) :: f5
+    f5 = ''
+  end function f5
+
+  function f6 (p)
+    type (pair) :: p
+    integer :: i
+    character (len = sum ((/ p%left, p%right, (i, i = 1, 10) /))) :: f6
+    f6 = ''
+  end function f6
+
+  subroutine test (string, length)
+    character (len = *) :: string
+    integer, intent (in) :: length
+    if (len (string) .ne. length) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_result_6.f90 b/gcc/testsuite/gfortran.dg/char_result_6.f90
new file mode 100644
index 000000000..de8e1059c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_6.f90
@@ -0,0 +1,107 @@
+! Like char_result_5.f90, but the function arguments are pointers to scalars.
+! { dg-do run }
+pure function select (selector, iftrue, iffalse)
+  logical, intent (in) :: selector
+  integer, intent (in) :: iftrue, iffalse
+  integer :: select
+
+  if (selector) then
+    select = iftrue
+  else
+    select = iffalse
+  end if
+end function select
+
+program main
+  implicit none
+
+  interface
+    pure function select (selector, iftrue, iffalse)
+      logical, intent (in) :: selector
+      integer, intent (in) :: iftrue, iffalse
+      integer :: select
+    end function select
+  end interface
+
+  type pair
+    integer :: left, right
+  end type pair
+
+  integer, target :: i
+  integer, pointer :: ip
+  real, target :: r
+  real, pointer :: rp
+  logical, target :: l
+  logical, pointer :: lp
+  complex, target :: c
+  complex, pointer :: cp
+  character, target :: ch
+  character, pointer :: chp
+  type (pair), target :: p
+  type (pair), pointer :: pp
+
+  i = 100
+  r = 50.5
+  l = .true.
+  c = (10.9, 11.2)
+  ch = '1'
+  p%left = 40
+  p%right = 50
+
+  ip => i
+  rp => r
+  lp => l
+  cp => c
+  chp => ch
+  pp => p
+
+  call test (f1 (ip), 200)
+  call test (f2 (rp), 100)
+  call test (f3 (lp), 50)
+  call test (f4 (cp), 10)
+  call test (f5 (chp), 11)
+  call test (f6 (pp), 145)
+contains
+  function f1 (i)
+    integer, pointer :: i
+    character (len = abs (i) * 2) :: f1
+    f1 = ''
+  end function f1
+
+  function f2 (r)
+    real, pointer :: r
+    character (len = floor (r) * 2) :: f2
+    f2 = ''
+  end function f2
+
+  function f3 (l)
+    logical, pointer :: l
+    character (len = select (l, 50, 55)) :: f3
+    f3 = ''
+  end function f3
+
+  function f4 (c)
+    complex, pointer :: c
+    character (len = int (c)) :: f4
+    f4 = ''
+  end function f4
+
+  function f5 (c)
+    character, pointer :: c
+    character (len = scan ('123456789', c) + 10) :: f5
+    f5 = ''
+  end function f5
+
+  function f6 (p)
+    type (pair), pointer :: p
+    integer :: i
+    character (len = sum ((/ p%left, p%right, (i, i = 1, 10) /))) :: f6
+    f6 = ''
+  end function f6
+
+  subroutine test (string, length)
+    character (len = *) :: string
+    integer, intent (in) :: length
+    if (len (string) .ne. length) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_result_7.f90 b/gcc/testsuite/gfortran.dg/char_result_7.f90
new file mode 100644
index 000000000..7b8692f40
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_7.f90
@@ -0,0 +1,47 @@
+! Related to PR 15326.  Try calling string functions whose lengths depend
+! on a dummy procedure.
+! { dg-do run }
+integer pure function double (x)
+  integer, intent (in) :: x
+  double = x * 2
+end function double
+
+program main
+  implicit none
+
+  interface
+    integer pure function double (x)
+      integer, intent (in) :: x
+    end function double
+  end interface
+
+  call test (f1 (double, 100), 200)
+
+  call indirect (double)
+contains
+  function f1 (fn, i)
+    integer :: i
+    interface
+      integer pure function fn (x)
+        integer, intent (in) :: x
+      end function fn
+    end interface
+    character (len = fn (i)) :: f1
+    f1 = ''
+  end function f1
+
+  subroutine indirect (fn)
+    interface
+      integer pure function fn (x)
+        integer, intent (in) :: x
+      end function fn
+    end interface
+    call test (f1 (fn, 100), 200)
+  end subroutine indirect
+
+  subroutine test (string, length)
+    character (len = *) :: string
+    integer, intent (in) :: length
+    if (len (string) .ne. length) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_result_8.f90 b/gcc/testsuite/gfortran.dg/char_result_8.f90
new file mode 100644
index 000000000..69b119647
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_8.f90
@@ -0,0 +1,51 @@
+! Related to PR 15326.  Compare functions that return string pointers with
+! functions that return strings.
+! { dg-do run }
+program main
+  implicit none
+
+  character (len = 30), target :: string
+
+  call test (f1 (), 30)
+  call test (f2 (50), 50)
+  call test (f3 (), 30)
+  call test (f4 (70), 70)
+
+  call indirect (100)
+contains
+  function f1 ()
+    character (len = 30) :: f1
+    f1 = ''
+  end function f1
+
+  function f2 (i)
+    integer :: i
+    character (len = i) :: f2
+    f2 = ''
+  end function f2
+
+  function f3 ()
+    character (len = 30), pointer :: f3
+    f3 => string
+  end function f3
+
+  function f4 (i)
+    integer :: i
+    character (len = i), pointer :: f4
+    f4 => string
+  end function f4
+
+  subroutine indirect (i)
+    integer :: i
+    call test (f1 (), 30)
+    call test (f2 (i), i)
+    call test (f3 (), 30)
+    call test (f4 (i), i)
+  end subroutine indirect
+
+  subroutine test (string, length)
+    character (len = *) :: string
+    integer, intent (in) :: length
+    if (len (string) .ne. length) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_result_9.f90 b/gcc/testsuite/gfortran.dg/char_result_9.f90
new file mode 100644
index 000000000..062901e1b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_result_9.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! PR 18883: Fake result variables of non-constant length, in module
+module foo
+contains
+    function s_to_c(chars)
+        character, pointer :: chars(:)
+        character(len=len(chars)) :: s_to_c
+        s_to_c = 'a'
+    end function s_to_c
+end module foo
+
+program huj
+
+    use foo
+
+    implicit none
+    character, pointer :: c(:)
+    character(3) :: s
+
+    allocate(c(5))
+    c = (/"a", "b", "c" /)
+    s = s_to_c(c)
+
+end program huj
+
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/char_spread_1.f90 b/gcc/testsuite/gfortran.dg/char_spread_1.f90
new file mode 100644
index 000000000..bb152ee39
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_spread_1.f90
@@ -0,0 +1,32 @@
+! Test spread for character arrays.
+! { dg-do run }
+program main
+  implicit none
+  integer, parameter :: n1 = 3, n2 = 10, n3 = 4, slen = 9
+  character (len = slen), dimension (n1, n3) :: a
+  integer :: i1, i2, i3
+
+  do i3 = 1, n3
+    do i1 = 1, n1
+      a (i1, i3) = 'abc'(i1:i1) // 'defg'(i3:i3) // 'cantrip'
+    end do
+  end do
+
+  call test (spread (a, 2, n2))
+contains
+  subroutine test (b)
+    character (len = slen), dimension (:, :, :) :: b
+
+    if (size (b, 1) .ne. n1) call abort
+    if (size (b, 2) .ne. n2) call abort
+    if (size (b, 3) .ne. n3) call abort
+
+    do i3 = 1, n3
+      do i2 = 1, n2
+        do i1 = 1, n1
+          if (b (i1, i2, i3) .ne. a (i1, i3)) call abort
+        end do
+      end do
+    end do
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_transpose_1.f90 b/gcc/testsuite/gfortran.dg/char_transpose_1.f90
new file mode 100644
index 000000000..4b9c21a2f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_transpose_1.f90
@@ -0,0 +1,29 @@
+! Test transpose for character arrays.
+! { dg-do run }
+program main
+  implicit none
+  integer, parameter :: n1 = 3, n2 = 4, slen = 9
+  character (len = slen), dimension (n1, n2) :: a
+  integer :: i1, i2
+
+  do i2 = 1, n2
+    do i1 = 1, n1
+      a (i1, i2) = 'abc'(i1:i1) // 'defg'(i2:i2) // 'cantrip'
+    end do
+  end do
+
+  call test (transpose (a))
+contains
+  subroutine test (b)
+    character (len = slen), dimension (:, :) :: b
+
+    if (size (b, 1) .ne. n2) call abort
+    if (size (b, 2) .ne. n1) call abort
+
+    do i2 = 1, n2
+      do i1 = 1, n1
+        if (b (i2, i1) .ne. a (i1, i2)) call abort
+      end do
+    end do
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_type_len.f90 b/gcc/testsuite/gfortran.dg/char_type_len.f90
new file mode 100644
index 000000000..706f9341f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_type_len.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! Testcase for PR fortran/25681
+program char_type_len
+  integer,parameter :: n = 9
+  type foo_t
+     character (len = 80) :: bar (1)
+     character (len = 75) :: gee (n)
+  end type foo_t
+  type(foo_t) :: foo
+  
+  if (len(foo%bar) /= 80 .or. len(foo%gee) /= 75) call abort
+end program char_type_len
diff --git a/gcc/testsuite/gfortran.dg/char_type_len_2.f90 b/gcc/testsuite/gfortran.dg/char_type_len_2.f90
new file mode 100644
index 000000000..e4fab8020
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_type_len_2.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! PR31251 Non-integer character length leads to segfault
+! Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+  character(len=2.3) :: s ! { dg-error "must be of INTEGER type" }
+  character(kind=1,len=4.3) :: t ! { dg-error "must be of INTEGER type" }
+  character(len=,,7.2,kind=1) :: u ! { dg-error "Syntax error in CHARACTER declaration" }
+  character(len=7,kind=2) :: v ! ! { dg-error "Kind 2 is not supported for CHARACTER" }
+  character(kind=2) :: w ! ! { dg-error "Kind 2 is not supported for CHARACTER" }
+  character(kind=2,len=7) :: x ! ! { dg-error "Kind 2 is not supported for CHARACTER" }
+  end
diff --git a/gcc/testsuite/gfortran.dg/char_unpack_1.f90 b/gcc/testsuite/gfortran.dg/char_unpack_1.f90
new file mode 100644
index 000000000..65dd888a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_unpack_1.f90
@@ -0,0 +1,44 @@
+! Test unpack0 for character arrays.
+! { dg-do run }
+program main
+  implicit none
+  integer, parameter :: n1 = 3, n2 = 4, nv = 10, slen = 9
+  character (len = slen), dimension (n1, n2) :: field
+  character (len = slen), dimension (nv) :: vector
+  logical, dimension (n1, n2) :: mask
+  integer :: i1, i2, i
+
+  do i2 = 1, n2
+    do i1 = 1, n1
+      field (i1, i2) = 'abc'(i1:i1) // 'defg'(i2:i2) // 'cantrip'
+    end do
+  end do
+  mask (1, :) = (/ .true., .false., .true., .true. /)
+  mask (2, :) = (/ .true., .false., .false., .false. /)
+  mask (3, :) = (/ .false., .true., .true., .true. /)
+
+  do i = 1, nv
+    vector (i) = 'crespo' // '0123456789'(i:i)
+  end do
+
+  call test (unpack (vector, mask, field))
+contains
+  subroutine test (a)
+    character (len = slen), dimension (:, :) :: a
+
+    if (size (a, 1) .ne. n1) call abort
+    if (size (a, 2) .ne. n2) call abort
+
+    i = 0
+    do i2 = 1, n2
+      do i1 = 1, n1
+        if (mask (i1, i2)) then
+          i = i + 1
+          if (a (i1, i2) .ne. vector (i)) call abort
+        else
+          if (a (i1, i2) .ne. field (i1, i2)) call abort
+        end if
+      end do
+    end do
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/char_unpack_2.f90 b/gcc/testsuite/gfortran.dg/char_unpack_2.f90
new file mode 100644
index 000000000..3b2c4a327
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_unpack_2.f90
@@ -0,0 +1,40 @@
+! Test unpack1 for character arrays.
+! { dg-do run }
+program main
+  implicit none
+  integer, parameter :: n1 = 3, n2 = 4, nv = 10, slen = 9
+  character (len = slen) :: field
+  character (len = slen), dimension (nv) :: vector
+  logical, dimension (n1, n2) :: mask
+  integer :: i1, i2, i
+
+  field = 'broadside'
+  mask (1, :) = (/ .true., .false., .true., .true. /)
+  mask (2, :) = (/ .true., .false., .false., .false. /)
+  mask (3, :) = (/ .false., .true., .true., .true. /)
+
+  do i = 1, nv
+    vector (i) = 'crespo' // '0123456789'(i:i)
+  end do
+
+  call test (unpack (vector, mask, field))
+contains
+  subroutine test (a)
+    character (len = slen), dimension (:, :) :: a
+
+    if (size (a, 1) .ne. n1) call abort
+    if (size (a, 2) .ne. n2) call abort
+
+    i = 0
+    do i2 = 1, n2
+      do i1 = 1, n1
+        if (mask (i1, i2)) then
+          i = i + 1
+          if (a (i1, i2) .ne. vector (i)) call abort
+        else
+          if (a (i1, i2) .ne. field) call abort
+        end if
+      end do
+    end do
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/character_array_constructor_1.f90 b/gcc/testsuite/gfortran.dg/character_array_constructor_1.f90
new file mode 100644
index 000000000..ac0f7e315
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/character_array_constructor_1.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! Tests the fix for PR27113, in which character structure
+! components would produce the TODO compilation error "complex
+! character array constructors".
+!
+! Test based on part of tonto-2.2;
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+  type BASIS_TYPE
+    character(len=8) :: label
+  end type
+
+  type(BASIS_TYPE), dimension(:), pointer :: ptr
+  character(8), dimension(2) :: carray
+
+  allocate (ptr(2))
+  ptr(1)%label = "Label 1"
+  ptr(2)%label = "Label 2"
+
+! This is the original bug
+  call read_library_data_((/ptr%label/))
+
+  carray(1) = "Label 3"
+  carray(2) = "Label 4"
+
+! Mix a character array with the character component of a derived type pointer array.
+  call read_library_data_((/carray, ptr%label/))
+
+! Finally, add a constant (character(8)).
+  call read_library_data_((/carray, ptr%label, "Label 5 "/))
+
+contains
+
+  subroutine read_library_data_ (chr)
+    character(*), dimension(:) :: chr
+    character(len = len(chr)) :: tmp
+    if (size(chr,1) == 2) then
+      if (any (chr .ne. (/"Label 1", "Label 2"/))) call abort ()
+    elseif (size(chr,1) == 4) then
+      if (any (chr .ne. (/"Label 3", "Label 4","Label 1", "Label 2"/))) call abort ()
+    elseif (size(chr,1) == 5) then
+      if (any (chr .ne. (/"Label 3", "Label 4","Label 1", "Label 2", "Label 5"/))) &
+          call abort ()
+    end if
+  end subroutine read_library_data_
+
+end
diff --git a/gcc/testsuite/gfortran.dg/character_assign_1.f90 b/gcc/testsuite/gfortran.dg/character_assign_1.f90
new file mode 100644
index 000000000..a4e073299
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/character_assign_1.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! Tests the fix for PR35702, which caused an ICE because the types in the assignment
+! were not translated to be the same.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+MODULE TESTS
+  TYPE UNSEQ
+    CHARACTER(1) :: C
+  END TYPE UNSEQ       
+CONTAINS
+  SUBROUTINE CG0028 (TDA1L, TDA1R, nf0, nf1, nf2, nf3)
+    TYPE(UNSEQ) TDA1L(NF3)
+    TDA1L(NF1:NF2:NF1)%C = TDA1L(NF0+2:NF3:NF2/2)%C
+  END SUBROUTINE
+END MODULE TESTS
+! { dg-final { cleanup-modules "tests" } }
diff --git a/gcc/testsuite/gfortran.dg/character_comparison_1.f90 b/gcc/testsuite/gfortran.dg/character_comparison_1.f90
new file mode 100644
index 000000000..d34af304d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/character_comparison_1.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+! { dg-options "-O -fdump-tree-original" }
+program main
+  implicit none
+  character(len=4) :: c
+  integer :: n
+  integer :: i
+  common /foo/ i
+
+  n = 0
+  i = 0
+  c = 'abcd'
+  n = n + 1 ; if (c == c) call yes
+  n = n + 1 ; if (c >= c) call yes
+  n = n + 1 ; if (c <= c) call yes
+  n = n + 1 ; if (c .eq. c) call yes
+  n = n + 1 ; if (c .ge. c) call yes
+  n = n + 1 ; if (c .le. c) call yes
+  if (c /= c) call abort
+  if (c > c) call abort
+  if (c < c) call abort
+  if (c .ne. c) call abort
+  if (c .gt. c) call abort
+  if (c .lt. c) call abort
+  if (n /= i) call abort
+end program main
+
+subroutine yes
+  implicit none
+  common /foo/ i
+  integer :: i
+  i = i + 1
+end subroutine yes
+
+! { dg-final { scan-tree-dump-times "gfortran_compare_string" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/character_comparison_2.f90 b/gcc/testsuite/gfortran.dg/character_comparison_2.f90
new file mode 100644
index 000000000..d2736f874
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/character_comparison_2.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! { dg-options "-O -fdump-tree-original" }
+program main
+  implicit none
+  character(len=4) :: c
+  integer :: n
+  integer :: i
+  integer :: k1, k2
+  common /foo/ i
+
+  n = 0
+  i = 0
+  k1 = 1
+  k2 = 3
+  c = 'abcd'
+  n = n + 1 ; if (c(1:2) == c(1:2)) call yes
+  n = n + 1 ; if (c(k1:k2) >= c(k1:k2)) call yes
+  n = n + 1 ; if (c(:2) <= c(1:2)) call yes
+  n = n + 1 ; if (c(k2:) .eq. c(k2:4)) call yes
+  n = n + 1 ; if (c(:) .ge. c) call yes
+  n = n + 1 ; if (c .le. c) call yes
+  if (c(1:2) /= c(1:2)) call abort
+  if (c(k1:k2) > c(k1:k2)) call abort
+  if (c(:2) < c(1:2)) call abort
+  if (c(:) .ne. c) call abort
+  if (c(:2) .gt. c(1:2)) call abort
+  if (c(1:2) .lt. c(:2)) call abort
+  if (n /= i) call abort
+end program main
+
+subroutine yes
+  implicit none
+  common /foo/ i
+  integer :: i
+  i = i + 1
+end subroutine yes
+
+! { dg-final { scan-tree-dump-times "gfortran_compare_string" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/character_comparison_3.f90 b/gcc/testsuite/gfortran.dg/character_comparison_3.f90
new file mode 100644
index 000000000..dbcdbefb2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/character_comparison_3.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+program main
+  implicit none
+  character(len=4) :: c
+  integer :: i
+  integer :: k1, k2, k3, k4, k11, k22, k33, k44
+
+  k1 = 1
+  k2 = 2
+  k3 = 3
+  k4 = 4
+  k11 = 1
+  k22 = 2
+  k33 = 3
+  k44 = 4
+  c = 'abcd'
+  if (c(2:) /= c(k2:k4)) call abort
+  if (c(k2:k4) /= c(k22:)) call abort
+  if (c(2:3) == c(1:2)) call abort
+  if (c(1:2) == c(2:3)) call abort
+  if (c(k1:) == c(k2:)) call abort
+  if (c(:3) == c(:k4)) call abort
+  if (c(:k4) == c(:3)) call abort
+  if (c(:k3) == c(:k44)) call abort
+end program main
+
+! { dg-final { scan-tree-dump-times "gfortran_compare_string" 8 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/character_comparison_4.f90 b/gcc/testsuite/gfortran.dg/character_comparison_4.f90
new file mode 100644
index 000000000..1ff8b4707
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/character_comparison_4.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! { dg-options "-O -fdump-tree-original" }
+program main
+  implicit none
+  character(len=4) :: c, d
+  integer :: n
+  integer :: i
+  common /foo/ i
+
+  n = 0
+  i = 0
+  c = 'abcd'
+  d = 'efgh'
+
+  n = n + 1 ; if ('a' // c == 'a' // c) call yes
+  n = n + 1 ; if (c // 'a' == c // 'a') call yes
+  n = n + 1; if ('b' // c > 'a' // d) call yes
+  n = n + 1; if (c // 'b' > c // 'a') call yes
+
+  if ('a' // c /= 'a' // c) call abort
+  if ('a' // c // 'b' == 'a' // c // 'a') call abort
+  if ('b' // c == 'a' // c) call abort
+  if (c // 'a' ==  c // 'b') call abort
+  if (c // 'a ' /=  c // 'a') call abort
+  if (c // 'b' /=  c // 'b ') call abort
+
+  if (n /= i) call abort
+end program main
+
+subroutine yes
+  implicit none
+  common /foo/ i
+  integer :: i
+  i = i + 1
+end subroutine yes
+
+! { dg-final { scan-tree-dump-times "gfortran_compare_string" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/character_comparison_5.f90 b/gcc/testsuite/gfortran.dg/character_comparison_5.f90
new file mode 100644
index 000000000..b9ad92157
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/character_comparison_5.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-O -fdump-tree-original" }
+program main
+  implicit none
+  character(len=4) :: c, d
+  integer :: n
+  integer :: i
+  common /foo/ i
+
+  n = 0
+  i = 0
+  c = 'abcd'
+  d = 'efgh'
+  if (c // 'a' >= d // 'a') call abort
+  if ('a' // c >= 'a' // d) call abort
+end program main
+
+! { dg-final { scan-tree-dump-times "gfortran_concat_string" 0 "original" } }
+! { dg-final { scan-tree-dump-times "gfortran_compare_string" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/character_comparison_6.f90 b/gcc/testsuite/gfortran.dg/character_comparison_6.f90
new file mode 100644
index 000000000..78f647705
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/character_comparison_6.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-options "-O -fdump-tree-original" }
+program main
+  implicit none
+  character(len=4) :: c
+  integer :: n
+  integer :: i
+  common /foo/ i
+
+  n = 0
+  i = 0
+  c = 'abcd'
+  if ('a ' // c == 'a' // c) call abort
+  if ('a' // c == 'a ' // c) call abort
+end program main
+
+! { dg-final { scan-tree-dump-times "gfortran_concat_string" 4 "original" } }
+! { dg-final { scan-tree-dump-times "gfortran_compare_string" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/character_comparison_7.f90 b/gcc/testsuite/gfortran.dg/character_comparison_7.f90
new file mode 100644
index 000000000..7983969a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/character_comparison_7.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! { dg-options "-O -fdump-tree-original" }
+! Test that expressions in subroutine calls are also optimized
+program main
+  implicit none
+  character(len=4) :: c
+  c = 'abcd'
+  call yes(c == c)
+  call no(c /= c)
+end program main
+
+subroutine yes(a)
+  implicit none
+  logical, intent(in) :: a
+  if (.not. a) call abort
+end subroutine yes
+
+subroutine no(a)
+  implicit none
+  logical, intent(in) :: a
+  if (a) call abort
+end subroutine no
+
+! { dg-final { scan-tree-dump-times "gfortran_compare_string" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/chkbits.f90 b/gcc/testsuite/gfortran.dg/chkbits.f90
new file mode 100644
index 000000000..4652439fd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/chkbits.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! NOT() was not return the two's complement value as reported by
+! PR fortran/25458.  In checking other bit manipulation intrinsics,
+! IBSET was found to be in error.
+program chkbits
+
+  implicit none
+
+  integer(kind=1) i1
+  integer(kind=2) i2
+  integer(kind=4) i4
+  integer(kind=8) i8
+
+  i1 = ibset(huge(0_1), bit_size(i1)-1)
+  i2 = ibset(huge(0_2), bit_size(i2)-1)
+  i4 = ibset(huge(0_4), bit_size(i4)-1)
+  i8 = ibset(huge(0_8), bit_size(i8)-1)
+  if (i1 /= -1 .or. i2 /= -1 .or. i4 /= -1 .or. i8 /= -1) call abort
+
+  i1 = ibclr(-1_1, bit_size(i1)-1)
+  i2 = ibclr(-1_2, bit_size(i2)-1)
+  i4 = ibclr(-1_4, bit_size(i4)-1)
+  i8 = ibclr(-1_8, bit_size(i8)-1)
+  if (i1 /= huge(0_1) .or. i2 /= huge(0_2)) call abort
+  if (i4 /= huge(0_4) .or. i8 /= huge(0_8)) call abort
+
+  i1 = not(0_1)
+  i2 = not(0_2)
+  i4 = not(0_4)
+  i8 = not(0_8)
+  if (i1 /= -1 .or. i2 /= -1 .or. i4 /= -1 .or. i8 /= -1) call abort
+
+end program chkbits
diff --git a/gcc/testsuite/gfortran.dg/chmod_1.f90 b/gcc/testsuite/gfortran.dg/chmod_1.f90
new file mode 100644
index 000000000..07760cf12
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/chmod_1.f90
@@ -0,0 +1,35 @@
+! { dg-do run { target { ! { *-*-mingw* *-*-cygwin* spu-*-* } } } }
+! { dg-options "-std=gnu" }
+! See PR38956.  Test fails on cygwin when user has Administrator rights
+  implicit none
+  character(len=*), parameter :: n = "foobar_file"
+  integer :: i
+
+  open (10,file=n)
+  close (10,status="delete")
+
+  open (10,file=n)
+  close (10,status="keep")
+
+  if (access(n,"") /= 0 .or. access(n," ") /= 0 .or. access(n,"r") /= 0 .or. &
+      access(n,"R") /= 0 .or. access(n,"w") /= 0 .or. access(n,"W") /= 0) &
+    call abort
+
+  call chmod (n, "a+x", i)
+  if (i == 0) then
+    if (access(n,"x") /= 0 .or. access(n,"X") /= 0) call abort
+  end if
+
+  call chmod (n, "a-w", i)
+  if (i == 0 .and. getuid() /= 0) then
+    if (access(n,"w") == 0 .or. access(n,"W") == 0) call abort
+  end if
+
+  open (10,file=n)
+  close (10,status="delete")
+
+  if (access(n,"") == 0 .or. access(n," ") == 0 .or. access(n,"r") == 0 .or. &
+      access(n,"R") == 0 .or. access(n,"w") == 0 .or. access(n,"W") == 0) &
+    call abort
+
+  end
diff --git a/gcc/testsuite/gfortran.dg/chmod_2.f90 b/gcc/testsuite/gfortran.dg/chmod_2.f90
new file mode 100644
index 000000000..3e5ed617b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/chmod_2.f90
@@ -0,0 +1,35 @@
+! { dg-do run { target { ! { *-*-mingw* *-*-cygwin* spu-*-* } } } }
+! { dg-options "-std=gnu" }
+! See PR38956.  Test fails on cygwin when user has Administrator rights
+  implicit none
+  character(len=*), parameter :: n = "foobar_file"
+  integer :: i
+
+  open (10,file=n)
+  close (10,status="delete")
+
+  open (10,file=n)
+  close (10,status="keep")
+
+  if (access(n,"") /= 0 .or. access(n," ") /= 0 .or. access(n,"r") /= 0 .or. &
+      access(n,"R") /= 0 .or. access(n,"w") /= 0 .or. access(n,"W") /= 0) &
+    call abort
+
+  i = chmod (n, "a+x")
+  if (i == 0) then
+    if (access(n,"x") /= 0 .or. access(n,"X") /= 0) call abort
+  end if
+
+  i = chmod (n, "a-w")
+  if (i == 0 .and. getuid() /= 0) then
+    if (access(n,"w") == 0 .or. access(n,"W") == 0) call abort
+  end if
+
+  open (10,file=n)
+  close (10,status="delete")
+
+  if (access(n,"") == 0 .or. access(n," ") == 0 .or. access(n,"r") == 0 .or. &
+      access(n,"R") == 0 .or. access(n,"w") == 0 .or. access(n,"W") == 0) &
+    call abort
+
+  end
diff --git a/gcc/testsuite/gfortran.dg/chmod_3.f90 b/gcc/testsuite/gfortran.dg/chmod_3.f90
new file mode 100644
index 000000000..9e92ecabc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/chmod_3.f90
@@ -0,0 +1,35 @@
+! { dg-do run { target { ! { *-*-mingw* *-*-cygwin* spu-*-* } } } }
+! { dg-options "-std=gnu -fdefault-integer-8" }
+! See PR38956.  Test fails on cygwin when user has Administrator rights
+  implicit none
+  character(len=*), parameter :: n = "foobar_file"
+  integer :: i
+
+  open (10,file=n)
+  close (10,status="delete")
+
+  open (10,file=n)
+  close (10,status="keep")
+
+  if (access(n,"") /= 0 .or. access(n," ") /= 0 .or. access(n,"r") /= 0 .or. &
+      access(n,"R") /= 0 .or. access(n,"w") /= 0 .or. access(n,"W") /= 0) &
+    call abort
+
+  i = chmod (n, "a+x")
+  if (i == 0) then
+    if (access(n,"x") /= 0 .or. access(n,"X") /= 0) call abort
+  end if
+
+  i = chmod (n, "a-w")
+  if (i == 0 .and. getuid() /= 0) then
+    if (access(n,"w") == 0 .or. access(n,"W") == 0) call abort
+  end if
+
+  open (10,file=n)
+  close (10,status="delete")
+
+  if (access(n,"") == 0 .or. access(n," ") == 0 .or. access(n,"r") == 0 .or. &
+      access(n,"R") == 0 .or. access(n,"w") == 0 .or. access(n,"W") == 0) &
+    call abort
+
+  end
diff --git a/gcc/testsuite/gfortran.dg/class_1.f03 b/gcc/testsuite/gfortran.dg/class_1.f03
new file mode 100644
index 000000000..f21133a05
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_1.f03
@@ -0,0 +1,37 @@
+! { dg-do run }
+!
+! PR 40940: CLASS statement
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+implicit none
+
+type t
+  integer :: comp
+  class(t),pointer :: c2
+end type
+
+class(t),pointer :: c1
+
+allocate(c1)
+
+c1%comp = 5
+c1%c2 => c1
+
+print *,c1%comp
+
+call sub(c1)
+
+if (c1%comp/=5) call abort()
+
+deallocate(c1)
+
+contains
+
+  subroutine sub (c3)
+    class(t) :: c3
+    print *,c3%comp
+  end subroutine
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/class_10.f03 b/gcc/testsuite/gfortran.dg/class_10.f03
new file mode 100644
index 000000000..f238a597a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_10.f03
@@ -0,0 +1,32 @@
+! { dg-do compile }
+!
+! PR 41800: [OOP] ICE in fold_convert_loc, at fold-const.c:2789
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+
+module abstract_gradient
+
+  implicit none
+  private
+
+  type, public, abstract :: gradient_class
+  contains
+    procedure, nopass  :: inner_product
+  end type
+
+contains
+
+  function inner_product ()
+    class(gradient_class), pointer :: inner_product
+    inner_product => NULL()
+  end function
+
+end module
+
+
+ use abstract_gradient
+ class(gradient_class), pointer    :: g_initial, ip_save
+ ip_save => g_initial%inner_product()   ! ICE
+end
+
+! { dg-final { cleanup-modules "abstract_gradient" } }
diff --git a/gcc/testsuite/gfortran.dg/class_11.f03 b/gcc/testsuite/gfortran.dg/class_11.f03
new file mode 100644
index 000000000..bf80c4e00
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_11.f03
@@ -0,0 +1,37 @@
+! { dg-do compile }
+!
+! PR 41556
+! Contributed by Damian Rouson <damian@rouson.net>
+
+  implicit none
+
+  type ,abstract :: object
+  contains
+    procedure(assign_interface) ,deferred :: assign   
+    generic  :: assignment(=) => assign
+  end type 
+
+  abstract interface
+    subroutine assign_interface(lhs,rhs) 
+      import :: object 
+      class(object) ,intent(inout) :: lhs
+      class(object) ,intent(in)    :: rhs
+    end subroutine 
+  end interface
+
+! PR 41937
+! Contributed by Juergen Reuter <reuter@physik.uni-freiburg.de>
+
+  type, abstract :: cuba_abstract_type
+     integer :: dim_f = 1
+     real, dimension(:), allocatable :: integral
+  end type cuba_abstract_type
+
+contains
+
+    subroutine cuba_abstract_alloc_dim_f(this)
+      class(cuba_abstract_type) :: this
+      allocate(this%integral(this%dim_f))
+    end subroutine cuba_abstract_alloc_dim_f
+
+end
diff --git a/gcc/testsuite/gfortran.dg/class_12.f03 b/gcc/testsuite/gfortran.dg/class_12.f03
new file mode 100644
index 000000000..56c68a577
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_12.f03
@@ -0,0 +1,45 @@
+! { dg-do compile }
+!
+! PR 41556: [OOP] Errors in applying operator/assignment to an abstract type
+!
+! Contributed by Damian Rouson <damian@rouson.net>
+
+module abstract_algebra
+  implicit none 
+  private      
+  public :: rescale
+  public :: object
+
+  type ,abstract :: object
+  contains
+    procedure(assign_interface) ,deferred :: assign   
+    procedure(product_interface) ,deferred :: product
+    generic  :: assignment(=) => assign
+    generic  :: operator(*) => product
+  end type 
+
+  abstract interface
+    function product_interface(lhs,rhs) result(product)
+      import :: object
+      class(object) ,intent(in)  :: lhs
+      class(object) ,allocatable :: product
+      real          ,intent(in)  :: rhs
+    end function 
+    subroutine assign_interface(lhs,rhs) 
+      import :: object 
+      class(object) ,intent(inout) :: lhs
+      class(object) ,intent(in)    :: rhs
+    end subroutine 
+  end interface
+
+contains
+
+  subroutine rescale(operand,scale)    
+    class(object)    :: operand
+    real ,intent(in) :: scale
+    operand = operand*scale
+    operand = operand%product(scale)
+  end subroutine 
+end module
+
+! { dg-final { cleanup-modules "abstract_algebra" } }
diff --git a/gcc/testsuite/gfortran.dg/class_13.f03 b/gcc/testsuite/gfortran.dg/class_13.f03
new file mode 100644
index 000000000..84073bf22
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_13.f03
@@ -0,0 +1,37 @@
+! { dg-do compile }
+!
+! PR 42353: [OOP] Bogus Error: Name 'vtype$...' at (1) is an ambiguous reference ...
+!
+! Original test case by Harald Anlauf <anlauf@gmx.de>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+module concrete_vector
+  type :: trivial_vector_type
+  end type
+  class(trivial_vector_type), pointer :: this
+end module concrete_vector
+
+module concrete_gradient
+contains
+  subroutine my_to_vector (v)
+    use concrete_vector
+    class(trivial_vector_type) :: v
+    select type (v)
+    class is (trivial_vector_type)
+    end select
+  end subroutine
+end module concrete_gradient
+
+module concrete_inner_product
+  use concrete_vector
+  use concrete_gradient
+contains
+  real function my_dot_v_v (a)
+    class(trivial_vector_type) :: a
+    select type (a)
+    class is (trivial_vector_type)
+    end select
+  end function
+end module concrete_inner_product
+ 
+! { dg-final { cleanup-modules "concrete_vector concrete_gradient concrete_inner_product" } }
diff --git a/gcc/testsuite/gfortran.dg/class_14.f03 b/gcc/testsuite/gfortran.dg/class_14.f03
new file mode 100644
index 000000000..4e6db17c9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_14.f03
@@ -0,0 +1,54 @@
+! { dg-do compile }
+! Test the final fix for PR42353, in which a compilation error was
+! occurring because the derived type of the initializer of the vtab
+! component '$extends' was not the same as that of the component.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+!
+module abstract_vector
+  implicit none
+
+  type, abstract :: vector_class
+  end type vector_class
+end module abstract_vector
+!-------------------------
+module concrete_vector
+  use abstract_vector
+  implicit none
+
+  type, extends(vector_class) :: trivial_vector_type
+  end type trivial_vector_type
+
+  private :: my_assign
+contains
+  subroutine my_assign (this,v)
+    class(trivial_vector_type), intent(inout) :: this
+    class(vector_class),        intent(in)    :: v
+  end subroutine my_assign
+end module concrete_vector
+!---------------------------
+module concrete_gradient
+  use abstract_vector
+  implicit none
+
+  type, abstract, extends(vector_class) :: gradient_class
+  end type gradient_class
+
+  type, extends(gradient_class) :: trivial_gradient_type
+  end type trivial_gradient_type
+
+  private :: my_assign
+contains
+  subroutine my_assign (this,v)
+    class(trivial_gradient_type), intent(inout) :: this
+    class(vector_class),          intent(in)    :: v
+  end subroutine my_assign
+end module concrete_gradient
+!----------------------------
+module concrete_inner_product
+  use concrete_vector
+  use concrete_gradient
+  implicit none
+end module concrete_inner_product
+! { dg-final { cleanup-modules "abstract_vector concrete_vector" } }
+! { dg-final { cleanup-modules "concrete_gradient concrete_inner_product" } }
diff --git a/gcc/testsuite/gfortran.dg/class_15.f03 b/gcc/testsuite/gfortran.dg/class_15.f03
new file mode 100644
index 000000000..fbeb2a7e4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_15.f03
@@ -0,0 +1,43 @@
+! { dg-do compile }
+!
+! PR 42274: [fortran-dev Regression] ICE: segmentation fault
+!
+! Original test case by Salvatore Filippone <sfilippone@uniroma2.it>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+module mod_A
+  type :: t1
+  contains 
+    procedure,nopass :: fun
+  end type
+contains
+  logical function fun()
+  end function
+end module
+
+module mod_B
+  use mod_A
+  type, extends(t1) :: t2
+  contains
+    procedure :: sub1
+  end type
+contains 
+  subroutine sub1(a)
+    class(t2) :: a
+  end subroutine
+end module
+
+module mod_C
+contains 
+  subroutine sub2(b)
+    use mod_B
+    type(t2) :: b
+  end subroutine
+end module
+
+module mod_D
+  use mod_A
+  use mod_C
+end module
+
+! { dg-final { cleanup-modules "mod_A mod_B mod_C mod_D" } }
diff --git a/gcc/testsuite/gfortran.dg/class_16.f03 b/gcc/testsuite/gfortran.dg/class_16.f03
new file mode 100644
index 000000000..7d0d38f80
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_16.f03
@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+! PR 43896: [fortran-dev Regression] ICE in gfc_conv_variable, at fortran/trans-expr.c:551
+!
+! Contributed by Fran Martinez Fadrique <fmartinez@gmv.com>
+
+module m_rotation_matrix
+
+  type t_rotation_matrix
+    contains
+      procedure :: array => rotation_matrix_array
+  end type
+
+contains
+
+  function rotation_matrix_array( rot ) result(array)
+    class(t_rotation_matrix) :: rot
+    double precision, dimension(3,3)    :: array
+  end function
+
+end module
+
+! { dg-final { cleanup-modules "m_rotation_matrix" } }
diff --git a/gcc/testsuite/gfortran.dg/class_17.f03 b/gcc/testsuite/gfortran.dg/class_17.f03
new file mode 100644
index 000000000..b015c1319
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_17.f03
@@ -0,0 +1,64 @@
+! { dg-do compile }
+!
+! PR 43696: [OOP] Bogus error: Passed-object dummy argument must not be POINTER
+!
+! Contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
+
+
+MODULE error_stack_module
+  implicit none
+
+  type,abstract::serializable_class
+   contains
+     procedure(ser_DTV_RF),deferred::read_formatted
+  end type serializable_class
+
+  abstract interface
+     subroutine ser_DTV_RF(dtv,unit,iotype,v_list,iostat,iomsg)
+       import serializable_class
+       CLASS(serializable_class),INTENT(INOUT) :: dtv
+       INTEGER, INTENT(IN) :: unit
+       CHARACTER (LEN=*), INTENT(IN) :: iotype
+       INTEGER, INTENT(IN) :: v_list(:)
+       INTEGER, INTENT(OUT) :: iostat
+       CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
+     end subroutine ser_DTV_RF
+  end interface
+
+  type,extends(serializable_class)::error_type
+     class(error_type),pointer::next=>null()
+   contains
+     procedure::read_formatted=>error_read_formatted
+  end type error_type
+
+contains
+
+  recursive subroutine error_read_formatted(dtv,unit,iotype,v_list,iostat,iomsg)
+    CLASS(error_type),INTENT(INOUT) :: dtv
+    INTEGER, INTENT(IN) :: unit
+    CHARACTER (LEN=*), INTENT(IN) :: iotype
+    INTEGER, INTENT(IN) :: v_list(:)
+    INTEGER, INTENT(OUT) :: iostat
+    CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
+    character(8),allocatable::type
+    character(8),allocatable::next
+    call basic_read_string(unit,type)
+    call basic_read_string(unit,next)
+    if(next=="NEXT")then
+       allocate(dtv%next)
+       call dtv%next%read_formatted(unit,iotype,v_list,iostat,iomsg)
+    end if
+  end subroutine error_read_formatted
+
+end MODULE error_stack_module
+
+
+module b_module
+  implicit none
+  type::b_type
+     class(not_yet_defined_type_type),pointer::b_component  ! { dg-error "is a type that has not been declared" }
+  end type b_type
+end module b_module
+ 
+
+! { dg-final { cleanup-modules "error_stack_module b_module" } }
diff --git a/gcc/testsuite/gfortran.dg/class_18.f03 b/gcc/testsuite/gfortran.dg/class_18.f03
new file mode 100644
index 000000000..576f931f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_18.f03
@@ -0,0 +1,18 @@
+! { dg-do run }
+!
+! PR 43207: [OOP] ICE for class pointer => null() initialization
+!
+! Original test case by Tobias Burnus <burnus@gcc.gnu.org>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+  implicit none
+  type :: parent
+  end type
+  type(parent), target :: t
+  class(parent), pointer :: cp => null()
+
+  if (associated(cp)) call abort()
+  cp => t
+  if (.not. associated(cp)) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/class_19.f03 b/gcc/testsuite/gfortran.dg/class_19.f03
new file mode 100644
index 000000000..78e5652a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_19.f03
@@ -0,0 +1,45 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+!
+! PR 43969: [OOP] ALLOCATED() with polymorphic variables
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+
+module foo_mod
+  type foo_inner
+    integer, allocatable :: v(:)
+  end type foo_inner
+  type foo_outer
+    class(foo_inner), allocatable :: int
+  end type foo_outer
+contains
+subroutine foo_checkit()
+  implicit none
+  type(foo_outer)    :: try
+  type(foo_outer),allocatable :: try2
+  class(foo_outer), allocatable :: try3
+  
+  if (allocated(try%int)) call abort()
+  allocate(foo_outer :: try3)
+  if (allocated(try3%int)) call abort()
+  allocate(try2)
+  if (allocated(try2%int)) call abort()
+ 
+end subroutine foo_checkit
+end module foo_mod
+
+
+program main
+
+  use foo_mod
+  implicit none
+  
+  call foo_checkit()
+
+end program main
+
+! { dg-final { scan-tree-dump-times "__builtin_free" 8 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
+! { dg-final { cleanup-modules "foo_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/class_2.f03 b/gcc/testsuite/gfortran.dg/class_2.f03
new file mode 100644
index 000000000..3a75d5568
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_2.f03
@@ -0,0 +1,49 @@
+! { dg-do compile }
+!
+! PR 40940: CLASS statement
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+use,intrinsic :: iso_c_binding
+
+type t1
+  integer :: comp
+end type
+
+type t2
+  sequence
+  real :: r
+end type
+
+type,bind(c) :: t3
+  integer(c_int) :: i
+end type
+
+type :: t4
+  procedure(absint), pointer :: p  ! { dg-error "Non-polymorphic passed-object dummy argument" }
+end type
+
+type :: t5
+  class(t1) :: c  ! { dg-error "must be allocatable or pointer" }
+end type
+
+abstract interface
+  subroutine absint(arg)
+    import :: t4
+    type(t4) :: arg
+  end subroutine
+end interface
+
+type t6
+  integer :: i
+  class(t6), allocatable :: foo  ! { dg-error "must have the POINTER attribute" }
+end type t6
+
+
+class(t1) :: o1  ! { dg-error "must be dummy, allocatable or pointer" }
+
+class(t2), pointer :: o2  ! { dg-error "is not extensible" }
+class(t3), pointer :: o3  ! { dg-error "is not extensible" }
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/class_20.f03 b/gcc/testsuite/gfortran.dg/class_20.f03
new file mode 100644
index 000000000..1428102e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_20.f03
@@ -0,0 +1,40 @@
+! { dg-do compile }
+!
+! PR 44044: [OOP] SELECT TYPE with class-valued function
+! comment #1
+!
+! Note: All three error messages are being checked for double occurrence,
+!       using the trick from PR 30612.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+
+implicit none
+
+type :: t
+end type
+
+type :: s
+  sequence
+end type
+
+contains
+
+  function fun()  ! { dg-bogus "must be dummy, allocatable or pointer.*must be dummy, allocatable or pointer" }
+    class(t) :: fun
+  end function
+ 
+  function fun2()  ! { dg-bogus "cannot have a deferred shape.*cannot have a deferred shape" }
+    integer,dimension(:) :: fun2
+  end function
+ 
+  function fun3() result(res)  ! { dg-bogus "is not extensible.*is not extensible" }
+    class(s),pointer :: res
+  end function
+
+end
+
+
+! { dg-error "must be dummy, allocatable or pointer" "" { target *-*-* } 23 }
+! { dg-error "cannot have a deferred shape"          "" { target *-*-* } 27 }
+! { dg-error "is not extensible"                     "" { target *-*-* } 31 }
diff --git a/gcc/testsuite/gfortran.dg/class_21.f03 b/gcc/testsuite/gfortran.dg/class_21.f03
new file mode 100644
index 000000000..93b9616ae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_21.f03
@@ -0,0 +1,18 @@
+! { dg-do compile }
+!
+! PR 43990: [OOP] ICE in output_constructor_regular_field, at varasm.c:4995
+!
+! Reported by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
+
+module m
+
+  type :: t
+     logical :: l = .true.
+     class(t),pointer :: cp => null()
+  end type
+
+  type(t),save :: default_t
+
+end module
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/class_22.f03 b/gcc/testsuite/gfortran.dg/class_22.f03
new file mode 100644
index 000000000..df68783b4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_22.f03
@@ -0,0 +1,31 @@
+! { dg-do compile }
+!
+! PR 44212: [OOP] ICE when defining a pointer component before defining the class and calling a TBP then
+!
+! Contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
+
+module ice_module
+
+  type :: B_type
+     class(A_type),pointer :: A_comp
+  end type B_type
+
+  type :: A_type
+  contains
+     procedure :: A_proc
+  end type A_type
+
+contains
+
+  subroutine A_proc(this)
+    class(A_type),target,intent(inout) :: this
+  end subroutine A_proc
+
+  subroutine ice_proc(this)
+    class(A_type) :: this
+    call this%A_proc()
+  end subroutine ice_proc
+
+end module ice_module
+
+! { dg-final { cleanup-modules "ice_module" } }
diff --git a/gcc/testsuite/gfortran.dg/class_23.f03 b/gcc/testsuite/gfortran.dg/class_23.f03
new file mode 100644
index 000000000..e1e351762
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_23.f03
@@ -0,0 +1,24 @@
+! { dg-do compile }
+!
+! PR 42051: [OOP] ICE on array-valued function with CLASS formal argument
+!
+! Original test case by Damian Rouson <damian@rouson.net>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+  type grid
+  end type 
+
+contains
+
+  function return_x(this) result(this_x)
+    class(grid) :: this
+    real  ,dimension(1) :: this_x
+  end function
+
+  subroutine output()
+    type(grid) :: mesh
+    real ,dimension(1) :: x
+    x = return_x(mesh)
+  end subroutine
+
+end
diff --git a/gcc/testsuite/gfortran.dg/class_24.f03 b/gcc/testsuite/gfortran.dg/class_24.f03
new file mode 100644
index 000000000..085e6d1e1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_24.f03
@@ -0,0 +1,22 @@
+! { dg-do compile }
+!
+! PR 44869: [OOP] Missing TARGET check - and wrong code or accepts-invalid?
+!
+! Contributed by Satish.BD <bdsatish@gmail.com>
+
+  type :: test_case
+  end type 
+
+  type :: test_suite
+    type(test_case) :: list
+  end type
+
+contains
+
+  subroutine sub(self)
+    class(test_suite), intent(inout) :: self
+    type(test_case), pointer :: tst_case
+    tst_case => self%list       ! { dg-error "is neither TARGET nor POINTER" }
+  end subroutine
+
+end
diff --git a/gcc/testsuite/gfortran.dg/class_25.f03 b/gcc/testsuite/gfortran.dg/class_25.f03
new file mode 100644
index 000000000..3588b7759
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_25.f03
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! PR [OOP] Compile-time errors on typed allocation and pointer function result assignment
+!
+! Contributed by Damian Rouson <damian@rouson.net>
+
+module m
+
+  implicit none
+
+  type foo 
+  end type
+
+  type ,extends(foo) :: bar
+  end type
+
+contains
+
+  function new_bar()
+    class(foo) ,pointer :: new_bar
+    allocate(bar :: new_bar) 
+  end function
+
+end module
+
+end 
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/class_26.f03 b/gcc/testsuite/gfortran.dg/class_26.f03
new file mode 100644
index 000000000..629c9c98e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_26.f03
@@ -0,0 +1,29 @@
+! { dg-do run }
+!
+! PR 44065: [OOP] Undefined reference to vtab$...
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+module s_mat_mod
+  implicit none 
+  type :: s_sparse_mat
+  end type
+contains
+  subroutine s_set_triangle(a)
+    class(s_sparse_mat), intent(inout) :: a
+  end subroutine
+end module
+
+module s_tester
+implicit none
+contains
+  subroutine s_ussv_2
+    use s_mat_mod
+    type(s_sparse_mat) :: a
+    call s_set_triangle(a)
+  end subroutine
+end module
+
+end
+ 
+! { dg-final { cleanup-modules "s_mat_mod s_tester" } }
diff --git a/gcc/testsuite/gfortran.dg/class_27.f03 b/gcc/testsuite/gfortran.dg/class_27.f03
new file mode 100644
index 000000000..c3a3c902e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_27.f03
@@ -0,0 +1,67 @@
+! { dg-do compile }
+!
+! PR 46330: [4.6 Regression] [OOP] ICE after revision 166368
+!
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+! Taken from http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/76f99e7fd4f3e772
+
+module type2_type 
+ implicit none 
+ type, abstract :: Type2 
+ end type Type2 
+end module type2_type 
+
+module extended2A_type 
+ use type2_type 
+ implicit none 
+ type, extends(Type2) :: Extended2A 
+    real(kind(1.0D0)) :: coeff1 = 1. 
+ contains 
+    procedure :: setCoeff1 => Extended2A_setCoeff1 
+ end type Extended2A 
+ contains 
+    function Extended2A_new(c1, c2) result(typePtr_) 
+       real(kind(1.0D0)), optional, intent(in) :: c1 
+       real(kind(1.0D0)), optional, intent(in) :: c2 
+       type(Extended2A), pointer  :: typePtr_ 
+       type(Extended2A), save, allocatable, target  :: type_ 
+       allocate(type_) 
+       typePtr_ => null() 
+       if (present(c1)) call type_%setCoeff1(c1) 
+       typePtr_ => type_ 
+       if ( .not.(associated (typePtr_))) then 
+          stop 'Error initializing Extended2A Pointer.' 
+       endif 
+    end function Extended2A_new 
+    subroutine Extended2A_setCoeff1(this,c1) 
+       class(Extended2A) :: this 
+       real(kind(1.0D0)), intent(in) :: c1 
+       this% coeff1 = c1 
+    end subroutine Extended2A_setCoeff1 
+end module extended2A_type 
+
+module type1_type 
+ use type2_type 
+ implicit none 
+ type Type1 
+    class(type2), pointer :: type2Ptr => null() 
+ contains 
+    procedure :: initProc => Type1_initProc 
+ end type Type1 
+ contains 
+    function Type1_initProc(this) result(iError) 
+       use extended2A_type 
+       implicit none 
+       class(Type1) :: this 
+       integer :: iError 
+          this% type2Ptr => extended2A_new() 
+          if ( .not.( associated(this% type2Ptr))) then 
+             iError = 1 
+             write(*,'(A)') "Something Wrong." 
+          else 
+             iError = 0 
+          endif 
+    end function Type1_initProc 
+end module type1_type
+
+! { dg-final { cleanup-modules "type2_type extended2A_type type1_type" } }
diff --git a/gcc/testsuite/gfortran.dg/class_28.f03 b/gcc/testsuite/gfortran.dg/class_28.f03
new file mode 100644
index 000000000..684b8cdab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_28.f03
@@ -0,0 +1,45 @@
+! { dg-do compile }
+!
+! PR 46344: [4.6 Regression] [OOP] ICE with allocatable CLASS components
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+module m
+
+  type t1
+  end type
+
+  type  t2
+    class(t1), allocatable :: cc
+  end type
+
+  class(t2), allocatable :: sm
+
+end module m
+
+
+module m2
+
+  type t1
+  end type
+
+  type  t2
+    class(t1), allocatable :: c
+  end type
+
+  type(t1) :: w
+
+end module m2
+
+
+program p
+  use m
+  implicit none
+
+  type(t2), allocatable :: x(:) 
+
+  allocate(x(1))
+
+end program p
+
+! { dg-final { cleanup-modules "m m2" } }
diff --git a/gcc/testsuite/gfortran.dg/class_29.f03 b/gcc/testsuite/gfortran.dg/class_29.f03
new file mode 100644
index 000000000..d5ed8fae3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_29.f03
@@ -0,0 +1,34 @@
+! { dg-do compile }
+!
+! PR 46313: [OOP] OOP-ABI issue, ALLOCATE issue, CLASS renaming issue
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+module m1
+  type mytype
+    real :: a(10) = 2
+  end type
+end module m1
+
+module m2
+  type mytype
+    real :: b(10) = 8
+  end type
+end module m2
+
+program p
+use m1, t1 => mytype
+use m2, t2 => mytype
+implicit none
+
+class(t1), allocatable :: x
+class(t2), allocatable :: y
+
+allocate (t1 :: x)
+allocate (t2 :: y)
+
+print *, x%a
+print *, y%b
+end
+
+! { dg-final { cleanup-modules "m1 m2" } }
diff --git a/gcc/testsuite/gfortran.dg/class_3.f03 b/gcc/testsuite/gfortran.dg/class_3.f03
new file mode 100644
index 000000000..8e15f0e57
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_3.f03
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR 40940: [F03] CLASS statement
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+ type :: t
+  integer :: comp
+ end type
+
+ class(t), pointer :: cl  ! { dg-error "CLASS statement" }
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/class_30.f90 b/gcc/testsuite/gfortran.dg/class_30.f90
new file mode 100644
index 000000000..f2cedcb97
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_30.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+!
+! PR fortran/46244 (comments 7 to 9)
+!
+! gfortran accepted CLASS in bind(C) and SEQUENCE types
+!
+type :: t
+  integer :: i
+end type t
+
+type t2
+  sequence
+  class(t), pointer :: x ! { dg-error "Polymorphic component x at .1. in SEQUENCE or BIND" }
+end type t2
+
+type, bind(C):: t3
+  class(t), pointer :: y
+  ! { dg-warning "may not be C interoperable" "" { target *-*-* } 17 }
+  ! { dg-error "Polymorphic component y at .1. in SEQUENCE or BIND" "" { target *-*-* } 17 }
+end type t3
+end
diff --git a/gcc/testsuite/gfortran.dg/class_31.f90 b/gcc/testsuite/gfortran.dg/class_31.f90
new file mode 100644
index 000000000..eddf13f1b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_31.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+!
+! PR fortran/46413
+!
+type t
+  integer :: ii =5
+end type t
+class(t), allocatable :: x
+allocate (t :: x)
+
+print *,x  ! { dg-error "Data transfer element at .1. cannot be polymorphic" }
+end
diff --git a/gcc/testsuite/gfortran.dg/class_32.f90 b/gcc/testsuite/gfortran.dg/class_32.f90
new file mode 100644
index 000000000..b5857c1f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_32.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+!
+! PR 45827: [4.6 Regression] [OOP] mio_component_ref(): Component not found
+!
+! Contributed by Daniel Franke <dfranke@gcc.gnu.org>
+
+MODULE m
+
+  TYPE, ABSTRACT :: t
+    PRIVATE
+    INTEGER   :: n
+  CONTAINS
+    PROCEDURE :: get
+  END TYPE
+
+  ABSTRACT INTERFACE
+    SUBROUTINE create(this)
+      IMPORT t
+      CLASS(t) :: this
+    END SUBROUTINE
+  END INTERFACE
+
+CONTAINS
+
+  FUNCTION get(this)
+    CLASS(t) :: this
+    REAL, DIMENSION(this%n) :: get
+  END FUNCTION
+
+  SUBROUTINE destroy(this)
+    CLASS(t) :: this
+  END SUBROUTINE
+
+END MODULE
+
+
+PROGRAM p
+  USE m
+END
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/class_33.f90 b/gcc/testsuite/gfortran.dg/class_33.f90
new file mode 100644
index 000000000..b809fb1df
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_33.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+!
+! PR 46971: [4.6 Regression] [OOP] ICE on long class names
+!
+! Contributed by Andrew Benson <abenson@its.caltech.edu>
+
+module Molecular_Abundances_Structure
+  type molecularAbundancesStructure
+  end type
+  class(molecularAbundancesStructure), pointer :: molecules
+end module
+
+! { dg-final { cleanup-modules "Molecular_Abundances_Structure" } }
diff --git a/gcc/testsuite/gfortran.dg/class_34.f90 b/gcc/testsuite/gfortran.dg/class_34.f90
new file mode 100644
index 000000000..ecdb4ddc8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_34.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+!
+! PR 46448: [4.6 Regression] [OOP] symbol `__copy_...' is already defined
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m0
+  type :: t
+  end type
+end module 
+
+module m1
+  use m0
+  class(t), pointer :: c1
+end module
+
+module m2
+  use m0
+  class(t), pointer :: c2
+end module
+
+end
+
+! { dg-final { cleanup-modules "m0 m1 m2" } }
diff --git a/gcc/testsuite/gfortran.dg/class_35.f90 b/gcc/testsuite/gfortran.dg/class_35.f90
new file mode 100644
index 000000000..1b5502a78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_35.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+!
+! PR 46313: [OOP] class container naming collisions
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+module one
+  type two_three
+  end type
+end module
+
+module one_two
+  type three
+  end type
+end module
+
+use one
+use one_two
+class(two_three), allocatable :: a1
+class(three), allocatable :: a2
+
+if (same_type_as(a1,a2)) call abort()
+
+end 
+
+! { dg-final { cleanup-modules "one one_two" } }
diff --git a/gcc/testsuite/gfortran.dg/class_36.f03 b/gcc/testsuite/gfortran.dg/class_36.f03
new file mode 100644
index 000000000..6911f3f04
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_36.f03
@@ -0,0 +1,14 @@
+! { dg-do compile }
+!
+! PR 47572: [OOP] Invalid: Allocatable polymorphic with init expression.
+!
+! Contributed by Edmondo Giovannozzi <edmondo.giovannozzi@gmail.com>
+! cf. http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/763785b16883ed68
+
+program scalar_allocation
+  type test
+    real :: a
+  end type
+  class (test), allocatable :: b = test(3.4)  ! { dg-error "cannot have an initializer" }
+  print *,allocated(b)
+end program
diff --git a/gcc/testsuite/gfortran.dg/class_37.f03 b/gcc/testsuite/gfortran.dg/class_37.f03
new file mode 100644
index 000000000..f951ea1f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_37.f03
@@ -0,0 +1,263 @@
+! { dg-do compile }
+! Test fix for PR47082, in which an ICE in the ALLOCATE at line 248.
+!
+! Contributed by Salvatore Filippone  <salvatore.filippone@uniroma2.it>
+!
+module psb_penv_mod
+
+  interface psb_init
+    module procedure  psb_init
+  end interface
+
+  interface psb_exit
+    module procedure  psb_exit
+  end interface
+
+  interface psb_info
+    module procedure psb_info
+  end interface
+
+  integer, private, save :: nctxt=0
+
+
+
+contains
+
+
+  subroutine psb_init(ictxt,np,basectxt,ids)
+    implicit none 
+    integer, intent(out) :: ictxt
+    integer, intent(in), optional :: np, basectxt, ids(:)
+
+
+    ictxt = nctxt
+    nctxt = nctxt + 1
+
+  end subroutine psb_init
+
+  subroutine psb_exit(ictxt,close)
+    implicit none 
+    integer, intent(inout) :: ictxt
+    logical, intent(in), optional :: close
+
+    nctxt = max(0, nctxt - 1)    
+
+  end subroutine psb_exit
+
+
+  subroutine psb_info(ictxt,iam,np)
+
+    implicit none 
+
+    integer, intent(in)  :: ictxt
+    integer, intent(out) :: iam, np
+
+    iam = 0
+    np  = 1
+
+  end subroutine psb_info
+
+
+end module psb_penv_mod
+
+
+module psb_indx_map_mod
+
+  type      :: psb_indx_map
+
+    integer :: state          = -1
+    integer :: ictxt          = -1
+    integer :: mpic           = -1
+    integer :: global_rows    = -1
+    integer :: global_cols    = -1
+    integer :: local_rows     = -1
+    integer :: local_cols     = -1
+
+
+  end type psb_indx_map
+
+end module psb_indx_map_mod
+
+
+
+module psb_gen_block_map_mod
+  use psb_indx_map_mod
+  
+  type, extends(psb_indx_map) :: psb_gen_block_map
+    integer :: min_glob_row   = -1
+    integer :: max_glob_row   = -1
+    integer, allocatable :: loc_to_glob(:), srt_l2g(:,:), vnl(:)
+  contains
+
+    procedure, pass(idxmap)  :: gen_block_map_init => block_init
+
+  end type psb_gen_block_map
+
+  private ::  block_init
+
+contains
+
+  subroutine block_init(idxmap,ictxt,nl,info)
+    use psb_penv_mod
+    implicit none 
+    class(psb_gen_block_map), intent(inout) :: idxmap
+    integer, intent(in)  :: ictxt, nl
+    integer, intent(out) :: info
+    !  To be implemented
+    integer :: iam, np, i, j, ntot
+    integer, allocatable :: vnl(:)
+
+    info = 0
+    call psb_info(ictxt,iam,np) 
+    if (np < 0) then 
+      info = -1
+      return
+    end if
+    
+    allocate(vnl(0:np),stat=info)
+    if (info /= 0)  then
+      info = -2
+      return
+    end if
+    
+    vnl(:)   = 0
+    vnl(iam) = nl
+    ntot = sum(vnl)
+    vnl(1:np) = vnl(0:np-1)
+    vnl(0) = 0
+    do i=1,np
+      vnl(i) = vnl(i) + vnl(i-1)
+    end do
+    if (ntot /= vnl(np)) then 
+! !$      write(0,*) ' Mismatch in block_init ',ntot,vnl(np)
+    end if
+    
+    idxmap%global_rows  = ntot
+    idxmap%global_cols  = ntot
+    idxmap%local_rows   = nl
+    idxmap%local_cols   = nl
+    idxmap%ictxt        = ictxt
+    idxmap%state        = 1
+
+    idxmap%min_glob_row = vnl(iam)+1
+    idxmap%max_glob_row = vnl(iam+1) 
+    call move_alloc(vnl,idxmap%vnl)
+    allocate(idxmap%loc_to_glob(nl),stat=info) 
+    if (info /= 0)  then
+      info = -2
+      return
+    end if
+    
+  end subroutine block_init
+
+end module psb_gen_block_map_mod
+
+
+module psb_descriptor_type
+  use psb_indx_map_mod
+
+  implicit none
+
+
+  type psb_desc_type
+    integer, allocatable  :: matrix_data(:)
+    integer, allocatable  :: halo_index(:)
+    integer, allocatable  :: ext_index(:)
+    integer, allocatable  :: ovrlap_index(:)
+    integer, allocatable  :: ovrlap_elem(:,:)
+    integer, allocatable  :: ovr_mst_idx(:)
+    integer, allocatable  :: bnd_elem(:)
+    class(psb_indx_map), allocatable :: indxmap
+    integer, allocatable  :: lprm(:)
+    type(psb_desc_type), pointer     :: base_desc => null()
+    integer, allocatable  :: idx_space(:)
+  end type psb_desc_type
+
+
+end module psb_descriptor_type
+
+module psb_cd_if_tools_mod
+
+  use psb_descriptor_type
+  use psb_gen_block_map_mod
+
+  interface psb_cdcpy
+    subroutine psb_cdcpy(desc_in, desc_out, info)
+      use psb_descriptor_type
+
+      implicit none
+      !....parameters...
+
+      type(psb_desc_type), intent(in)  :: desc_in
+      type(psb_desc_type), intent(out) :: desc_out
+      integer, intent(out)             :: info
+    end subroutine psb_cdcpy
+  end interface
+
+
+end module psb_cd_if_tools_mod
+
+module psb_cd_tools_mod
+
+  use psb_cd_if_tools_mod
+
+  interface psb_cdall
+
+    subroutine psb_cdall(ictxt, desc, info,mg,ng,vg,vl,flag,nl,repl, globalcheck)
+      use psb_descriptor_type
+      implicit None
+      Integer, intent(in)               :: mg,ng,ictxt, vg(:), vl(:),nl
+      integer, intent(in)               :: flag
+      logical, intent(in)               :: repl, globalcheck
+      integer, intent(out)              :: info
+      type(psb_desc_type), intent(out)  :: desc
+      
+      optional :: mg,ng,vg,vl,flag,nl,repl, globalcheck
+    end subroutine psb_cdall
+   
+  end interface
+
+end module psb_cd_tools_mod
+module psb_base_tools_mod
+  use psb_cd_tools_mod
+end module psb_base_tools_mod
+
+subroutine psb_cdall(ictxt, desc, info,mg,ng,vg,vl,flag,nl,repl, globalcheck)
+  use psb_descriptor_type
+  use psb_gen_block_map_mod
+  use psb_base_tools_mod, psb_protect_name => psb_cdall
+  implicit None
+  Integer, intent(in)               :: mg,ng,ictxt, vg(:), vl(:),nl
+  integer, intent(in)               :: flag
+  logical, intent(in)               :: repl, globalcheck
+  integer, intent(out)              :: info
+  type(psb_desc_type), intent(out)  :: desc
+
+  optional :: mg,ng,vg,vl,flag,nl,repl, globalcheck
+  integer :: err_act, n_, flag_, i, me, np, nlp, nnv, lr
+  integer, allocatable :: itmpsz(:) 
+
+
+
+  info = 0
+  desc%base_desc => null() 
+  if (allocated(desc%indxmap)) then 
+    write(0,*) 'Allocated on an intent(OUT) var?'
+  end if
+
+  allocate(psb_gen_block_map :: desc%indxmap, stat=info)
+  if (info == 0) then 
+    select type(aa => desc%indxmap) 
+    type is (psb_gen_block_map) 
+      call aa%gen_block_map_init(ictxt,nl,info)
+    class default 
+        ! This cannot happen 
+      info = -1
+    end select
+  end if
+
+  return
+
+end subroutine psb_cdall
+
+ 
diff --git a/gcc/testsuite/gfortran.dg/class_38.f03 b/gcc/testsuite/gfortran.dg/class_38.f03
new file mode 100644
index 000000000..279362792
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_38.f03
@@ -0,0 +1,22 @@
+! { dg-do compile }
+!
+! PR 47728: [OOP] ICE on invalid CLASS declaration
+!
+! Contributed by Arjen Markus <arjen.markus@deltares.nl>
+
+program test_objects
+
+   implicit none
+
+   type, abstract :: shape
+   end type
+
+   type, extends(shape) :: rectangle
+       real :: width, height
+   end type
+
+   class(shape), dimension(2) :: object  ! { dg-error "must be dummy, allocatable or pointer" }
+
+   object(1) = rectangle( 1.0, 2.0 )  ! { dg-error "Unclassifiable statement" }
+
+end program test_objects
diff --git a/gcc/testsuite/gfortran.dg/class_39.f03 b/gcc/testsuite/gfortran.dg/class_39.f03
new file mode 100644
index 000000000..bc8039fc0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_39.f03
@@ -0,0 +1,13 @@
+! { dg-do compile }
+!
+! PR 47745: [OOP] Segfault with CLASS(*) and derived type dummy arguments
+!
+! Contributed by Rodney Polkinghorne <thisrod@gmail.com>
+
+  type, abstract :: T 
+  end type T
+contains
+  class(T) function add()  ! { dg-error "must be dummy, allocatable or pointer" }
+    add = 1  ! { dg-error "Variable must not be polymorphic in assignment" }
+  end function
+end
diff --git a/gcc/testsuite/gfortran.dg/class_40.f03 b/gcc/testsuite/gfortran.dg/class_40.f03
new file mode 100644
index 000000000..bd367dfe5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_40.f03
@@ -0,0 +1,36 @@
+! { dg-do run }
+!
+! PR 47767: [OOP] SELECT TYPE fails to execute correct TYPE IS block
+!
+! Contributed by Andrew Benson <abenson@caltech.edu>
+
+module Tree_Nodes
+  type treeNode
+   contains
+     procedure :: walk
+  end type
+contains
+  subroutine walk (thisNode)
+    class (treeNode) :: thisNode
+    print *, SAME_TYPE_AS (thisNode, treeNode())
+  end subroutine
+end module
+
+module Merger_Trees
+  use Tree_Nodes
+  private
+  type(treeNode), public :: baseNode
+end module
+
+module Merger_Tree_Build
+  use Merger_Trees
+end module
+
+program test
+  use Merger_Tree_Build
+  use Tree_Nodes
+  type(treeNode) :: node
+  call walk (node)
+end program
+
+! { dg-final { cleanup-modules "Tree_Nodes Merger_Trees Merger_Tree_Build" } }
diff --git a/gcc/testsuite/gfortran.dg/class_41.f03 b/gcc/testsuite/gfortran.dg/class_41.f03
new file mode 100644
index 000000000..bcab2b4ce
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_41.f03
@@ -0,0 +1,24 @@
+! { dg-do compile }
+!
+! PR 48059: [4.6 Regression][OOP] ICE in in gfc_conv_component_ref: character function of extended type
+!
+! Contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
+
+module a_module
+  type :: a_type
+     integer::length=0
+  end type a_type
+  type,extends(a_type) :: b_type
+  end type b_type
+contains
+  function a_string(this) result(form)
+    class(a_type),intent(in)::this
+    character(max(1,this%length))::form
+  end function a_string
+  subroutine b_sub(this)
+    class(b_type),intent(inout),target::this
+    print *,a_string(this)
+  end subroutine b_sub
+end module a_module
+
+! { dg-final { cleanup-modules "a_module" } }
diff --git a/gcc/testsuite/gfortran.dg/class_42.f03 b/gcc/testsuite/gfortran.dg/class_42.f03
new file mode 100644
index 000000000..dd59835cc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_42.f03
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! PR 48291: [4.6/4.7 Regression] [OOP] internal compiler error, new_symbol(): Symbol name too long
+!
+! Contributed by Adrian Prantl <adrian@llnl.gov>
+
+module Overload_AnException_Impl
+  type :: Overload_AnException_impl_t
+  end type
+contains
+  subroutine ctor_impl(self)
+    class(Overload_AnException_impl_t) :: self
+  end subroutine
+end module 
+
+! { dg-final { cleanup-modules "Overload_AnException_Impl" } }
diff --git a/gcc/testsuite/gfortran.dg/class_43.f03 b/gcc/testsuite/gfortran.dg/class_43.f03
new file mode 100644
index 000000000..86aa0e3c1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_43.f03
@@ -0,0 +1,14 @@
+! { dg-do compile }
+!
+! PR 49417: [4.6/4.7 Regression] [OOP] ICE on invalid CLASS component declaration
+!
+! Contributed by Andrew Benson <abenson@its.caltech.edu>
+
+ type :: nodeWrapper
+ end type nodeWrapper
+
+ type, extends(nodeWrapper) :: treeNode
+    class(nodeWrapper) :: subComponent   ! { dg-error "must be allocatable or pointer" }
+ end type treeNode
+
+end
diff --git a/gcc/testsuite/gfortran.dg/class_44.f03 b/gcc/testsuite/gfortran.dg/class_44.f03
new file mode 100644
index 000000000..f8e4004c0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_44.f03
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+! PR 49112: [4.6/4.7 Regression] [OOP] Missing type-bound procedure, "duplicate save" warnings and internal compiler error
+!
+! Contributed by John <jwmwalrus@gmail.com>
+
+    implicit none
+    save
+
+    type :: DateTime
+    end type
+
+    class(DateTime), allocatable :: dt
+
+end
diff --git a/gcc/testsuite/gfortran.dg/class_46.f03 b/gcc/testsuite/gfortran.dg/class_46.f03
new file mode 100644
index 000000000..4719c252f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_46.f03
@@ -0,0 +1,18 @@
+! { dg-do run }
+!
+! PR 50625: [4.6/4.7 Regression][OOP] ALLOCATABLE attribute lost for module CLASS variables
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+module m
+type t
+end type t
+class(t), allocatable :: x
+end module m
+
+use m
+implicit none
+if (allocated(x)) call abort()
+end 
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/class_47.f90 b/gcc/testsuite/gfortran.dg/class_47.f90
new file mode 100644
index 000000000..90a7560bc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_47.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+!
+! PR fortran/51913
+!
+! Contributed by Alexander Tismer
+!
+MODULE m_sparseMatrix
+
+  implicit none
+  
+  type :: sparseMatrix_t
+
+  end type sparseMatrix_t
+END MODULE m_sparseMatrix
+
+!===============================================================================
+module m_subroutine
+!  USE m_sparseMatrix !< when uncommenting this line program works fine
+
+  implicit none
+
+  contains
+  subroutine test(matrix)
+    use m_sparseMatrix
+    class(sparseMatrix_t), pointer :: matrix
+  end subroutine
+end module
+
+!===============================================================================
+PROGRAM main
+  use m_subroutine
+  USE m_sparseMatrix
+  implicit none
+
+  CLASS(sparseMatrix_t), pointer :: sparseMatrix
+  
+  call test(sparseMatrix)
+END PROGRAM
+
+! { dg-final { cleanup-modules "m_sparsematrix m_subroutine" } }
diff --git a/gcc/testsuite/gfortran.dg/class_4a.f03 b/gcc/testsuite/gfortran.dg/class_4a.f03
new file mode 100644
index 000000000..3cf0b7abf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_4a.f03
@@ -0,0 +1,14 @@
+! { dg-do compile }
+!
+! Test the fix for PR41583, in which the different source files
+! would generate the same 'vindex' for different class declared
+! types.
+!
+! The test comprises class_4a, class_4b class_4c and class_4d.f03
+
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module m
+  type t
+  end type t
+end module m
diff --git a/gcc/testsuite/gfortran.dg/class_4b.f03 b/gcc/testsuite/gfortran.dg/class_4b.f03
new file mode 100644
index 000000000..4658b8cf3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_4b.f03
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+! Test the fix for PR41583, in which the different source files
+! would generate the same 'vindex' for different class declared
+! types.
+!
+! The test comprises class_4a, class_4b class_4c and class_4d.f03
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module m2
+  use m
+  type, extends(t) :: t2
+  end type t2
+end module m2
diff --git a/gcc/testsuite/gfortran.dg/class_4c.f03 b/gcc/testsuite/gfortran.dg/class_4c.f03
new file mode 100644
index 000000000..c76b3ab69
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_4c.f03
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-additional-sources class_4a.f03 class_4b.f03 }
+!
+! Test the fix for PR41583, in which the different source files
+! would generate the same 'vindex' for different class declared
+! types.
+!
+! The test comprises class_4a, class_4b class_4c and class_4d.f03
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+  use m
+  use m2
+  type,extends(t) :: t3
+  end type t3
+
+  integer :: i
+  class(t), allocatable :: a
+  allocate(t3 :: a)
+  select type(a)
+    type is(t)
+      i = 1
+    type is(t2)
+      i = 2
+    type is(t3)
+      i = 3
+  end select
+  print *, i
+end
diff --git a/gcc/testsuite/gfortran.dg/class_4d.f03 b/gcc/testsuite/gfortran.dg/class_4d.f03
new file mode 100644
index 000000000..80934b6c1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_4d.f03
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+! Test the fix for PR41583, in which the different source files
+! would generate the same 'vindex' for different class declared
+! types.
+!
+! This file does nothing other than clean up the modules.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module m3
+  type t
+  end type t
+end module m3
+! { dg-final { cleanup-modules "m m2 m3" } }
diff --git a/gcc/testsuite/gfortran.dg/class_5.f03 b/gcc/testsuite/gfortran.dg/class_5.f03
new file mode 100644
index 000000000..087d745ae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_5.f03
@@ -0,0 +1,31 @@
+! { dg-do compile }
+!
+! PR 41719: [OOP] invalid: Intrinsic assignment involving polymorphic variables
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+ implicit none
+
+ type t1
+   integer :: a
+ end type
+
+ type, extends(t1) :: t2
+   integer :: b
+ end type
+
+ class(t1),pointer :: cp
+ type(t2) :: x
+
+ x = t2(45,478)
+ allocate(t2 :: cp)
+
+ cp = x   ! { dg-error "Variable must not be polymorphic" }
+
+ select type (cp)
+ type is (t2)
+   print *, cp%a, cp%b
+ end select
+
+end
+ 
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/class_6.f03 b/gcc/testsuite/gfortran.dg/class_6.f03
new file mode 100644
index 000000000..2f3ff62a6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_6.f03
@@ -0,0 +1,21 @@
+! { dg-do run }
+!
+! PR 41629: [OOP] gimplification error on valid code
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+  type t1
+    integer :: comp
+  end type
+
+  type(t1), target :: a
+
+  class(t1) :: x
+  pointer :: x       ! This is valid
+
+  a%comp = 3
+  x => a
+  print *,x%comp
+  if (x%comp/=3) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/class_7.f03 b/gcc/testsuite/gfortran.dg/class_7.f03
new file mode 100644
index 000000000..d7f1c835e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_7.f03
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! Test fixes for PR41587 and PR41608.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+! PR41587: used to accept the declaration of component 'foo'
+  type t0
+    integer :: j = 42
+  end type t0
+  type t
+    integer :: i
+! FIXME: uncomment and dejagnuify once class arrays are enabled
+!    class(t0), allocatable :: foo(3)  ! { "deferred shape" }
+  end type t
+
+! PR41608: Would ICE on missing type decl
+  class(t1), pointer :: c  ! { dg-error "before it is defined" }
+
+  select type (c)          ! { dg-error "shall be polymorphic" }
+    type is (t0)
+  end select
+end
diff --git a/gcc/testsuite/gfortran.dg/class_8.f03 b/gcc/testsuite/gfortran.dg/class_8.f03
new file mode 100644
index 000000000..78f10ebe2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_8.f03
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! Test fixes for PR41618.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+!
+ type t1
+   integer :: comp
+   class(t1),pointer :: cc
+ end type
+
+ class(t1) :: x ! { dg-error "must be dummy, allocatable or pointer" }
+
+ x%comp = 3
+ print *,x%comp
+
+end
diff --git a/gcc/testsuite/gfortran.dg/class_9.f03 b/gcc/testsuite/gfortran.dg/class_9.f03
new file mode 100644
index 000000000..5dbd4597a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_9.f03
@@ -0,0 +1,68 @@
+! { dg-do run }
+! Test the fix for PR41706, in which arguments of class methods that
+! were themselves class methods did not work.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+!
+module m
+type :: t
+  real :: v = 1.5
+contains
+  procedure, nopass :: a
+  procedure, nopass :: b
+  procedure, pass :: c
+  procedure, nopass :: d
+end type
+
+contains
+
+  real function a (x)
+    real :: x
+    a = 2.*x
+  end function
+
+  real function b (x)
+    real :: x
+    b = 3.*x
+  end function
+
+  real function c (x)
+    class (t) :: x
+    c = 4.*x%v
+  end function
+
+  subroutine d (x)
+    real :: x
+    if (abs(x-3.0)>1E-3) call abort()
+  end subroutine
+
+  subroutine s (x)
+    class(t) :: x
+    real :: r
+    r = x%a (1.1)       ! worked
+    if (r .ne. a (1.1)) call abort
+
+    r = x%a (b (1.2))   ! worked
+    if (r .ne. a(b (1.2))) call abort
+
+    r = b ( x%a (1.3))  ! worked
+    if (r .ne. b(a (1.3))) call abort
+
+    r = x%a(x%b (1.4))   ! failed
+    if (r .ne. a(b (1.4))) call abort
+
+    r = x%a(x%c ())   ! failed
+    if (r .ne. a(c (x))) call abort
+
+    call x%d (x%a(1.5))  ! failed
+
+  end subroutine
+
+end
+
+  use m
+  class(t),allocatable :: x
+  allocate(x)
+  call s (x)
+end
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/class_allocate_1.f03 b/gcc/testsuite/gfortran.dg/class_allocate_1.f03
new file mode 100644
index 000000000..67c806579
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_allocate_1.f03
@@ -0,0 +1,98 @@
+! { dg-do run }
+!
+! Allocating CLASS variables.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+ implicit none
+
+ type t1
+   integer :: comp = 5
+   class(t1),pointer :: cc
+ end type
+
+ type, extends(t1) :: t2
+   integer :: j
+ end type
+
+ type, extends(t2) :: t3
+   integer :: k
+ end type
+
+ class(t1),pointer :: cp, cp2
+ type(t2),pointer :: cp3
+ type(t3) :: x
+ integer :: i
+
+
+ ! (1) check that vindex is set correctly (for different cases)
+
+ i = 0
+ allocate(cp)
+ select type (cp)
+ type is (t1)
+   i = 1
+ type is (t2)
+   i = 2
+ type is (t3)
+   i = 3
+ end select
+ deallocate(cp)
+ if (i /= 1) call abort()
+
+ i = 0
+ allocate(t2 :: cp)
+ select type (cp)
+ type is (t1)
+   i = 1
+ type is (t2)
+   i = 2
+ type is (t3)
+   i = 3
+ end select
+ deallocate(cp)
+ if (i /= 2) call abort()
+
+ i = 0
+ allocate(cp, source = x)
+ select type (cp)
+ type is (t1)
+   i = 1
+ type is (t2)
+   i = 2
+ type is (t3)
+   i = 3
+ end select
+ deallocate(cp)
+ if (i /= 3) call abort()
+
+ i = 0
+ allocate(t2 :: cp2)
+ allocate(cp, source = cp2)
+ allocate(t2 :: cp3)
+ allocate(cp, source=cp3)
+ select type (cp)
+ type is (t1)
+   i = 1
+ type is (t2)
+   i = 2
+ type is (t3)
+   i = 3
+ end select
+ deallocate(cp)
+ deallocate(cp2)
+ if (i /= 2) call abort()
+
+
+ ! (2) check initialization (default initialization vs. SOURCE)
+
+ allocate(cp)
+ if (cp%comp /= 5) call abort()
+ deallocate(cp)
+
+ x%comp = 4
+ allocate(cp, source=x)
+ if (cp%comp /= 4) call abort()
+ deallocate(cp)
+
+end
diff --git a/gcc/testsuite/gfortran.dg/class_allocate_2.f03 b/gcc/testsuite/gfortran.dg/class_allocate_2.f03
new file mode 100644
index 000000000..cec05f17a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_allocate_2.f03
@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+! PR fortran/41582
+!
+subroutine test()
+type :: t
+end type t
+class(t), allocatable :: c,d
+allocate(t :: d)
+allocate(c,source=d)
+end
+
+type, abstract :: t
+end type t
+type t2
+  class(t), pointer :: t
+end type t2
+
+class(t), allocatable :: a,c,d
+type(t2) :: b
+allocate(a) ! { dg-error "requires a type-spec or source-expr" }
+allocate(b%t) ! { dg-error "requires a type-spec or source-expr" }
+end
diff --git a/gcc/testsuite/gfortran.dg/class_allocate_3.f03 b/gcc/testsuite/gfortran.dg/class_allocate_3.f03
new file mode 100644
index 000000000..c6128a8ab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_allocate_3.f03
@@ -0,0 +1,39 @@
+! { dg-do run }
+!
+! PR 41581: [OOP] Allocation of a CLASS with SOURCE=<class> does not work
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+ type t
+ end type t
+
+ type,extends(t) :: t2
+   integer :: i = 54
+   real :: r = 384.02
+ end type t2
+
+ class(t), allocatable :: m1, m2
+
+ allocate(t2 :: m2)
+ select type(m2)
+ type is (t2)
+   print *, m2%i, m2%r
+   if (m2%i/=54) call abort()
+   if (abs(m2%r-384.02)>1E-3) call abort()
+   m2%i = 42
+   m2%r = -4.0
+ class default
+   call abort()
+ end select
+
+ allocate(m1, source=m2)
+ select type(m1)
+ type is (t2)
+   print *, m1%i, m1%r
+   if (m1%i/=42) call abort()
+   if (abs(m1%r+4.0)>1E-3) call abort()
+ class default
+   call abort()
+ end select
+
+end
diff --git a/gcc/testsuite/gfortran.dg/class_allocate_4.f03 b/gcc/testsuite/gfortran.dg/class_allocate_4.f03
new file mode 100644
index 000000000..d1ebf8cc9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_allocate_4.f03
@@ -0,0 +1,23 @@
+! { dg-do run }
+!
+! PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+type t
+  integer :: i
+end type t
+type, extends(t) :: t2
+  integer :: j
+end type t2
+
+class(t), allocatable :: a
+allocate(a, source=t2(1,2))
+print *,a%i
+if(a%i /= 1) call abort()
+select type (a)
+  type is (t2)
+     print *,a%j
+     if(a%j /= 2) call abort()
+end select
+end
diff --git a/gcc/testsuite/gfortran.dg/class_allocate_5.f90 b/gcc/testsuite/gfortran.dg/class_allocate_5.f90
new file mode 100644
index 000000000..592161ef5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_allocate_5.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+!
+! PR fortran/45451
+!
+! Contributed by Salvatore Filippone and Janus Weil
+!
+! Check that ALLOCATE with SOURCE= does a deep copy.
+!
+program bug23
+  implicit none
+
+  type  :: psb_base_sparse_mat
+    integer, allocatable :: irp(:)
+  end type psb_base_sparse_mat
+
+  class(psb_base_sparse_mat), allocatable  :: a 
+  type(psb_base_sparse_mat) :: acsr
+
+  allocate(acsr%irp(4)) 
+  acsr%irp(1:4) = (/1,3,4,5/)
+
+  write(*,*) acsr%irp(:)
+
+  allocate(a,source=acsr)
+
+  write(*,*) a%irp(:)
+
+  call move_alloc(acsr%irp, a%irp)
+
+  write(*,*) a%irp(:)
+
+  if (any (a%irp /= [1,3,4,5])) call abort()
+end program bug23
+
diff --git a/gcc/testsuite/gfortran.dg/class_allocate_6.f03 b/gcc/testsuite/gfortran.dg/class_allocate_6.f03
new file mode 100644
index 000000000..8b96d1db2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_allocate_6.f03
@@ -0,0 +1,46 @@
+! { dg-do run }
+!
+! PR 46174: [OOP] ALLOCATE with SOURCE: Deep copy missing
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+implicit none
+type t
+end type t
+
+type, extends(t) :: t2
+  integer, allocatable :: a(:)
+end type t2
+
+class(t), allocatable :: x, y
+integer :: i
+
+allocate(t2 :: x)
+select type(x)
+ type is (t2)
+   allocate(x%a(10))
+   x%a = [ (i, i = 1,10) ]
+   print '(*(i3))', x%a
+ class default
+   call abort()
+end select
+
+allocate(y, source=x)
+
+select type(x)
+ type is (t2)
+   x%a = [ (i, i = 11,20) ]
+   print '(*(i3))', x%a
+ class default
+   call abort()
+end select
+
+select type(y)
+ type is (t2)
+   print '(*(i3))', y%a
+   if (any (y%a /= [ (i, i = 1,10) ])) call abort()
+ class default
+   call abort()
+end select
+
+end
diff --git a/gcc/testsuite/gfortran.dg/class_defined_operator_1.f03 b/gcc/testsuite/gfortran.dg/class_defined_operator_1.f03
new file mode 100644
index 000000000..008739e3f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_defined_operator_1.f03
@@ -0,0 +1,102 @@
+! { dg-do run }
+! Test the fix for PR42385, in which CLASS defined operators
+! compiled but were not correctly dynamically dispatched.
+!
+! Contributed by Janus Weil  <janus@gcc.gnu.org>
+!
+module foo_module
+ implicit none
+ private
+ public :: foo
+
+ type :: foo
+   integer :: foo_x
+ contains
+   procedure :: times => times_foo
+   procedure :: assign => assign_foo
+   generic :: operator(*) => times
+   generic :: assignment(=) => assign
+ end type
+
+contains
+
+   function times_foo(this,factor) result(product)
+     class(foo) ,intent(in) :: this
+     class(foo) ,allocatable :: product
+     integer, intent(in) :: factor
+     allocate (product, source = this)
+     product%foo_x = -product%foo_x * factor
+   end function
+
+   subroutine assign_foo(lhs,rhs)
+     class(foo) ,intent(inout) :: lhs
+     class(foo) ,intent(in) :: rhs
+     lhs%foo_x = -rhs%foo_x
+   end subroutine
+
+end module
+
+module bar_module
+ use foo_module ,only : foo
+ implicit none
+ private
+ public :: bar
+
+ type ,extends(foo) :: bar
+   integer :: bar_x
+ contains
+   procedure :: times => times_bar
+   procedure :: assign => assign_bar
+ end type
+
+contains
+ subroutine assign_bar(lhs,rhs)
+   class(bar) ,intent(inout) :: lhs
+   class(foo) ,intent(in) :: rhs
+   select type(rhs)
+     type is (bar)
+       lhs%bar_x = rhs%bar_x
+       lhs%foo_x = -rhs%foo_x
+   end select
+ end subroutine
+ function times_bar(this,factor) result(product)
+   class(bar) ,intent(in) :: this
+   integer, intent(in) :: factor
+   class(foo), allocatable :: product
+   select type(this)
+     type is (bar)
+       allocate(product,source=this)
+       select type(product)
+         type is(bar)
+           product%bar_x = 2*this%bar_x*factor
+       end select
+   end select
+ end function
+end module
+
+program main
+ use foo_module ,only : foo
+ use bar_module ,only : bar
+ implicit none
+ type(foo) :: unitf
+ type(bar) :: unitb
+
+! foo's assign negates, whilst its '*' negates and mutliplies.
+ unitf%foo_x = 1
+ call rescale(unitf, 42)
+ if (unitf%foo_x .ne. 42) call abort
+
+! bar's assign negates foo_x, whilst its '*' copies foo_x
+! and does a multiply by twice factor.
+ unitb%foo_x = 1
+ unitb%bar_x = 2
+ call rescale(unitb, 3)
+ if (unitb%bar_x .ne. 12) call abort
+ if (unitb%foo_x .ne. -1) call abort
+contains
+ subroutine rescale(this,scale)
+   class(foo) ,intent(inout) :: this
+   integer, intent(in) :: scale
+   this = this*scale
+ end subroutine
+end program
diff --git a/gcc/testsuite/gfortran.dg/class_dummy_1.f03 b/gcc/testsuite/gfortran.dg/class_dummy_1.f03
new file mode 100644
index 000000000..950379027
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_dummy_1.f03
@@ -0,0 +1,43 @@
+! { dg-do run }
+!
+! PR 44541: [OOP] wrong code for polymorphic variable with INTENT(OUT)/Alloc w/ MOLD
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+  implicit none
+
+  type t
+    integer :: a = 1
+  end type t
+
+  type, extends(t) :: t2
+    integer :: b = 3
+  end type t2
+
+  type(t2) :: y
+
+  y%a = 44
+  y%b = 55
+  call intent_out (y)
+  if (y%a/=1 .or. y%b/=3) call abort()
+
+  y%a = 66
+  y%b = 77
+  call intent_out_unused (y)
+  if (y%a/=1 .or. y%b/=3) call abort()
+
+contains
+
+  subroutine intent_out(x)
+    class(t), intent(out) :: x
+    select type (x)
+      type is (t2)
+      if (x%a/=1 .or. x%b/=3) call abort()
+    end select
+  end subroutine
+
+   subroutine intent_out_unused(x)
+     class(t), intent(out) :: x
+   end subroutine
+
+end
diff --git a/gcc/testsuite/gfortran.dg/class_dummy_2.f03 b/gcc/testsuite/gfortran.dg/class_dummy_2.f03
new file mode 100644
index 000000000..c1735822b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_dummy_2.f03
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! PR 45674: [OOP] Undefined references for extended types
+!
+! Contributed by Dietmar Ebner <dietmar.ebner@gmail.com>
+
+module fails_mod
+  implicit none 
+  type :: a_t
+     integer :: a
+  end type
+  type, extends(a_t) :: b_t
+     integer :: b
+  end type
+contains
+  subroutine foo(a)
+    class(a_t) :: a
+  end subroutine foo
+end module fails_mod
+
+module fails_test
+  implicit none
+contains
+  subroutine bar
+    use fails_mod
+    type(b_t) :: b
+    call foo(b)
+  end subroutine bar
+end module fails_test
+
+end
+
+! { dg-final { cleanup-modules "fails_mod fails_test" } }
diff --git a/gcc/testsuite/gfortran.dg/class_dummy_3.f03 b/gcc/testsuite/gfortran.dg/class_dummy_3.f03
new file mode 100644
index 000000000..6b12eb892
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_dummy_3.f03
@@ -0,0 +1,30 @@
+! { dg-do compile }
+!
+! PR 46161: [OOP] Invalid: Passing non-polymorphic to allocatable polymorphic dummy
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+  implicit none
+
+  type :: base
+  end type 
+
+  type, extends(base) :: ext
+  end type 
+
+  type(base), allocatable :: a
+  class(base), pointer :: b
+  class(ext), allocatable :: c
+  
+  call test(a)  ! { dg-error "must be polymorphic" }
+  call test(b)  ! { dg-error "must be ALLOCATABLE" }
+  call test(c)  ! { dg-error "must have the same declared type" }
+
+contains
+
+  subroutine test(arg)
+    implicit none 
+    class(base), allocatable :: arg
+  end subroutine
+
+end
diff --git a/gcc/testsuite/gfortran.dg/cmplx_intrinsic_1.f90 b/gcc/testsuite/gfortran.dg/cmplx_intrinsic_1.f90
new file mode 100644
index 000000000..bc4b9dfb2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cmplx_intrinsic_1.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+
+CONTAINS
+SUBROUTINE send_forward ()
+
+    INTEGER, DIMENSION(3)                    :: lz, ub, uz
+    REAL, ALLOCATABLE, DIMENSION(:, :, :)    :: buffer
+    COMPLEX, DIMENSION ( :, :, : ), POINTER  :: cc3d
+
+    cc3d ( lz(1):uz(1), lz(2):uz(2), lz(3):uz(3) ) = &
+           CMPLX ( buffer ( lz(1):uz(1), lz(2):uz(2), lz(3):uz(3) ), &
+                   KIND = SELECTED_REAL_KIND ( 14, 200 ) )
+   
+END SUBROUTINE send_forward
+END
+
diff --git a/gcc/testsuite/gfortran.dg/coarray_1.f90 b/gcc/testsuite/gfortran.dg/coarray_1.f90
new file mode 100644
index 000000000..7fd4c8424
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_1.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! Coarray support
+! PR fortran/18918
+!
+implicit none
+integer :: n
+critical  ! { dg-error "Fortran 2008:" }
+  sync all()  ! { dg-error "Fortran 2008:" }
+end critical ! { dg-error "Expecting END PROGRAM" }
+sync memory  ! { dg-error "Fortran 2008:" }
+sync images(*)  ! { dg-error "Fortran 2008:" }
+
+! num_images is implicitly defined:
+n = num_images()  ! { dg-error "has no IMPLICIT type" }
+error stop 'stop'  ! { dg-error "Fortran 2008:" }
+end
diff --git a/gcc/testsuite/gfortran.dg/coarray_10.f90 b/gcc/testsuite/gfortran.dg/coarray_10.f90
new file mode 100644
index 000000000..61cafa926
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_10.f90
@@ -0,0 +1,46 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/18918
+!
+! Coarray intrinsics
+!
+
+subroutine image_idx_test1()
+  INTEGER,save :: array[2,-1:4,8,*]
+  WRITE (*,*) IMAGE_INDEX (array, [2,0,3,1])
+  WRITE (*,*) IMAGE_INDEX (array, [0,0,3,1])  ! { dg-error "for dimension 1, SUB has 0 and COARRAY lower bound is 1" }
+  WRITE (*,*) IMAGE_INDEX (array, [1,2,9,0])  ! { dg-error "for dimension 3, SUB has 9 and COARRAY upper bound is 8" }
+  WRITE (*,*) IMAGE_INDEX (array, [2,0,3])    ! { dg-error "Too few elements" }
+  WRITE (*,*) IMAGE_INDEX (array, [2,0,3,1,1])! { dg-error "Too many elements" }
+end subroutine
+
+subroutine this_image_check()
+  integer,save :: a(1,2,3,5)[0:3,*]
+  integer :: j
+  integer,save :: z(4)[*], i
+
+  j = this_image(a,dim=3) ! { dg-error "not a valid codimension index" }
+  j = this_image(dim=3) ! { dg-error "DIM argument without ARRAY argument" }
+  i = image_index(i, [ 1 ]) ! { dg-error "Expected coarray variable" }
+  i = image_index(z, 2) ! { dg-error "must be a rank one array" }
+end subroutine this_image_check
+
+
+subroutine rank_mismatch()
+  implicit none
+  integer,allocatable :: A(:)[:,:,:,:]
+  allocate(A(1)[1,1,1:*])     ! { dg-error "Too few codimensions" }
+  allocate(A(1)[1,1,1,1,1,*]) ! { dg-error "Invalid codimension 5" }
+  allocate(A(1)[1,1,1,*])
+  allocate(A(1)[1,1])     ! { dg-error "Too few codimensions" }
+  allocate(A(1)[1,*])     ! { dg-error "Too few codimensions" }
+  allocate(A(1)[1,1:*])   ! { dg-error "Too few codimensions" }
+
+  A(1)[1,1,1] = 1       ! { dg-error "Too few codimensions" }
+  A(1)[1,1,1,1,1,1] = 1 ! { dg-error "Invalid codimension 5" }
+  A(1)[1,1,1,1] = 1
+  A(1)[1,1] = 1         ! { dg-error "Too few codimensions" }
+  A(1)[1,1] = 1         ! { dg-error "Too few codimensions" }
+  A(1)[1,1:1] = 1       ! { dg-error "Too few codimensions" }
+end subroutine rank_mismatch
diff --git a/gcc/testsuite/gfortran.dg/coarray_11.f90 b/gcc/testsuite/gfortran.dg/coarray_11.f90
new file mode 100644
index 000000000..7ec735357
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_11.f90
@@ -0,0 +1,64 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single -fdump-tree-original" }
+!
+! PR fortran/18918
+! PR fortran/43919 for boundsTest()
+!
+! Coarray intrinsics
+!
+
+subroutine image_idx_test1()
+  INTEGER,save :: array[2,-1:4,8,*]
+  WRITE (*,*) IMAGE_INDEX (array, [2,0,3,1])
+  if (IMAGE_INDEX (array, [1,-1,1,1]) /= 1) call not_existing()
+  if (IMAGE_INDEX (array, [2,-1,1,1]) /= 0) call not_existing()
+  if (IMAGE_INDEX (array, [1,-1,1,2]) /= 0) call not_existing()
+end subroutine
+
+subroutine this_image_check()
+  integer,save :: a(1,2,3,5)[0:3,*]
+  integer :: j
+  if (this_image() /= 1) call not_existing()
+  if (this_image(a,dim=1) /= 0) call not_existing()
+  if (this_image(a,dim=2) /= 1) call not_existing()
+end subroutine this_image_check
+
+subroutine othercheck()
+real,save :: a(5)[2,*]
+complex,save :: c[4:5,6,9:*]
+integer,save :: i, j[*]
+dimension :: b(3)
+codimension :: b[5:*]
+dimension :: h(9:10)
+codimension :: h[8:*]
+save :: b,h
+if (this_image() /= 1) call not_existing()
+if (num_images() /= 1) call not_existing()
+if(any(this_image(coarray=a) /= [ 1, 1 ])) call not_existing()
+if(any(this_image(c) /= [4,1,9])) call not_existing()
+if(this_image(c, dim=3) /= 9) call not_existing()
+if(ubound(b,dim=1) /= 3 .or. this_image(coarray=b,dim=1) /= 5) call not_existing()
+if(ubound(h,dim=1) /= 10 .or. this_image(h,dim=1) /= 8) call not_existing()
+end subroutine othercheck
+
+subroutine andanother()
+integer,save :: a(1)[2:9,4,-3:5,0:*]
+print *, lcobound(a)
+print *, lcobound(a,dim=3,kind=8)
+print *, ucobound(a)
+print *, ucobound(a,dim=1,kind=2)
+if (any(lcobound(a) /= [2, 1, -3, 0])) call not_existing()
+if (any(ucobound(a) /= [9, 4,  5, 0])) call not_existing()
+if (lcobound(a,dim=3,kind=8) /= -3_8)  call not_existing()
+if (ucobound(a,dim=1,kind=2) /=  9_2)  call not_existing()
+end subroutine andanother
+
+subroutine boundsTest()
+  implicit none
+  integer :: a[*] = 7
+  if (any (lcobound(a) /= [1])) call not_existing()
+  if (any (ucobound(a) /= [1])) call not_existing()
+end subroutine boundsTest
+
+! { dg-final { scan-tree-dump-times "not_existing" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_12.f90 b/gcc/testsuite/gfortran.dg/coarray_12.f90
new file mode 100644
index 000000000..c1b734212
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_12.f90
@@ -0,0 +1,77 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single -fdump-tree-original" }
+!
+! Coarray support -- allocatable array coarrays
+! PR fortran/18918
+!
+integer,allocatable :: a(:)[:,:]
+nn = 5
+mm = 7
+allocate(a(nn)[mm,*])
+end
+
+subroutine testAlloc3
+  implicit none
+  integer, allocatable :: ab(:,:,:)[:,:]
+  integer, allocatable, dimension(:),codimension[:] :: b(:,:,:)[:,:]
+  integer, allocatable, dimension(:,:),codimension[:,:,:] :: c
+  integer, allocatable, dimension(:,:),codimension[:,:,:] :: d[:,:]
+  integer, allocatable, dimension(:,:,:),codimension[:,:,:] :: e(:,:)
+  integer, allocatable, dimension(:,:,:),codimension[:,:,:] :: f(:,:)[:,:]
+
+  allocate(ab(1,2,3)[4,*])
+  allocate(b(1,2,3)[4,*])
+  allocate(c(1,2)[3,4,*])
+  allocate(d(1,2)[3,*])
+  allocate(e(1,2)[3,4,*])
+  allocate(f(1,2)[3,*])
+end subroutine testAlloc3
+
+subroutine testAlloc4()
+  implicit none
+  integer, allocatable :: xxx(:)[:,:,:,:]
+  integer :: mmm
+  mmm=88
+  allocate(xxx(1)[7,-5:8,mmm:2,*])
+end subroutine testAlloc4
+
+subroutine testAlloc5()
+  implicit none
+  integer, allocatable :: yyy(:)[:,:,:,:]
+  integer :: ooo, ppp
+  ooo=88
+  ppp=42
+  allocate(yyy(1)[7,-5:ppp,1,ooo:*])
+end subroutine testAlloc5
+
+
+! { dg-final { scan-tree-dump-times "a.dim.0..lbound = 1;"     1 "original" } }
+! { dg-final { scan-tree-dump-times "a.dim.0..ubound = .*nn;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "a.dim.1..lbound = 1;"     1 "original" } }
+! { dg-final { scan-tree-dump-times "a.dim.1..ubound = .*mm;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "a.dim.2..lbound = 1;"     1 "original" } }
+! { dg-final { scan-tree-dump-times "a.dim.2..ubound"          0 "original" } }
+
+! { dg-final { scan-tree-dump-times "xxx.dim.0..lbound = 1;"     1 "original" } }
+! { dg-final { scan-tree-dump-times "xxx.dim.0..ubound = 1;"     1 "original" } }
+! { dg-final { scan-tree-dump-times "xxx.dim.1..lbound = 1;"     1 "original" } }
+! { dg-final { scan-tree-dump-times "xxx.dim.1..ubound = 7;"     1 "original" } }
+! { dg-final { scan-tree-dump-times "xxx.dim.2..lbound = -5;"    1 "original" } }
+! { dg-final { scan-tree-dump-times "xxx.dim.2..ubound = 8;"     1 "original" } }
+! { dg-final { scan-tree-dump-times "xxx.dim.3..lbound = .*mmm;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "xxx.dim.3..ubound = 2;"     1 "original" } }
+! { dg-final { scan-tree-dump-times "xxx.dim.4..lbound = 1;"     1 "original" } }
+! { dg-final { scan-tree-dump-times "xxx.dim.4..ubound"          0 "original" } }
+
+! { dg-final { scan-tree-dump-times "yyy.dim.0..lbound = 1;"     1 "original" } }
+! { dg-final { scan-tree-dump-times "yyy.dim.0..ubound = 1;"     1 "original" } }
+! { dg-final { scan-tree-dump-times "yyy.dim.1..lbound = 1;"     1 "original" } }
+! { dg-final { scan-tree-dump-times "yyy.dim.1..ubound = 7;"     1 "original" } }
+! { dg-final { scan-tree-dump-times "yyy.dim.2..lbound = -5;"    1 "original" } }
+! { dg-final { scan-tree-dump-times "yyy.dim.2..ubound = .*ppp;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "yyy.dim.3..lbound = 1;"     1 "original" } }
+! { dg-final { scan-tree-dump-times "yyy.dim.3..ubound = 1;"     1 "original" } }
+! { dg-final { scan-tree-dump-times "yyy.dim.4..lbound = .*ooo;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "yyy.dim.4..ubound"          0 "original" } }
+
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_13.f90 b/gcc/testsuite/gfortran.dg/coarray_13.f90
new file mode 100644
index 000000000..bbd1ad491
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_13.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+! Coarray support -- allocatable array coarrays
+! PR fortran/18918
+! PR fortran/43931
+!
+program test
+  implicit none
+  call one()
+contains
+  subroutine one()
+    integer, allocatable :: a(:)[:,:,:]
+    allocate(a(1)[-4:9,8,4:*])
+  end subroutine one
+  subroutine four(C)
+    integer, allocatable :: C(:)[:]
+ end subroutine four
+end program test
diff --git a/gcc/testsuite/gfortran.dg/coarray_14.f90 b/gcc/testsuite/gfortran.dg/coarray_14.f90
new file mode 100644
index 000000000..3e3f0462b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_14.f90
@@ -0,0 +1,55 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/46370
+!
+! Coarray checks
+!
+
+! Check for C1229: "A data-ref shall not be a polymorphic subobject of a
+! coindexed object." which applies to function and subroutine calls.
+module m
+  implicit none
+  type t
+  contains
+    procedure, nopass :: sub=>sub
+    procedure, nopass :: func=>func
+  end type t
+  type t3
+    type(t) :: nopoly
+  end type t3
+  type t2
+    class(t), allocatable :: poly
+    class(t3), allocatable :: poly2
+  end type t2
+contains
+  subroutine sub()
+  end subroutine sub
+  function func()
+    integer :: func
+  end function func
+end module m
+
+subroutine test(x)
+  use m
+  type(t2) :: x[*]
+  integer :: i
+  call x[1]%poly2%nopoly%sub() ! OK
+  i = x[1]%poly2%nopoly%func() ! OK
+  call x[1]%poly%sub() ! { dg-error "Polymorphic subobject of coindexed object" }
+  i = x[1]%poly%func() ! { dg-error "Polymorphic subobject of coindexed object" }
+end subroutine test
+
+
+! Check for C617: "... a data-ref shall not be a polymorphic subobject of a
+! coindexed object or ..." 
+! Before, the second allocate statment was failing - though it is no subobject.
+program myTest
+type t
+end type t
+type(t), allocatable :: a[:]
+ allocate (t :: a) ! { dg-error "Coarray specification required in ALLOCATE statement" }
+allocate (t :: a[*]) ! { dg-error "allocatable scalar coarrays are not yet supported" }
+end program myTest
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_2.f90 b/gcc/testsuite/gfortran.dg/coarray_2.f90
new file mode 100644
index 000000000..902a0dd98
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_2.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+! { dg-shouldfail "error stop" }
+! 
+! Coarray support
+! PR fortran/18918
+
+implicit none
+integer :: n
+character(len=30) :: str
+critical
+end critical
+myCr: critical
+end critical myCr
+  sync all
+  sync all ( )
+  n = 5
+  sync all (stat=n)
+  if (n /= 0) call abort()
+  n = 5
+  sync all (stat=n,errmsg=str)
+  if (n /= 0) call abort()
+  sync all (errmsg=str)
+
+  sync memory
+  sync memory ( )
+  n = 5
+  sync memory (stat=n)
+  if (n /= 0) call abort()
+  n = 5
+  sync memory (errmsg=str,stat=n)
+  if (n /= 0) call abort()
+  sync memory (errmsg=str)
+
+sync images (*, stat=n)
+sync images (1, errmsg=str)
+sync images ([1],errmsg=str,stat=n)
+
+sync images (*)
+sync images (1)
+sync images ([1])
+
+if (num_images() /= 1) call abort()
+error stop 'stop'
+end
+
+! { dg-output "ERROR STOP stop" }
diff --git a/gcc/testsuite/gfortran.dg/coarray_28.f90 b/gcc/testsuite/gfortran.dg/coarray_28.f90
new file mode 100644
index 000000000..ca6f86356
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_28.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/54225
+!
+
+integer, allocatable :: a[:,:]
+
+allocate (a[*,4]) ! { dg-error "Unexpected '.' for codimension 1 of 2" }
+end
diff --git a/gcc/testsuite/gfortran.dg/coarray_3.f90 b/gcc/testsuite/gfortran.dg/coarray_3.f90
new file mode 100644
index 000000000..63c3bd335
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_3.f90
@@ -0,0 +1,100 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+! 
+! Coarray support
+! PR fortran/18918
+
+implicit none
+integer :: n, m(1), k
+character(len=30) :: str(2)
+
+critical fkl ! { dg-error "Syntax error in CRITICAL" }
+end critical fkl ! { dg-error "Expecting END PROGRAM" }
+
+sync all (stat=1) ! { dg-error "Syntax error in SYNC ALL" }
+sync all ( stat = n,stat=k) ! { dg-error "Redundant STAT" }
+sync memory (errmsg=str)
+sync memory (errmsg=n) ! { dg-error "must be a scalar CHARACTER variable" }
+sync images (*, stat=1.0) ! { dg-error "Syntax error in SYNC IMAGES" }
+sync images (-1) ! { dg-error "must between 1 and num_images" }
+sync images (1)
+sync images ( [ 1 ])
+sync images ( m(1:0) ) 
+sync images ( reshape([1],[1,1])) ! { dg-error "must be a scalar or rank-1" }
+end
+
+subroutine foo
+critical
+  stop 'error' ! { dg-error "Image control statement STOP" }
+  sync all     ! { dg-error "Image control statement SYNC" }
+  return 1     ! { dg-error "Image control statement RETURN" }
+  critical     ! { dg-error "Nested CRITICAL block" }
+  end critical 
+end critical   ! { dg-error "Expecting END SUBROUTINE" }
+end
+
+subroutine bar()
+do
+  critical
+    cycle ! { dg-error "leaves CRITICAL construct" }
+  end critical
+end do
+
+outer: do
+  critical
+    do
+      exit
+      exit outer ! { dg-error "leaves CRITICAL construct" }
+    end do
+  end critical
+end do outer
+end subroutine bar
+
+
+subroutine sub()
+333 continue ! { dg-error "leaves CRITICAL construct" }
+do
+  critical
+    if (.false.) then
+      goto 333 ! { dg-error "leaves CRITICAL construct" }
+      goto 777
+777 end if
+  end critical
+end do
+
+if (.true.) then
+outer: do
+  critical
+    do
+      goto 444
+      goto 555 ! { dg-error "leaves CRITICAL construct" }
+    end do
+444 continue
+  end critical
+ end do outer
+555 end if ! { dg-error "leaves CRITICAL construct" }
+end subroutine sub
+
+pure subroutine pureSub()
+  critical ! { dg-error "Image control statement CRITICAL" }
+  end critical ! { dg-error "Expecting END SUBROUTINE statement" }
+  sync all ! { dg-error "Image control statement SYNC" }
+  error stop ! { dg-error "not allowed in PURE procedure" }
+end subroutine pureSub
+
+
+SUBROUTINE TEST
+   goto 10 ! { dg-warning "is not in the same block" }
+   CRITICAL
+     goto 5  ! OK
+5    continue ! { dg-warning "is not in the same block" }
+     goto 10 ! OK
+     goto 20 ! { dg-error "leaves CRITICAL construct" }
+     goto 30 ! { dg-error "leaves CRITICAL construct" }
+10 END CRITICAL ! { dg-warning "is not in the same block" }
+   goto 5 ! { dg-warning "is not in the same block" }
+20 continue ! { dg-error "leaves CRITICAL construct" }
+   BLOCK
+30   continue ! { dg-error "leaves CRITICAL construct" }
+   END BLOCK
+end SUBROUTINE TEST
diff --git a/gcc/testsuite/gfortran.dg/coarray_4.f90 b/gcc/testsuite/gfortran.dg/coarray_4.f90
new file mode 100644
index 000000000..5607ec99a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_4.f90
@@ -0,0 +1,87 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! Coarray support -- corank declarations
+! PR fortran/18918
+!
+
+subroutine valid(n, c, f)
+  implicit none
+  integer :: n
+  integer, save :: a[*], b(4)[-1:4,*]
+  real :: c(*)[1,0:3,3:*]
+  real :: f(n)[0:n,-100:*]
+  integer, allocatable :: d[:], e(:)[:,:]
+  integer, save, codimension[1,*] :: g, h(7), i(6)[*], j[*]
+  integer :: k
+  codimension :: k[*]
+  save :: k
+  integer :: ii = 7
+  block
+    integer, save :: kk[ii, *] ! { dg-error "cannot have the SAVE attribute" }
+  end block
+end subroutine valid
+
+subroutine valid2()
+  type t
+    integer, allocatable :: a[:]
+  end type t
+  type, extends(t) :: tt
+    integer, allocatable :: b[:]
+  end type tt
+  type(tt), save :: foo
+  type(tt) :: bar ! { dg-error "is a coarray or has a coarray component" }
+end subroutine valid2
+
+subroutine invalid(n)
+  implicit none
+  integer :: n
+  integer :: k[*] ! { dg-error "not ALLOCATABLE, SAVE nor a dummy" }
+  integer :: h(3)[*] ! { dg-error "not ALLOCATABLE, SAVE nor a dummy" }
+  integer, save :: a[*]
+  codimension :: a[1,*] ! { dg-error "Duplicate CODIMENSION attribute" }
+  complex, save :: hh(n)[*] ! { dg-error "cannot have the SAVE attribute" }
+  integer :: j = 6
+
+  integer, save :: hf1[j,*] ! { dg-error "cannot appear in the expression|cannot have the SAVE attribute" }
+  integer, save :: hf2[n,*] ! { dg-error "cannot have the SAVE attribute" }
+  integer, save :: hf3(4)[j,*] ! { dg-error "cannot appear in the expression|cannot have the SAVE attribute" }
+  integer, save :: hf4(5)[n,*] ! { dg-error "cannot have the SAVE attribute" }
+
+  integer, allocatable :: a2[*] ! { dg-error "must have deferred shape" }
+  integer, allocatable :: a3(:)[*] ! { dg-error "must have deferred shape" }
+  integer, allocatable :: a4[*] ! { dg-error "must have deferred shape" }
+end subroutine invalid
+
+subroutine invalid2
+  use iso_c_binding
+  implicit none
+  type t0
+    integer, allocatable :: a[:,:,:]
+  end type t0
+  type t
+  end type t
+  type, extends(t) :: tt ! { dg-error "has a coarray component, parent type" }
+    integer, allocatable :: a[:]
+  end type tt
+  type ttt
+    integer, pointer :: a[:] ! { dg-error "must be allocatable" }
+  end type ttt
+  type t4
+    integer, allocatable :: b[4,*] ! { dg-error "with deferred shape" }
+  end type t4
+  type t5
+    type(c_ptr), allocatable :: p[:] ! { dg-error "shall not be a coarray" }
+  end type t5
+  type(t0), save :: t0_1[*] ! { dg-error "shall be a nonpointer, nonallocatable scalar" }
+  type(t0), allocatable :: t0_2[:] ! { dg-error "shall be a nonpointer, nonallocatable scalar" }
+  type(c_ptr), save :: pp[*] ! { dg-error "shall not be a coarray" }
+end subroutine invalid2
+
+elemental subroutine elem(a) ! { dg-error "Coarray dummy argument" }
+  integer, intent(in) :: a[*]
+end subroutine
+
+function func() result(res)
+  integer :: res[*] ! { dg-error "CODIMENSION attribute conflicts with RESULT" }
+end function func
diff --git a/gcc/testsuite/gfortran.dg/coarray_5.f90 b/gcc/testsuite/gfortran.dg/coarray_5.f90
new file mode 100644
index 000000000..46aa311f2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_5.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! Coarray support -- corank declarations
+! PR fortran/18918
+!
+
+integer :: a, b[*]  ! { dg-error "Fortran 2008: Coarray declaration" }
+codimension :: a[*] ! { dg-error "Fortran 2008: Coarray declaration" }
+end
diff --git a/gcc/testsuite/gfortran.dg/coarray_6.f90 b/gcc/testsuite/gfortran.dg/coarray_6.f90
new file mode 100644
index 000000000..d3c600b36
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_6.f90
@@ -0,0 +1,85 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! Coarray support -- corank declarations
+! PR fortran/18918
+!
+module m2
+  use iso_c_binding
+  integer(c_int), bind(C) :: a[*] ! { dg-error "BIND.C. attribute conflicts with CODIMENSION" }
+
+  type, bind(C) :: t ! { dg-error "cannot have the ALLOCATABLE" }
+    integer(c_int), allocatable :: a[:] ! { dg-error "cannot have the ALLOCATABLE" }
+    integer(c_int)  :: b[*] ! { dg-error "must be allocatable" }
+  end type t
+end module m2
+
+subroutine bind(a) bind(C) ! { dg-error "Coarray dummy variable" }
+  use iso_c_binding
+  integer(c_int) :: a[*]
+end subroutine bind
+
+subroutine allo(x) ! { dg-error "can thus not be an allocatable coarray" }
+  integer, allocatable, intent(out) :: x[:]
+end subroutine allo
+
+module m
+  integer :: modvar[*] ! OK, implicit save
+  type t
+    complex, allocatable :: b(:,:,:,:)[:,:,:]
+  end type t
+end module m
+
+subroutine bar()
+  integer, parameter :: a[*] = 4 ! { dg-error "PARAMETER attribute conflicts with CODIMENSION" }
+  integer, pointer :: b[:] ! { dg-error "is not ALLOCATABLE, SAVE nor a dummy" }
+end subroutine bar
+
+subroutine vol()
+  integer,save :: a[*]
+  block
+    volatile :: a ! { dg-error "Specifying VOLATILE for coarray" }
+  end block
+contains
+  subroutine int()
+    volatile :: a ! { dg-error "Specifying VOLATILE for coarray" }
+  end subroutine int
+end subroutine vol
+
+
+function func() result(func2) ! { dg-error "shall not be a coarray or have a coarray component" }
+  use m
+  type(t) :: func2
+end function func
+
+subroutine invalid()
+  type t
+    integer, allocatable :: a[:]
+  end type t
+  type t2
+    type(t), allocatable :: b ! { dg-error "nonpointer, nonallocatable scalar" }
+  end type t2
+  type t3
+    type(t), pointer :: c ! { dg-error "nonpointer, nonallocatable scalar" }
+  end type t3
+  type t4
+    type(t) :: d(4) ! { dg-error "nonpointer, nonallocatable scalar" }
+  end type t4
+end subroutine invalid
+
+subroutine valid(a)
+  integer :: a(:)[4,-1:6,4:*]
+  type t
+    integer, allocatable :: a[:]
+  end type t
+  type t2
+    type(t) :: b
+  end type t2
+  type(t2), save :: xt2[*]
+end subroutine valid
+
+program main
+  integer :: A[*] ! Valid, implicit SAVE attribute
+end program main
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_7.f90 b/gcc/testsuite/gfortran.dg/coarray_7.f90
new file mode 100644
index 000000000..29af0d191
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_7.f90
@@ -0,0 +1,175 @@
+! { dg-do compile }
+! { dg-options "-fmax-errors=1000 -fcoarray=single" }
+!
+! PR fortran/18918
+!
+! Coarray expressions.
+!
+program test
+  implicit none
+  type t3
+    integer, allocatable :: a
+  end type t3
+  type t4
+    type(t3) :: xt3
+  end type t4
+  type t
+    integer, pointer :: ptr
+    integer, allocatable :: alloc(:)
+  end type t
+  type(t), target :: i[*]
+  type(t), allocatable :: ca[:]
+  type(t4), target :: tt4[*]
+  type(t4), allocatable :: ca2[:]
+  integer, volatile :: volat[*]
+  integer, asynchronous :: async[*]
+  integer :: caf1[1,*], caf2[*]
+  allocate(i%ptr)
+  call foo(i%ptr)
+  call foo(i[1]%ptr) ! { dg-error "Coindexed actual argument at .1. to pointer dummy" }
+  call bar(i%ptr)
+  call bar(i[1]%ptr) ! OK, value of ptr target 
+  call bar(i[1]%alloc(1)) ! OK
+  call typeDummy(i) ! OK
+  call typeDummy(i[1]) ! { dg-error "with ultimate pointer component" }
+  call typeDummy2(ca) ! OK
+  call typeDummy2(ca[1]) ! { dg-error "with ultimate pointer component" }
+  call typeDummy3(tt4%xt3) ! OK
+  call typeDummy3(tt4[1]%xt3) ! { dg-error "requires either VALUE or INTENT.IN." }
+  call typeDummy4(ca2) ! OK
+  call typeDummy4(ca2[1]) ! { dg-error "requires INTENT.IN." }
+! Note: Checking an VOLATILE dummy is not possible as volatile + intent(in)
+! is not possible
+
+  call asyn(volat)
+  call asyn(async)
+  call asyn(volat[1]) ! { dg-error "Coindexed ASYNCHRONOUS or VOLATILE actual argument" }
+  call asyn(async[1]) ! { dg-error "Coindexed ASYNCHRONOUS or VOLATILE actual argument" }
+
+  call coarray(caf1) ! rank mismatch; OK, for non allocatable coarrays
+  call coarray(caf2)
+  call coarray(caf2[1]) ! { dg-error "must be a coarray" }
+  call ups(i)
+  call ups(i[1]) ! { dg-error "with ultimate pointer component" }
+  call ups(i%ptr)
+  call ups(i[1]%ptr) ! OK - passes target not pointer
+contains
+  subroutine asyn(a)
+    integer, intent(in), asynchronous :: a
+  end subroutine asyn
+  subroutine bar(a)
+    integer :: a
+  end subroutine bar
+  subroutine foo(a)
+    integer, pointer :: a
+  end subroutine foo
+  subroutine coarray(a)
+    integer :: a[*]
+  end subroutine coarray
+  subroutine typeDummy(a)
+    type(t) :: a
+  end subroutine typeDummy
+  subroutine typeDummy2(a)
+    type(t),allocatable :: a
+  end subroutine typeDummy2
+  subroutine typeDummy3(a)
+    type(t3) :: a
+  end subroutine typeDummy3
+  subroutine typeDummy4(a)
+    type(t4), allocatable :: a
+  end subroutine typeDummy4
+end program test
+
+
+subroutine alloc()
+type t
+  integer, allocatable :: a(:)
+end type t
+type(t), save :: a[*]
+type(t), allocatable :: b(:)[:], C[:]
+
+allocate(b(1)) ! { dg-error "Coarray specification" }
+allocate(a[3]%a(5)) ! { dg-error "Coindexed allocatable" }
+allocate(c[*]) ! { dg-error "Sorry" }
+allocate(a%a(5)) ! OK
+end subroutine alloc
+
+
+subroutine dataPtr()
+  integer, save, target :: a[*]
+  data a/5/ ! OK
+  data a[1]/5/ ! { dg-error "cannot have a coindex" }
+  type t
+  integer, pointer :: p
+  end type t
+  type(t), save :: x[*]
+
+  type t2
+    integer :: a(1)
+  end type t2
+  type(t2) y
+  data y%a/4/
+
+
+   x[1]%p => a  ! { dg-error "shall not have a coindex" }
+   x%p => a[1]  ! { dg-error "shall not have a coindex" }
+end subroutine dataPtr
+
+
+subroutine test3()
+implicit none
+type t
+  integer :: a(1)
+end type t
+type(t), save :: x[*]
+data x%a/4/
+
+  integer, save :: y(1)[*] !(1)
+  call sub(x(1:1)[1]) ! { dg-error "Rank mismatch" }
+contains
+  subroutine sub(a) ! { dg-error "shall not have codimensions with deferred shape" }
+    integer :: a(:)[:]
+  end subroutine sub
+end subroutine test3
+
+
+subroutine test4()
+  integer, save :: i[*]
+  integer :: j
+  call foo(i)
+  call foo(j) ! { dg-error "must be a coarray" }
+contains
+  subroutine foo(a)
+    integer :: a[*]
+  end subroutine foo
+end subroutine test4
+
+
+subroutine allocateTest()
+  implicit none
+  real, allocatable, codimension[:,:] :: a,b,c
+  integer :: n, q
+  n = 1
+  q = 1
+  allocate(a[q,*]) ! { dg-error "Sorry" }
+  allocate(b[q,*]) ! { dg-error "Sorry" }
+  allocate(c[q,*]) ! { dg-error "Sorry" }
+end subroutine allocateTest
+
+
+subroutine testAlloc4()
+  implicit none
+  type co_double_3
+    double precision, allocatable :: array(:)
+  end type co_double_3
+  type(co_double_3),save, codimension[*] :: work
+  allocate(work%array(1))
+  print *, size(work%array)
+end subroutine testAlloc4
+
+subroutine test5()
+  implicit none
+  integer, save :: i[*]
+  print *, i[*] ! { dg-error "Coindex of codimension 1 must be a scalar" }
+end subroutine test5
+
diff --git a/gcc/testsuite/gfortran.dg/coarray_8.f90 b/gcc/testsuite/gfortran.dg/coarray_8.f90
new file mode 100644
index 000000000..6ceba8b9a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_8.f90
@@ -0,0 +1,191 @@
+! { dg-do compile }
+! { dg-options "-fmax-errors=1000 -fcoarray=single" }
+!
+! PR fortran/18918
+!
+! Coarray expressions.
+!
+module mod2
+  implicit none
+  type t
+    procedure(sub), pointer :: ppc
+  contains
+    procedure :: tbp => sub
+  end type t
+  type t2
+    class(t), allocatable :: poly
+  end type t2
+contains
+  subroutine sub(this)
+    class(t), intent(in) :: this
+  end subroutine sub
+end module mod2
+
+subroutine procTest(y,z)
+  use mod2
+  implicit none
+  type(t), save :: x[*]
+  type(t) :: y[*]
+  type(t2) :: z[*]
+
+  x%ppc => sub
+  call x%ppc() ! OK
+  call x%tbp() ! OK
+  call x[1]%tbp ! OK, not polymorphic
+  ! Invalid per C726
+  call x[1]%ppc ! { dg-error "Coindexed procedure-pointer component" }
+
+  y%ppc => sub
+  call y%ppc() ! OK
+  call y%tbp() ! OK
+  call y[1]%tbp ! OK, coindexed polymorphic object but not poly. subobj.
+  call y[1]%ppc ! { dg-error "Coindexed procedure-pointer component" }
+
+  ! Invalid per C1229
+  z%poly%ppc => sub
+  call z%poly%ppc() ! OK
+  call z%poly%tbp() ! OK
+  call z[1]%poly%tbp ! { dg-error "Polymorphic subobject of coindexed" }
+  call z[1]%poly%ppc ! { dg-error "Coindexed procedure-pointer component" }
+end subroutine procTest
+
+
+module m
+  type t1
+    integer, pointer :: p
+  end type t1
+  type t2
+    integer :: i
+  end type t2
+  type t
+    integer, allocatable :: a[:]
+    type(t1), allocatable :: b[:]
+    type(t2), allocatable :: c[:]
+  end type t
+contains
+  pure subroutine p2(x)
+   integer, intent(inout) :: x
+  end subroutine p2
+  pure subroutine p3(x)
+   integer, pointer :: x
+  end subroutine p3
+  pure subroutine p1(x)
+    type(t), intent(inout) :: x
+    integer, target :: tgt1
+    x%a = 5
+    x%a[6] = 9 ! { dg-error "Assignment to coindexed variable" }
+    x%b%p => tgt1
+    x%b[1]%p => tgt1 ! { dg-error "shall not have a coindex" }
+    x%b%p => x%b[1]%p ! { dg-error "shall not have a coindex" }
+    x%b = t1(x%b[1]%p) ! { dg-error "Coindexed expression to pointer component" }
+    x%b = x%b[1] ! { dg-error "derived type variable with a POINTER component in a PURE" }
+    call p2 (x%c[1]%i) ! { dg-error "Coindexed actual argument" }
+    call p3 (x%b[1]%p) ! { dg-error "to pointer dummy" }
+  end subroutine p1
+  subroutine nonPtr()
+    type(t1), save :: a[*]
+    type(t2), save :: b[*]
+    integer, target :: tgt1
+    a%p => tgt1
+    a[1]%p => tgt1 ! { dg-error "shall not have a coindex" }
+    a%p => a[2]%p ! { dg-error "shall not have a coindex" }
+    a = t1(a[1]%p) ! { dg-error "Coindexed expression to pointer component" }
+    call p2 (b[1]%i) ! OK
+    call p2 (a[1]%p) ! OK - pointer target and not pointer
+  end subroutine nonPtr
+end module m
+
+
+module mmm3
+ type t
+   integer, allocatable :: a(:)
+ end type t
+contains
+  subroutine assign(x)
+    type(t) :: x[*]
+    allocate(x%a(3))
+    x%a = [ 1, 2, 3]
+    x[1]%a = [ 1, 2, 3] ! OK - if shapes are the same, otherwise wrong
+                        ! (no reallocate on assignment)
+  end subroutine assign
+  subroutine assign2(x,y)
+    type(t),allocatable :: x[:]
+    type(t) :: y
+    x = y
+    x[1] = y ! { dg-error "must not be have an allocatable ultimate component" }
+  end subroutine assign2
+end module mmm3
+
+
+module mmm4
+  implicit none
+contains
+  subroutine t1(x)
+    integer :: x(1)
+  end subroutine t1
+  subroutine t3(x)
+    character :: x(*)
+  end subroutine t3
+  subroutine t2()
+    integer, save :: x[*]
+    integer, save :: y(1)[*]
+    character(len=20), save :: z[*]
+
+    call t1(x) ! { dg-error "Rank mismatch" }
+    call t1(x[1]) ! { dg-error "Rank mismatch" }
+
+    call t1(y(1)) ! OK
+    call t1(y(1)[1]) ! { dg-error "Rank mismatch" }
+
+    call t3(z) !  OK
+    call t3(z[1]) ! { dg-error "Rank mismatch" }
+  end subroutine t2
+end module mmm4
+
+
+subroutine tfgh()
+  integer :: i(2)
+  DATA i/(i, i=1,2)/ ! { dg-error "Expected PARAMETER symbol" }
+  do i = 1, 5 ! { dg-error "cannot be a sub-component" }
+  end do ! { dg-error "Expecting END SUBROUTINE" }
+end subroutine tfgh
+
+subroutine tfgh2()
+  integer, save :: x[*]
+  integer :: i(2)
+  DATA i/(x, x=1,2)/ ! { dg-error "Expected PARAMETER symbol" }
+  do x = 1, 5 ! { dg-error "cannot be a coarray" }
+  end do ! { dg-error "Expecting END SUBROUTINE" }
+end subroutine tfgh2
+
+
+subroutine f4f4()
+  type t
+    procedure(), pointer, nopass :: ppt => null()
+  end type t
+  external foo
+  type(t), save :: x[*]
+  x%ppt => foo
+  x[1]%ppt => foo ! { dg-error "shall not have a coindex" }
+end subroutine f4f4
+
+
+subroutine corank()
+  integer, allocatable :: a[:,:]
+  call one(a) ! OK
+  call two(a) !  { dg-error "Corank mismatch in argument" }
+contains
+  subroutine one(x)
+    integer :: x[*]
+  end subroutine one
+  subroutine two(x)
+    integer, allocatable :: x[:]
+  end subroutine two
+end subroutine corank
+
+subroutine assign42()
+  integer, allocatable :: z(:)[:]
+  z(:)[1] = z
+end subroutine assign42
+
+! { dg-final { cleanup-modules "mod2 m mmm3 mmm4" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_9.f90 b/gcc/testsuite/gfortran.dg/coarray_9.f90
new file mode 100644
index 000000000..cdfb4dc85
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_9.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+!
+! PR fortran/18918
+!
+! Check for error if no -fcoarray= option has been given
+!
+
+integer :: a
+integer :: b[*] ! { dg-error "Coarrays disabled" }
+
+error stop "Error"
+sync all !  "Coarrays disabled"  (but error above is fatal)
+
+critical ! "Coarrays disabled"  (but error above is fatal)
+
+end critical ! "Expecting END PROGRAM statement"  (but error above is fatal)
+
+end
diff --git a/gcc/testsuite/gfortran.dg/com_block_driver.f90 b/gcc/testsuite/gfortran.dg/com_block_driver.f90
new file mode 100644
index 000000000..691a40fe5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/com_block_driver.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+module myComModule
+  use, intrinsic :: iso_c_binding
+
+  common /COM2/ R2, S2
+  real(c_double) :: r2
+  real(c_double) :: s2 
+  bind(c) :: /COM2/
+
+end module myComModule
+
+module comBlockTests
+  use, intrinsic :: iso_c_binding
+  use myComModule
+
+  implicit none
+
+  common /COM/ R, S
+  real(c_double) :: r
+  real(c_double) :: s 
+  bind(c) :: /COM/
+
+  contains
+
+  subroutine testTypes()
+    implicit none
+  end subroutine testTypes
+end module comBlockTests
+
+program comBlockDriver
+  use comBlockTests
+  
+  call testTypes()
+end program comBlockDriver
+
+! { dg-final { cleanup-modules "mycommodule comblocktests" } }
diff --git a/gcc/testsuite/gfortran.dg/comma.f b/gcc/testsuite/gfortran.dg/comma.f
new file mode 100644
index 000000000..08c451795
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/comma.f
@@ -0,0 +1,19 @@
+! { dg-do run { target fd_truncate } }
+! PR25419 Default input with commas.
+! Derived from example given in PR.
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org> 
+      stuff = 1
+      stuff2 = 2
+      write(11,'(a)') ",,"
+      rewind(11)
+      read(11,*)stuff, stuff2
+      if (stuff.ne.1.0) call abort()
+      if (stuff2.ne.2.0) call abort()
+      rewind (11)
+      write(11,'(a)') ","
+      rewind(11)
+      read(11,*)stuff
+      if (stuff.ne.1.0) call abort()
+      close(11, status='delete')
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/comma_format_extension_1.f b/gcc/testsuite/gfortran.dg/comma_format_extension_1.f
new file mode 100644
index 000000000..a3a5a98f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/comma_format_extension_1.f
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "" }
+! test that the extension for a missing comma is accepted
+
+      subroutine mysub
+      dimension ibar(5)
+      write (3,1001) ( ibar(m), m = 1, 5 )
+
+ 1001 format (/5x,' ',i4' '/ )
+      return
+      end
diff --git a/gcc/testsuite/gfortran.dg/comma_format_extension_2.f b/gcc/testsuite/gfortran.dg/comma_format_extension_2.f
new file mode 100644
index 000000000..7eb17b584
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/comma_format_extension_2.f
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! test that the extension for a missing comma is accepted
+
+      subroutine mysub
+      dimension ibar(5)
+      write (3,1001) ( ibar(m), m = 1, 5 )
+
+ 1001 format (/5x,' ',i4' '/ ) ! { dg-warning "Missing comma" }
+      return
+      end
diff --git a/gcc/testsuite/gfortran.dg/comma_format_extension_3.f b/gcc/testsuite/gfortran.dg/comma_format_extension_3.f
new file mode 100644
index 000000000..776254e29
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/comma_format_extension_3.f
@@ -0,0 +1,16 @@
+! PR libfortran/15332 and PR fortran/13257
+! We used to accept this as an extension but
+! did do the correct thing at runtime.
+! Note the missing , before i1 in the format.
+! { dg-do run }
+! { dg-options "" }
+      character*12 c
+
+      write (c,100) 0, 1
+      if (c .ne. 'i = 0, j = 1') call abort
+      
+      write (c,100) 0
+      if (c .ne. 'i = 0       ') call abort
+
+ 100  format ('i = 'i1,:,', j = ',i1)
+      end
diff --git a/gcc/testsuite/gfortran.dg/comma_format_extension_4.f b/gcc/testsuite/gfortran.dg/comma_format_extension_4.f
new file mode 100644
index 000000000..3053d3fb1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/comma_format_extension_4.f
@@ -0,0 +1,10 @@
+! PR fortran/13257
+! Note the missing , before i1 in the format.
+! { dg-do run }
+! { dg-options "" }
+      character*6 c
+      write (c,1001) 1
+      if (c .ne. '    1 ') call abort
+
+ 1001 format (' ',i4' ')
+      end
diff --git a/gcc/testsuite/gfortran.dg/common_1.f90 b/gcc/testsuite/gfortran.dg/common_1.f90
new file mode 100644
index 000000000..6ee146a5e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_1.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! tests various allowed variants of the common statement
+! inspired by PR 18869
+
+! blank common block
+      common x
+      common y, z
+      common // xx
+
+! one named common block on a line
+      common /a/ e
+      
+! appending to a common block
+      common /a/ g
+
+! several named common blocks on a line
+      common /foo/ a, /bar/ b      ! note 'a' is also the name of the 
+                                   ! above common block
+      common /baz/ c /foobar/ d, /bazbar/ f
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/common_10.f90 b/gcc/testsuite/gfortran.dg/common_10.f90
new file mode 100644
index 000000000..cec443a5c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_10.f90
@@ -0,0 +1,55 @@
+use iso_c_binding
+implicit none
+
+type, bind(C) :: mytype1
+  integer(c_int) :: x
+  real(c_float)    :: y
+end type mytype1
+
+type mytype2
+  sequence
+  integer :: x
+  real    :: y
+end type mytype2
+
+type mytype3
+  integer :: x
+  real    :: y
+end type mytype3
+
+type mytype4
+  sequence
+  integer, allocatable, dimension(:) :: x
+end type mytype4
+
+type mytype5
+  sequence
+  integer, pointer :: x
+  integer :: y
+end type mytype5
+
+type mytype6
+  sequence
+  type(mytype5) :: t
+end type mytype6
+
+type mytype7
+  sequence
+  type(mytype4) :: t
+end type mytype7
+
+common /a/ t1
+common /b/ t2
+common /c/ t3  ! { dg-error "has neither the SEQUENCE nor the BIND.C. attribute" }
+common /d/ t4  ! { dg-error "has an ultimate component that is allocatable" }
+common /e/ t5
+common /f/ t6
+common /f/ t7  ! { dg-error "has an ultimate component that is allocatable" }
+type(mytype1) :: t1
+type(mytype2) :: t2
+type(mytype3) :: t3
+type(mytype4) :: t4
+type(mytype5) :: t5
+type(mytype6) :: t6
+type(mytype7) :: t7
+end
diff --git a/gcc/testsuite/gfortran.dg/common_11.f90 b/gcc/testsuite/gfortran.dg/common_11.f90
new file mode 100644
index 000000000..ec01515cb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_11.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+!
+! PR fortran/34658
+!
+! Check for more COMMON constrains
+!
+block data
+  implicit none
+  integer :: x, a  ! { dg-warning "Initialized variable 'a' at .1. is in a blank COMMON" }
+  integer :: y = 5, b = 5 ! { dg-warning "Initialized variable 'b' at .1. is in a blank COMMON" }
+  data x/5/, a/5/
+  common // a, b
+  common /a/ x, y
+end block data
+
+subroutine foo()
+  implicit none
+  type t
+    sequence
+    integer :: i = 5
+  end type t
+  type(t) x ! { dg-error "may not have default initializer" }
+  common // x
+end subroutine foo
+
+program test
+  implicit none
+  common /a/ I ! { dg-warning "in COMMON but only in BLOCK DATA initialization" }
+  integer :: I = 43
+end program test
diff --git a/gcc/testsuite/gfortran.dg/common_12.f90 b/gcc/testsuite/gfortran.dg/common_12.f90
new file mode 100644
index 000000000..0eea80f03
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_12.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+!
+! PR fortran/39594
+!
+! Contributed by Peter Knowles and reduced by Jakub Jelinek.
+!
+module pr39594
+  implicit double precision(z)
+  common /z/ z0,z1,z2,z3,z4,z5,z6,z7
+contains
+  subroutine foo
+    implicit double precision(z)
+    common /z/ z0,z1,z2,z3,z4,z5,z6,z7
+    call bar(z0)
+  end subroutine foo
+end module
+
+! { dg-final { cleanup-modules "pr39594" } }
diff --git a/gcc/testsuite/gfortran.dg/common_16.f90 b/gcc/testsuite/gfortran.dg/common_16.f90
new file mode 100644
index 000000000..3314e80ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_16.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-pedantic -mdalign" { target sh*-*-* } }
+!
+! PR fortran/50273
+!
+subroutine test()
+   character :: a
+   integer   :: b
+   character :: c
+   common /global_var/ a, b, c ! { dg-warning "Padding of 3 bytes required before 'b' in COMMON" }
+   print *, a, b, c
+end subroutine test
diff --git a/gcc/testsuite/gfortran.dg/common_2.f90 b/gcc/testsuite/gfortran.dg/common_2.f90
new file mode 100644
index 000000000..661e58205
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_2.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! The equivalence was causing us to miss out c when laying out the common
+! block.
+program common_2
+  common /block/ a, b, c, d
+  integer a, b, c, d, n
+  dimension n(4)
+  equivalence (a, n(1))
+  equivalence (c, n(3))
+  a = 1
+  b = 2
+  c = 3
+  d = 4
+  if (any (n .ne. (/1, 2, 3, 4/))) call abort
+end program
diff --git a/gcc/testsuite/gfortran.dg/common_3.f90 b/gcc/testsuite/gfortran.dg/common_3.f90
new file mode 100644
index 000000000..818738e45
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_3.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! Check that equivalences match common block layout.
+program common_3
+  common /block/ a, b, c, d ! { dg-error "not match ordering" "" }
+  integer a, b, c, d, n
+  dimension n(4)
+  equivalence (a, n(1))
+  equivalence (c, n(4))
+end program
diff --git a/gcc/testsuite/gfortran.dg/common_4.f90 b/gcc/testsuite/gfortran.dg/common_4.f90
new file mode 100644
index 000000000..cde2e27a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_4.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! Suppress warnings about misaligned common blocks.
+! { dg-options "-w" }
+! Check misaligned common blocks.
+program prog
+  common /block/ a, b, c
+  integer(kind=1) a
+  integer b, c
+  a = 1
+  b = HUGE(b)
+  c = 2
+  call foo
+end program
+subroutine foo
+  common /block/ a, b, c
+  integer(kind=1) a
+  integer b, c
+  if (a .ne. 1 .or. b .ne. HUGE(b) .or. c .ne. 2) call abort
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/common_5.f b/gcc/testsuite/gfortran.dg/common_5.f
new file mode 100644
index 000000000..0f04b1360
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_5.f
@@ -0,0 +1,11 @@
+C { dg-do compile }
+C { dg-options "-pedantic-errors -mdalign" { target sh*-*-* } }
+C PR 20059
+C Check that the warning for padding works correctly.
+      SUBROUTINE PLOTZ
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      COMMON /CCPOOL/ RMIN,RMAX,ZMIN,ZMAX,IMIN,JMIN,IMAX,JMAX,NFLOP, ! { dg-warning "Padding" }
+     $ HTP
+C
+        RETURN
+      END
diff --git a/gcc/testsuite/gfortran.dg/common_6.f90 b/gcc/testsuite/gfortran.dg/common_6.f90
new file mode 100644
index 000000000..8cef179e7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_6.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! PR 23765 : We used to incorrectly accept common blocks with no symbols
+common          ! { dg-error "Syntax error" }
+common //       ! { dg-error "Syntax error" }
+common /a/      ! { dg-error "Syntax error" }
+common /b/x/c/  ! { dg-error "Syntax error" }
+common y/d/     ! { dg-error "Syntax error" }
+common /e//f/   ! { dg-error "Syntax error" }
+common ///g/    ! { dg-error "Syntax error" }
+end
diff --git a/gcc/testsuite/gfortran.dg/common_7.f90 b/gcc/testsuite/gfortran.dg/common_7.f90
new file mode 100644
index 000000000..2736cad6d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_7.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! F2003: 16.2.1
+! "A name that identifies a common block in a scoping unit shall not be used 
+!  to identify a constant or an intrinsic procedure in that scoping unit."
+!
+subroutine x134
+ INTEGER, PARAMETER ::  C1=1  ! { dg-error "COMMON block 'c1' at \\(1\\) is used as PARAMETER" } 
+ COMMON /C1/ I  ! { dg-error "COMMON block 'c1' at \\(1\\) is used as PARAMETER" } 
+end subroutine
+end
diff --git a/gcc/testsuite/gfortran.dg/common_8.f90 b/gcc/testsuite/gfortran.dg/common_8.f90
new file mode 100644
index 000000000..ada4408f5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_8.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! PR fortran/25062
+!
+! F2003: 16.2.1
+! "A name that identifies a common block in a scoping unit shall not be used 
+!  to identify a constant or an intrinsic procedure in that scoping unit."
+!
+subroutine try
+ implicit none
+ COMMON /s/ J
+ COMMON /bar/ I
+ INTEGER I, J
+ real s, x
+ s(x)=sin(x)
+ print *, s(5.0)
+ call bar()
+contains
+ subroutine bar
+   print *, 'Hello world'
+ end subroutine bar
+
+end subroutine try
+
+program test
+ implicit none
+ COMMON /abs/ J ! { dg-error "is also an intrinsic procedure" }
+ intrinsic :: abs
+ INTEGER J
+ external try
+ call try
+end program test
diff --git a/gcc/testsuite/gfortran.dg/common_9.f90 b/gcc/testsuite/gfortran.dg/common_9.f90
new file mode 100644
index 000000000..a567eb386
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_9.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! PR fortran/25062
+!
+! F95: 14.1.2.1:
+! "A common block name in a scoping unit also may be the name of any local
+!  entity other than a named constant, intrinsic procedure, or a local variable
+!  that is also an external function in a function subprogram."
+!
+! F2003: 16.2.1
+! "A name that identifies a common block in a scoping unit shall not be used 
+!  to identify a constant or an intrinsic procedure in that scoping unit. If
+!  a local identifier is also the name of a common block, the appearance of
+!  that name in any context other than as a common block name in a COMMON
+!  or SAVE statement is an appearance of the local identifier."
+!
+function func1() result(res)
+  implicit none
+  real res, r
+  common /res/ r ! { dg-error "is also a function result" }
+end function func1
+end
diff --git a/gcc/testsuite/gfortran.dg/common_align_1.f90 b/gcc/testsuite/gfortran.dg/common_align_1.f90
new file mode 100644
index 000000000..4a6803e96
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_align_1.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options "-fno-align-commons" }
+
+! PR fortran/37486
+!
+! Test for -fno-align-commons.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>.
+
+subroutine one()
+  integer :: i
+  common i
+  if (i/=5) call abort()
+end subroutine one
+
+program test
+integer :: i
+real(8) :: r8
+common i, r8 
+i = 5
+call one()
+end program test
diff --git a/gcc/testsuite/gfortran.dg/common_align_2.f90 b/gcc/testsuite/gfortran.dg/common_align_2.f90
new file mode 100644
index 000000000..09dd3e1fa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_align_2.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-options "-pedantic-errors -mdalign" { target sh*-*-* } }
+! Tests the fix for PR37614, in which the alignement of commons followed
+! g77 rather than the standard or other compilers.
+!
+! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+subroutine foo (z)
+  real(8) x, y, z
+  common i(8)
+  equivalence (x, i(3)),(y,i(7))
+  if ((i(1) .ne. 42) .or. (i(5) .ne. 43)) call abort
+  if ((i(2) .ne. 0) .or. (i(2) .ne. 0)) call abort
+  if ((x .ne. z) .or. (y .ne. z)) call abort
+end subroutine
+
+subroutine bar
+  common i(8)
+  i = 0
+end subroutine
+
+  real(8) x, y
+  common i, x, j, y ! { dg-warning "Padding" }
+  call bar
+  i = 42
+  j = 43
+  x = atan (1.0)*4.0
+  y = x
+  call foo (x)
+end
+
diff --git a/gcc/testsuite/gfortran.dg/common_equivalence_1.f b/gcc/testsuite/gfortran.dg/common_equivalence_1.f
new file mode 100644
index 000000000..2f15b93a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_equivalence_1.f
@@ -0,0 +1,21 @@
+c { dg-do run }
+c This program tests the fix for PR22304.
+c
+c provided by Paul Thomas - pault@gcc.gnu.org
+c
+      integer a(2), b, c
+      COMMON /foo/ a
+      EQUIVALENCE (a(1),b), (c, a(2))
+      a(1) = 101
+      a(2) = 102
+      call bar ()
+      END
+
+      subroutine bar ()
+      integer a(2), b, c, d
+      COMMON /foo/ a
+      EQUIVALENCE (a(1),b), (c, a(2))
+      if (b.ne.101) call abort ()
+      if (c.ne.102) call abort ()
+      END
+
diff --git a/gcc/testsuite/gfortran.dg/common_equivalence_2.f b/gcc/testsuite/gfortran.dg/common_equivalence_2.f
new file mode 100644
index 000000000..be25fcd3d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_equivalence_2.f
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! PR fortran/18870
+!
+      program main
+      common /foo/ a
+      common /bar/ b
+      equivalence (a,c)
+      equivalence (b,c) ! { dg-error "indirectly overlap COMMON" }
+      c=3.
+      print *,a
+      print *,b
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/common_equivalence_3.f b/gcc/testsuite/gfortran.dg/common_equivalence_3.f
new file mode 100644
index 000000000..6acd46aa3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_equivalence_3.f
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! PR fortran/18870
+!
+      program main
+      equivalence (a,c)
+      equivalence (b,c)
+      common /foo/ a
+      common /bar/ b ! { dg-error "equivalenced to another COMMON" }
+      c=3.
+      print *,a
+      print *,b
+      end
+
+
diff --git a/gcc/testsuite/gfortran.dg/common_errors_1.f90 b/gcc/testsuite/gfortran.dg/common_errors_1.f90
new file mode 100644
index 000000000..0d4e1beb3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_errors_1.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! Tests a number of error messages relating to derived type objects
+! in common blocks.  Originally due to PR 33198
+
+subroutine one
+type a
+   sequence
+   integer :: i = 1
+end type a
+type(a) :: t ! { dg-error "Derived type variable .t. in COMMON at ... may not have default initializer" }
+common /c/ t
+end
+
+subroutine first
+type a
+   integer :: i
+   integer :: j
+end type a
+type(a) :: t  ! { dg-error "Derived type variable .t. in COMMON at ... has neither the SEQUENCE nor the BIND.C. attribute" }
+common /c/ t
+end
+
+subroutine prime
+type a
+   sequence
+   integer, allocatable :: i(:)
+   integer :: j
+end type a
+type(a) :: t  ! { dg-error "Derived type variable .t. in COMMON at ... has an ultimate component that is allocatable" }
+common /c/ t
+end
+
+subroutine source
+parameter(x=0.) ! { dg-error "COMMON block .x. at ... is used as PARAMETER at ..." }
+common /x/ i  ! { dg-error "COMMON block .x. at ... is used as PARAMETER at ..." }
+intrinsic sin
+common /sin/ j ! { dg-error "COMMON block .sin. at ... is also an intrinsic procedure" }
+end subroutine source
diff --git a/gcc/testsuite/gfortran.dg/common_pointer_1.f90 b/gcc/testsuite/gfortran.dg/common_pointer_1.f90
new file mode 100644
index 000000000..e0f90ca72
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_pointer_1.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! PR13415
+! Test pointer variables in common blocks.
+
+subroutine test
+  implicit none
+  real, pointer :: p(:), q
+  common /block/ p, q
+
+  if (any (p .ne. (/1.0, 2.0/)) .or. (q .ne. 42.0)) call abort ()
+end subroutine
+
+program common_pointer_1
+  implicit none
+  real, target :: a(2), b
+  real, pointer :: x(:), y
+  common /block/ x, y
+  
+  a = (/1.0, 2.0/)
+  b = 42.0
+  x=>a
+  y=>b
+  call test
+end program
diff --git a/gcc/testsuite/gfortran.dg/common_resize_1.f b/gcc/testsuite/gfortran.dg/common_resize_1.f
new file mode 100644
index 000000000..a94c1bc0c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_resize_1.f
@@ -0,0 +1,177 @@
+c { dg-do run }
+c { dg-options "-std=legacy" }
+c
+c Tests the fix for PR32302, in which the resizing of 'aux32' would cause
+c misalignment for double precision types and a wrong result would be obtained

+c at any level of optimization except none.
+c
+c Contributed by Dale Ranta <dir@lanl.gov> 
+c
+      subroutine unpki(ixp,nwcon,nmel)

+      parameter(lnv=32)

+      implicit double precision (a-h,o-z)                                    dp

+c

+c     unpack connection data

+c

+      common/aux32/kka(lnv),kkb(lnv),kkc(lnv),

+     1 kk1(lnv),kk2(lnv),kk3(lnv),dxy(lnv),

+     2 dyx(lnv),dyz(lnv),dzy(lnv),dzx(lnv),

+     3 dxz(lnv),vx17(lnv),vx28(lnv),vx35(lnv),

+     4 vx46(lnv),vy17(lnv),vy28(lnv),

+     5 vy35(lnv),vy46(lnv),vz17(lnv),vz28(lnv),vz35(lnv),vz46(lnv)

+      common/aux33/ix1(lnv),ix2(lnv),ix3(lnv),ix4(lnv),ix5(lnv),

+     1             ix6(lnv),ix7(lnv),ix8(lnv),mxt(lnv)

+      dimension ixp(nwcon,*)

+c

+      return

+      end

+      subroutine prtal

+      parameter(lnv=32)

+      implicit double precision (a-h,o-z)                                    dp

+      common/aux8/

+     & x1(lnv),x2(lnv),x3(lnv),x4(lnv),

+     & x5(lnv),x6(lnv),x7(lnv),x8(lnv),

+     & y1(lnv),y2(lnv),y3(lnv),y4(lnv),

+     & y5(lnv),y6(lnv),y7(lnv),y8(lnv),

+     & z1(lnv),z2(lnv),z3(lnv),z4(lnv),

+     & z5(lnv),z6(lnv),z7(lnv),z8(lnv)

+      common/aux9/vlrho(lnv),det(lnv)

+      common/aux10/

+     1 px1(lnv),px2(lnv),px3(lnv),px4(lnv),

+     & px5(lnv),px6(lnv),px7(lnv),px8(lnv),

+     2 py1(lnv),py2(lnv),py3(lnv),py4(lnv),

+     & py5(lnv),py6(lnv),py7(lnv),py8(lnv),

+     3 pz1(lnv),pz2(lnv),pz3(lnv),pz4(lnv),

+     & pz5(lnv),pz6(lnv),pz7(lnv),pz8(lnv),

+     4 vx1(lnv),vx2(lnv),vx3(lnv),vx4(lnv),

+     5 vx5(lnv),vx6(lnv),vx7(lnv),vx8(lnv),

+     6 vy1(lnv),vy2(lnv),vy3(lnv),vy4(lnv),

+     7 vy5(lnv),vy6(lnv),vy7(lnv),vy8(lnv),

+     8 vz1(lnv),vz2(lnv),vz3(lnv),vz4(lnv),

+     9 vz5(lnv),vz6(lnv),vz7(lnv),vz8(lnv)

+                       ! XFAILed here and below because of PRs 45045 and 45044

+      common/aux32/    ! { dg-warning "shall be of the same size" "" { xfail *-*-*} }

+     a a17(lnv),a28(lnv),dett(lnv),

+     1 aj1(lnv),aj2(lnv),aj3(lnv),aj4(lnv),

+     2 aj5(lnv),aj6(lnv),aj7(lnv),aj8(lnv),

+     3 aj9(lnv),x17(lnv),x28(lnv),x35(lnv),

+     4 x46(lnv),y17(lnv),y28(lnv),y35(lnv),

+     5 y46(lnv),z17(lnv),z28(lnv),z35(lnv),z46(lnv)

+      common/aux33/    ! { dg-warning "shall be of the same size" "" { xfail *-*-*} }

+     a ix1(lnv),ix2(lnv),ix3(lnv),ix4(lnv),ix5(lnv),

+     1             ix6(lnv),ix7(lnv),ix8(lnv),mxt(lnv),nmel

+      common/aux36/lft,llt

+      common/failu/sieu(lnv),failu(lnv)

+      common/sand1/ihf,ibemf,ishlf,itshf

+      dimension aj5968(lnv),aj6749(lnv),aj4857(lnv),aji1(lnv),aji2(lnv),

+     1          aji3(lnv),aji4(lnv),aji5(lnv),

+     1          aji6(lnv),aji7(lnv),aji8(lnv),aji9(lnv),aj12(lnv),

+     2          aj45(lnv),aj78(lnv),b17(lnv),b28(lnv),c17(lnv),c28(lnv)

+c

+      equivalence (x17,aj5968),(x28,aj6749),(x35,aj4857),(x46,aji1),

+     1 (y17,aji2),(y28,aji3),(y35,aji4),(y46,aji5),(z17,aji6),

+     2 (z28,aji7),(z35,aji8),(z46,aji9),(aj1,aj12),(aj2,aj45),

+     3 (aj3,aj78),(px1,b17),(px2,b28),(px3,c17),(px4,c28)

+      data o64th/0.0156250/

+c

+c     jacobian matrix

+c

+      do 10 i=lft,llt

+      x17(i)=x7(i)-x1(i)

+      x28(i)=x8(i)-x2(i)

+      x35(i)=x5(i)-x3(i)

+      x46(i)=x6(i)-x4(i)

+      y17(i)=y7(i)-y1(i)

+      y28(i)=y8(i)-y2(i)

+      y35(i)=y5(i)-y3(i)

+      y46(i)=y6(i)-y4(i)

+      z17(i)=z7(i)-z1(i)

+      z28(i)=z8(i)-z2(i)

+      z35(i)=z5(i)-z3(i)

+   10 z46(i)=z6(i)-z4(i)

+      do 20 i=lft,llt

+      aj1(i)=x17(i)+x28(i)-x35(i)-x46(i)

+      aj2(i)=y17(i)+y28(i)-y35(i)-y46(i)

+      aj3(i)=z17(i)+z28(i)-z35(i)-z46(i)

+      a17(i)=x17(i)+x46(i)

+      a28(i)=x28(i)+x35(i)

+      b17(i)=y17(i)+y46(i)

+      b28(i)=y28(i)+y35(i)

+      c17(i)=z17(i)+z46(i)

+   20 c28(i)=z28(i)+z35(i)

+      do 30 i=lft,llt

+      aj4(i)=a17(i)+a28(i)

+      aj5(i)=b17(i)+b28(i)

+      aj6(i)=c17(i)+c28(i)

+      aj7(i)=a17(i)-a28(i)

+      aj8(i)=b17(i)-b28(i)

+   30 aj9(i)=c17(i)-c28(i)

+c

+c     jacobian

+c

+      do 40 i=lft,llt

+      aj5968(i)=aj5(i)*aj9(i)-aj6(i)*aj8(i)

+      aj6749(i)=aj6(i)*aj7(i)-aj4(i)*aj9(i)

+   40 aj4857(i)=aj4(i)*aj8(i)-aj5(i)*aj7(i)

+      if (ihf.ne.1) then

+      do 50 i=lft,llt

+   50 det(i)=o64th*(aj1(i)*aj5968(i)+aj2(i)*aj6749(i)+aj3(i)*aj4857(i))

+      else

+      do 55 i=lft,llt

+      det(i)=o64th*(aj1(i)*aj5968(i)+aj2(i)*aj6749(i)+aj3(i)*aj4857(i))

+     1       *failu(i) + (1. - failu(i))

+   55 continue

+      endif

+      do 60 i=lft,llt

+   60 dett(i)=o64th/det(i)

+

+      if (det(lft) .ne. 1d0) call abort ()
+      if (det(llt) .ne. 1d0) call abort ()

+

+      return

+c

+      end

+      program main

+      parameter(lnv=32)

+      implicit double precision (a-h,o-z)                                    dp

+      common/aux8/

+     & x1(lnv),x2(lnv),x3(lnv),x4(lnv),

+     & x5(lnv),x6(lnv),x7(lnv),x8(lnv),

+     & y1(lnv),y2(lnv),y3(lnv),y4(lnv),

+     & y5(lnv),y6(lnv),y7(lnv),y8(lnv),

+     & z1(lnv),z2(lnv),z3(lnv),z4(lnv),

+     & z5(lnv),z6(lnv),z7(lnv),z8(lnv)

+      common/aux36/lft,llt

+      common/sand1/ihf,ibemf,ishlf,itshf

+      lft=1

+      llt=1

+      x1(1)=0

+      x2(1)=1

+      x3(1)=1

+      x4(1)=0

+      x5(1)=0

+      x6(1)=1

+      x7(1)=1

+      x8(1)=0

+

+      y1(1)=0

+      y2(1)=0

+      y3(1)=1

+      y4(1)=1

+      y5(1)=0

+      y6(1)=0

+      y7(1)=1

+      y8(1)=1

+

+      z1(1)=0

+      z2(1)=0

+      z3(1)=0

+      z4(1)=0

+      z5(1)=1

+      z6(1)=1

+      z7(1)=1

+      z8(1)=1

+      call prtal

+      stop

+      end

+

diff --git a/gcc/testsuite/gfortran.dg/compiler-directive_1.f90 b/gcc/testsuite/gfortran.dg/compiler-directive_1.f90
new file mode 100644
index 000000000..75f28dcc9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/compiler-directive_1.f90
@@ -0,0 +1,48 @@
+! { dg-do compile }
+!
+! PR fortran/34112
+!
+! Check for calling convention consitency
+! in procedure-pointer assignments.
+
+program test
+  interface
+    subroutine sub1()
+    end subroutine sub1
+    subroutine sub2()
+      !GCC$ ATTRIBUTES CDECL :: sub2
+    end subroutine sub2
+    subroutine sub3()
+      !GCC$ ATTRIBUTES STDCALL :: sub3
+    end subroutine sub3
+    subroutine sub4()
+!GCC$ ATTRIBUTES FASTCALL :: sub4
+    end subroutine sub4
+  end interface
+
+  !gcc$ attributes cdecl :: cdecl
+  !gcc$ attributes stdcall :: stdcall
+  procedure(), pointer :: ptr
+  procedure(), pointer :: cdecl
+  procedure(), pointer :: stdcall
+  procedure(), pointer :: fastcall
+  !gcc$ attributes fastcall :: fastcall
+
+  ! Valid:
+  ptr => sub1
+  cdecl => sub2
+  stdcall => sub3
+  fastcall => sub4
+
+  ! Invalid:
+  ptr => sub3 ! { dg-error "mismatch in the calling convention" }
+  ptr => sub4 ! { dg-error "mismatch in the calling convention" }
+  cdecl => sub3 ! { dg-error "mismatch in the calling convention" }
+  cdecl => sub4 ! { dg-error "mismatch in the calling convention" }
+  stdcall => sub1 ! { dg-error "mismatch in the calling convention" }
+  stdcall => sub2 ! { dg-error "mismatch in the calling convention" }
+  stdcall => sub4 ! { dg-error "mismatch in the calling convention" }
+  fastcall => sub1 ! { dg-error "mismatch in the calling convention" }
+  fastcall => sub2 ! { dg-error "mismatch in the calling convention" }
+  fastcall => sub3 ! { dg-error "mismatch in the calling convention" }
+end program
diff --git a/gcc/testsuite/gfortran.dg/compiler-directive_2.f b/gcc/testsuite/gfortran.dg/compiler-directive_2.f
new file mode 100644
index 000000000..fcb1657b4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/compiler-directive_2.f
@@ -0,0 +1,11 @@
+! { dg-do compile { target i?86-*-* x86_64-*-* } }
+! { dg-require-effective-target ilp32 }
+!
+! PR fortran/34112
+!
+! Check for calling convention consitency
+! in procedure-pointer assignments.
+!
+      subroutine test() ! { dg-error "fastcall and stdcall attributes are not compatible" }
+cGCC$ attributes stdcall, fastcall::test
+      end subroutine test
diff --git a/gcc/testsuite/gfortran.dg/complex_int_1.f90 b/gcc/testsuite/gfortran.dg/complex_int_1.f90
new file mode 100644
index 000000000..f287d8cd6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/complex_int_1.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! Complex constants with integer components should take ther kind from
+! the real typed component, or default complex type if both components have
+! integer type.
+program prog
+  call test1 ((1_8, 1.0_4))
+  call test2 ((1_8, 2_8))
+contains
+subroutine test1(x)
+  complex(4) :: x
+end subroutine
+subroutine test2(x)
+  complex :: x
+end subroutine
+end program
diff --git a/gcc/testsuite/gfortran.dg/complex_intrinsic_1.f90 b/gcc/testsuite/gfortran.dg/complex_intrinsic_1.f90
new file mode 100644
index 000000000..3c299151e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/complex_intrinsic_1.f90
@@ -0,0 +1,5 @@
+! Testcase for the COMPLEX intrinsic
+! { dg-do run }
+  if (complex(1_1, -1_2) /= complex(1.0_4, -1.0_8)) call abort
+  if (complex(1_4, -1.0) /= complex(1.0_4, -1_8)) call abort
+  end
diff --git a/gcc/testsuite/gfortran.dg/complex_intrinsic_2.f90 b/gcc/testsuite/gfortran.dg/complex_intrinsic_2.f90
new file mode 100644
index 000000000..1327e4a95
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/complex_intrinsic_2.f90
@@ -0,0 +1,7 @@
+! Testcase for the COMPLEX intrinsic
+! { dg-do compile }
+  complex c
+  c = complex(.true.,1.0) ! { dg-error "must be INTEGER or REAL" }
+  c = complex(1) ! { dg-error "Missing actual argument" }
+  c = complex(1,c) ! { dg-error "must be INTEGER or REAL" }
+  end
diff --git a/gcc/testsuite/gfortran.dg/complex_intrinsic_3.f90 b/gcc/testsuite/gfortran.dg/complex_intrinsic_3.f90
new file mode 100644
index 000000000..f0d12d6ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/complex_intrinsic_3.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+!
+! PR fortran/33197
+!
+! Fortran 2008 complex trigonometric functions: tan, cosh, sinh, tanh
+!
+implicit none
+real(4), parameter :: pi  = 2*acos(0.0_4)
+real(8), parameter :: pi8 = 2*acos(0.0_8)
+real(4), parameter :: eps  = 10*epsilon(0.0_4)
+real(8), parameter :: eps8 = 10*epsilon(0.0_8)
+complex(4), volatile :: z0_0  = cmplx(0.0_4, 0.0_4, kind=4)
+complex(4), volatile :: z1_1  = cmplx(1.0_4, 1.0_4, kind=4)
+complex(4), volatile :: zp_p  = cmplx(pi,    pi,    kind=4)
+complex(8), volatile :: z80_0 = cmplx(0.0_8, 0.0_8, kind=8)
+complex(8), volatile :: z81_1 = cmplx(1.0_8, 1.0_8, kind=8)
+complex(8), volatile :: z8p_p = cmplx(pi8,   pi8,   kind=8)
+
+if (abs(tan(z0_0)  - cmplx(0.0,0.0,4)) > eps) call abort()
+if (abs(tan(z1_1)  - cmplx(0.27175257,1.0839232,4)) > eps) call abort()
+if (abs(tan(z80_0) - cmplx(0.0_8,0.0_8,8)) > eps8) call abort()
+if (abs(tan(z81_1) - cmplx(0.27175258531951174_8,1.0839233273386946_8,8)) > eps8) call abort()
+
+if (abs(cosh(z0_0)  - cmplx(1.0,0.0,4)) > eps) call abort()
+if (abs(cosh(z1_1)  - cmplx(0.83372992,0.98889768,4)) > eps) call abort()
+if (abs(cosh(z80_0) - cmplx(1.0_8,0.0_8,8)) > eps8) call abort()
+if (abs(cosh(z81_1) - cmplx(0.83373002513114913_8,0.98889770576286506_8,8)) > eps8) call abort()
+
+if (abs(sinh(z0_0)  - cmplx(0.0,0.0,4)) > eps) call abort()
+if (abs(sinh(z1_1)  - cmplx(0.63496387,1.2984575,4)) > eps) call abort()
+if (abs(sinh(z80_0) - cmplx(0.0_8,0.0_8,8)) > eps8) call abort()
+if (abs(sinh(z81_1) - cmplx(0.63496391478473613_8,1.2984575814159773_8,8)) > eps8) call abort()
+
+if (abs(tanh(z0_0)  - cmplx(0.0,0.0,4)) > eps) call abort()
+if (abs(tanh(z1_1)  - cmplx(1.0839232,0.27175257,4)) > eps) call abort()
+if (abs(tanh(z80_0) - cmplx(0.0_8,0.0_8,8)) > eps8) call abort()
+if (abs(tanh(z81_1) - cmplx(1.0839233273386946_8,0.27175258531951174_8,8)) > eps8) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/complex_intrinsic_4.f90 b/gcc/testsuite/gfortran.dg/complex_intrinsic_4.f90
new file mode 100644
index 000000000..faef28f23
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/complex_intrinsic_4.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/33197
+!
+! Fortran 2008 complex trigonometric functions: tan, cosh, sinh, tanh
+!
+real :: r
+complex :: z
+r = -45.5
+r = sin(r)
+r = cos(r)
+r = tan(r)
+r = cosh(r)
+r = sinh(r)
+r = tanh(r)
+z = 4.0
+z = cos(z)
+z = sin(z)
+z = tan(z) ! { dg-error "Fortran 2008: COMPLEX argument" }
+z = cosh(z)! { dg-error "Fortran 2008: COMPLEX argument" }
+z = sinh(z)! { dg-error "Fortran 2008: COMPLEX argument" }
+z = tanh(z)! { dg-error "Fortran 2008: COMPLEX argument" }
+end
diff --git a/gcc/testsuite/gfortran.dg/complex_intrinsic_5.f90 b/gcc/testsuite/gfortran.dg/complex_intrinsic_5.f90
new file mode 100644
index 000000000..49b8eaaa6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/complex_intrinsic_5.f90
@@ -0,0 +1,221 @@
+! { dg-do run }
+!
+! PR fortran/33197
+!
+! Complex inverse trigonometric functions
+! and complex inverse hyperbolic functions
+!
+! Run-time evaluation check
+!
+module test
+  implicit none
+  real(4), parameter :: eps4 = epsilon(0.0_4)*4.0_4
+  real(8), parameter :: eps8 = epsilon(0.0_8)*2.0_8
+  interface check
+    procedure check4, check8
+  end interface check
+contains
+  SUBROUTINE check4(z, zref)
+    complex(4), intent(in) :: z, zref
+    if (    abs (real(z)-real(zref)) > eps4 &
+        .or.abs (aimag(z)-aimag(zref)) > eps4) then
+      print '(a,/,2((2g0," + I ",g0),/))', "check4:","   z=",z,'zref=',zref
+      print '(a,g0," + I*",g0,"  eps=",g0)', 'Diff: ', &
+                                 real(z)-real(zref), &
+                                 aimag(z)-aimag(zref), eps4
+      call abort()
+    end if
+  END SUBROUTINE check4
+  SUBROUTINE check8(z, zref)
+    complex(8), intent(in) :: z, zref
+    if (    abs (real(z)-real(zref)) > eps8 &
+        .or.abs (aimag(z)-aimag(zref)) > eps8) then
+      print '(a,/,2((2g0," + I ",g0),/))', "check8:","   z=",z,'zref=',zref
+      print '(a,g0," + I*",g0,"  eps=",g0)', 'Diff: ', &
+                                 real(z)-real(zref), &
+                                 aimag(z)-aimag(zref), eps8
+      call abort()
+    end if
+  END SUBROUTINE check8
+end module test
+
+PROGRAM ArcTrigHyp
+  use test
+  IMPLICIT NONE
+  complex(4), volatile :: z4
+  complex(8), volatile :: z8
+
+!!!!! ZERO !!!!!!
+
+  ! z = 0
+  z4 = cmplx(0.0_4, 0.0_4, kind=4)
+  z8 = cmplx(0.0_8, 0.0_8, kind=8)
+
+  ! Exact: 0
+  call check(asin(z4), cmplx(0.0_4, 0.0_4, kind=4))
+  call check(asin(z8), cmplx(0.0_8, 0.0_8, kind=8))
+  ! Exact: Pi/2 = 1.5707963267948966192313216916397514
+  call check(acos(z4), cmplx(1.57079632679489661920_4, 0.0_4, kind=4))
+  call check(acos(z8), cmplx(1.57079632679489661920_8, 0.0_8, kind=8))
+  ! Exact: 0
+  call check(atan(z4), cmplx(0.0_4, 0.0_4, kind=4))
+  call check(atan(z8), cmplx(0.0_8, 0.0_8, kind=8))
+  ! Exact: 0
+  call check(asinh(z4), cmplx(0.0_4, 0.0_4, kind=4))
+  call check(asinh(z8), cmplx(0.0_8, 0.0_8, kind=8))
+  ! Exact: I*Pi/2 = I*1.5707963267948966192313216916397514
+  call check(acosh(z4), cmplx(0.0_4, 1.57079632679489661920_4, kind=4))
+  call check(acosh(z8), cmplx(0.0_8, 1.57079632679489661920_8, kind=8))
+  ! Exact: 0
+  call check(atanh(z4), cmplx(0.0_4, 0.0_4, kind=4))
+  call check(atanh(z8), cmplx(0.0_8, 0.0_8, kind=8))
+
+
+!!!!! POSITIVE NUMBERS !!!!!!
+
+  ! z = tanh(1.0)
+  z4 = cmplx(0.76159415595576488811945828260479359_4, 0.0_4, kind=4)
+  z8 = cmplx(0.76159415595576488811945828260479359_8, 0.0_8, kind=8)
+
+  ! Numerically: 0.86576948323965862428960184619184444
+  call check(asin(z4), cmplx(0.86576948323965862428960184619184444_4, 0.0_4, kind=4))
+  call check(asin(z8), cmplx(0.86576948323965862428960184619184444_8, 0.0_8, kind=8))
+  ! Numerically: 0.70502684355523799494171984544790700
+  call check(acos(z4), cmplx(0.70502684355523799494171984544790700_4, 0.0_4, kind=4))
+  call check(acos(z8), cmplx(0.70502684355523799494171984544790700_8, 0.0_8, kind=8))
+  ! Numerically: 0.65088016802300754993807813168285564
+  call check(atan(z4), cmplx(0.65088016802300754993807813168285564_4, 0.0_4, kind=4))
+  call check(atan(z8), cmplx(0.65088016802300754993807813168285564_8, 0.0_8, kind=8))
+  ! Numerically: 0.70239670712987482778422106260749699
+  call check(asinh(z4), cmplx(0.70239670712987482778422106260749699_4, 0.0_4, kind=4))
+  call check(asinh(z8), cmplx(0.70239670712987482778422106260749699_8, 0.0_8, kind=8))
+  ! Numerically: 0.70502684355523799494171984544790700*I
+  call check(acosh(z4), cmplx(0.0_4, 0.70502684355523799494171984544790700_4, kind=4))
+  call check(acosh(z8), cmplx(0.0_8, 0.70502684355523799494171984544790700_8, kind=8))
+  ! Exact: 1
+  call check(atanh(z4), cmplx(1.0_4, 0.0_4, kind=4))
+  call check(atanh(z8), cmplx(1.0_8, 0.0_8, kind=8))
+
+
+  ! z = I*tanh(1.0)
+  z4 = cmplx(0.0_4, 0.76159415595576488811945828260479359_4, kind=4)
+  z8 = cmplx(0.0_8, 0.76159415595576488811945828260479359_8, kind=8)
+
+  ! Numerically: I*0.70239670712987482778422106260749699
+  call check(asin(z4), cmplx(0.0_4, 0.70239670712987482778422106260749699_4, kind=4))
+  call check(asin(z8), cmplx(0.0_8, 0.70239670712987482778422106260749699_8, kind=8))
+  ! Numerically: 1.5707963267948966192313216916397514 - I*0.7023967071298748277842210626074970
+  call check(acos(z4), cmplx(1.5707963267948966192313216916397514_4, -0.7023967071298748277842210626074970_4, kind=4))
+  call check(acos(z8), cmplx(1.5707963267948966192313216916397514_8, -0.7023967071298748277842210626074970_8, kind=8))
+  ! Exact: I*1
+  call check(atan(z4), cmplx(0.0_4, 1.0_4, kind=4))
+  call check(atan(z8), cmplx(0.0_8, 1.0_8, kind=8))
+  ! Numerically: I*0.86576948323965862428960184619184444
+  call check(asinh(z4), cmplx(0.0_4, 0.86576948323965862428960184619184444_4, kind=4))
+  call check(asinh(z8), cmplx(0.0_8, 0.86576948323965862428960184619184444_8, kind=8))
+  ! Numerically: 0.7023967071298748277842210626074970 + I*1.5707963267948966192313216916397514
+  call check(acosh(z4), cmplx(0.7023967071298748277842210626074970_4, 1.5707963267948966192313216916397514_4, kind=4))
+  call check(acosh(z8), cmplx(0.7023967071298748277842210626074970_8, 1.5707963267948966192313216916397514_8, kind=8))
+  ! Numerically: I*0.65088016802300754993807813168285564
+  call check(atanh(z4), cmplx(0.0_4, 0.65088016802300754993807813168285564_4, kind=4))
+  call check(atanh(z8), cmplx(0.0_8, 0.65088016802300754993807813168285564_8, kind=8))
+
+
+  ! z = (1+I)*tanh(1.0)
+  z4 = cmplx(0.76159415595576488811945828260479359_4, 0.76159415595576488811945828260479359_4, kind=4)
+  z8 = cmplx(0.76159415595576488811945828260479359_8, 0.76159415595576488811945828260479359_8, kind=8)
+
+  ! Numerically: 0.59507386031622633330574869409179139 + I*0.82342412550090412964986631390412834
+  call check(asin(z4), cmplx(0.59507386031622633330574869409179139_4, 0.82342412550090412964986631390412834_4, kind=4))
+  call check(asin(z8), cmplx(0.59507386031622633330574869409179139_8, 0.82342412550090412964986631390412834_8, kind=8))
+  ! Numerically: 0.97572246647867028592557299754796005 - I*0.82342412550090412964986631390412834
+  call check(acos(z4), cmplx(0.97572246647867028592557299754796005_4, -0.82342412550090412964986631390412834_4, kind=4))
+  call check(acos(z8), cmplx(0.97572246647867028592557299754796005_8, -0.82342412550090412964986631390412834_8, kind=8))
+  ! Numerically: 0.83774433133636226305479129936568267 + I*0.43874835208710654149508159123595167
+  call check(atan(z4), cmplx(0.83774433133636226305479129936568267_4, 0.43874835208710654149508159123595167_4, kind=4))
+  call check(atan(z8), cmplx(0.83774433133636226305479129936568267_8, 0.43874835208710654149508159123595167_8, kind=8))
+  ! Numerically: 0.82342412550090412964986631390412834 + I*0.59507386031622633330574869409179139
+  call check(asinh(z4), cmplx(0.82342412550090412964986631390412834_4, 0.59507386031622633330574869409179139_4, kind=4))
+  call check(asinh(z8), cmplx(0.82342412550090412964986631390412834_8, 0.59507386031622633330574869409179139_8, kind=8))
+  ! Numerically: 0.82342412550090412964986631390412834 + I*0.97572246647867028592557299754796005
+  call check(acosh(z4), cmplx(0.82342412550090412964986631390412834_4, 0.97572246647867028592557299754796005_4, kind=4))
+  call check(acosh(z8), cmplx(0.82342412550090412964986631390412834_8, 0.97572246647867028592557299754796005_8, kind=8))
+  ! Numerically: 0.43874835208710654149508159123595167 + I*0.83774433133636226305479129936568267
+  call check(atanh(z4), cmplx(0.43874835208710654149508159123595167_4, 0.83774433133636226305479129936568267_4, kind=4))
+  call check(atanh(z8), cmplx(0.43874835208710654149508159123595167_8, 0.83774433133636226305479129936568267_8, kind=8))
+
+
+  ! z = 1+I
+  z4 = cmplx(1.0_4, 1.0_4, kind=4)
+  z8 = cmplx(1.0_8, 1.0_8, kind=8)
+
+  ! Numerically: 0.66623943249251525510400489597779272 + I*1.06127506190503565203301891621357349
+  call check(asin(z4), cmplx(0.66623943249251525510400489597779272_4, 1.06127506190503565203301891621357349_4, kind=4))
+  call check(asin(z8), cmplx(0.66623943249251525510400489597779272_8, 1.06127506190503565203301891621357349_8, kind=8))
+  ! Numerically: 0.90455689430238136412731679566195872 - I*1.06127506190503565203301891621357349
+  call check(acos(z4), cmplx(0.90455689430238136412731679566195872_4, -1.06127506190503565203301891621357349_4, kind=4))
+  call check(acos(z8), cmplx(0.90455689430238136412731679566195872_8, -1.06127506190503565203301891621357349_8, kind=8))
+  ! Numerically: 1.01722196789785136772278896155048292 + I*0.40235947810852509365018983330654691
+  call check(atan(z4), cmplx(1.01722196789785136772278896155048292_4, 0.40235947810852509365018983330654691_4, kind=4))
+  call check(atan(z8), cmplx(1.01722196789785136772278896155048292_8, 0.40235947810852509365018983330654691_8, kind=8))
+  ! Numerically: 1.06127506190503565203301891621357349 + I*0.66623943249251525510400489597779272
+  call check(asinh(z4), cmplx(1.06127506190503565203301891621357349_4, 0.66623943249251525510400489597779272_4, kind=4))
+  call check(asinh(z8), cmplx(1.06127506190503565203301891621357349_8, 0.66623943249251525510400489597779272_8, kind=8))
+  ! Numerically: 1.06127506190503565203301891621357349 + I*0.90455689430238136412731679566195872
+  call check(acosh(z4), cmplx(1.06127506190503565203301891621357349_4, 0.90455689430238136412731679566195872_4, kind=4))
+  call check(acosh(z8), cmplx(1.06127506190503565203301891621357349_8, 0.90455689430238136412731679566195872_8, kind=8))
+  ! Numerically: 0.40235947810852509365018983330654691 + I*1.01722196789785136772278896155048292
+  call check(atanh(z4), cmplx(0.40235947810852509365018983330654691_4, 1.01722196789785136772278896155048292_4, kind=4))
+  call check(atanh(z8), cmplx(0.40235947810852509365018983330654691_8, 1.01722196789785136772278896155048292_8, kind=8))
+
+
+  ! z = (1+I)*1.1
+  z4 = cmplx(1.1_4, 1.1_4, kind=4)
+  z8 = cmplx(1.1_8, 1.1_8, kind=8)
+
+  ! Numerically: 0.68549840630267734494444454677951503 + I*1.15012680127435581678415521738176733
+  call check(asin(z4), cmplx(0.68549840630267734494444454677951503_4, 1.15012680127435581678415521738176733_4, kind=4))
+  call check(asin(z8), cmplx(0.68549840630267734494444454677951503_8, 1.15012680127435581678415521738176733_8, kind=8))
+  ! Numerically: 0.8852979204922192742868771448602364 - I*1.1501268012743558167841552173817673
+  call check(acos(z4), cmplx(0.8852979204922192742868771448602364_4, -1.1501268012743558167841552173817673_4, kind=4))
+  call check(acos(z8), cmplx(0.8852979204922192742868771448602364_8, -1.1501268012743558167841552173817673_8, kind=8))
+  ! Numerically: 1.07198475450905931839240655913126728 + I*0.38187020129010862908881230531688930
+  call check(atan(z4), cmplx(1.07198475450905931839240655913126728_4, 0.38187020129010862908881230531688930_4, kind=4))
+  call check(atan(z8), cmplx(1.07198475450905931839240655913126728_8, 0.38187020129010862908881230531688930_8, kind=8))
+  ! Numerically: 1.15012680127435581678415521738176733 + I*0.68549840630267734494444454677951503
+  call check(asinh(z4), cmplx(1.15012680127435581678415521738176733_4, 0.68549840630267734494444454677951503_4, kind=4))
+  call check(asinh(z8), cmplx(1.15012680127435581678415521738176733_8, 0.68549840630267734494444454677951503_8, kind=8))
+  ! Numerically: 1.1501268012743558167841552173817673 + I*0.8852979204922192742868771448602364
+  call check(acosh(z4), cmplx(1.1501268012743558167841552173817673_4, 0.8852979204922192742868771448602364_4, kind=4))
+  call check(acosh(z8), cmplx(1.1501268012743558167841552173817673_8, 0.8852979204922192742868771448602364_8, kind=8))
+  ! Numerically: 0.38187020129010862908881230531688930 + I*1.07198475450905931839240655913126728
+  call check(atanh(z4), cmplx(0.38187020129010862908881230531688930_4, 1.07198475450905931839240655913126728_4, kind=4))
+  call check(atanh(z8), cmplx(0.38187020129010862908881230531688930_8, 1.07198475450905931839240655913126728_8, kind=8))
+
+
+!!!!! Negative NUMBERS !!!!!!
+  ! z = -(1+I)*1.1
+  z4 = cmplx(-1.1_4, -1.1_4, kind=4)
+  z8 = cmplx(-1.1_8, -1.1_8, kind=8)
+
+  ! Numerically: -0.68549840630267734494444454677951503 - I*1.15012680127435581678415521738176733
+  call check(asin(z4), cmplx(-0.68549840630267734494444454677951503_4, -1.15012680127435581678415521738176733_4, kind=4))
+  call check(asin(z8), cmplx(-0.68549840630267734494444454677951503_8, -1.15012680127435581678415521738176733_8, kind=8))
+  ! Numerically: 2.2562947330975739641757662384192665 + I*1.1501268012743558167841552173817673
+  call check(acos(z4), cmplx(2.2562947330975739641757662384192665_4, 1.1501268012743558167841552173817673_4, kind=4))
+  call check(acos(z8), cmplx(2.2562947330975739641757662384192665_8, 1.1501268012743558167841552173817673_8, kind=8))
+  ! Numerically: -1.07198475450905931839240655913126728 - I*0.38187020129010862908881230531688930
+  call check(atan(z4), cmplx(-1.07198475450905931839240655913126728_4, -0.38187020129010862908881230531688930_4, kind=4))
+  call check(atan(z8), cmplx(-1.07198475450905931839240655913126728_8, -0.38187020129010862908881230531688930_8, kind=8))
+  ! Numerically: -1.15012680127435581678415521738176733 - I*0.68549840630267734494444454677951503
+  call check(asinh(z4), cmplx(-1.15012680127435581678415521738176733_4, -0.68549840630267734494444454677951503_4, kind=4))
+  call check(asinh(z8), cmplx(-1.15012680127435581678415521738176733_8, -0.68549840630267734494444454677951503_8, kind=8))
+  ! Numerically: 1.1501268012743558167841552173817673 - I*2.2562947330975739641757662384192665
+  call check(acosh(z4), cmplx(1.1501268012743558167841552173817673_4, -2.2562947330975739641757662384192665_4, kind=4))
+  call check(acosh(z8), cmplx(1.1501268012743558167841552173817673_8, -2.2562947330975739641757662384192665_8, kind=8))
+  ! Numerically: 0.38187020129010862908881230531688930 + I*1.07198475450905931839240655913126728
+  call check(atanh(z4), cmplx(-0.38187020129010862908881230531688930_4, -1.07198475450905931839240655913126728_4, kind=4))
+  call check(atanh(z8), cmplx(-0.38187020129010862908881230531688930_8, -1.07198475450905931839240655913126728_8, kind=8))
+END PROGRAM ArcTrigHyp
+
+! { dg-final { cleanup-modules "test" } }
diff --git a/gcc/testsuite/gfortran.dg/complex_intrinsic_6.f90 b/gcc/testsuite/gfortran.dg/complex_intrinsic_6.f90
new file mode 100644
index 000000000..5cde928ba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/complex_intrinsic_6.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/33197
+! PR fortran/40728
+!
+! Complex inverse trigonometric functions
+! and complex inverse hyperbolic functions
+!
+! Argument type check
+!
+
+PROGRAM ArcTrigHyp
+  IMPLICIT NONE
+  real(4), volatile :: r4
+  real(8), volatile :: r8
+  complex(4), volatile :: z4
+  complex(8), volatile :: z8
+
+  r4 = 0.0_4
+  r8 = 0.0_8
+  z4 = cmplx(0.0_4, 0.0_4, kind=4)
+  z8 = cmplx(0.0_8, 0.0_8, kind=8)
+
+  r4 = asin(r4)
+  r8 = asin(r8)
+  r4 = acos(r4)
+  r8 = acos(r8)
+  r4 = atan(r4)
+  r8 = atan(r8)
+
+! a(sin,cos,tan)h cannot be checked as they are not part of
+! Fortran 2003 - not even for real arguments
+
+  z4 = asin(z4) ! { dg-error "Fortran 2008: COMPLEX argument" }
+  z8 = asin(z8) ! { dg-error "Fortran 2008: COMPLEX argument" }
+  z4 = acos(z4) ! { dg-error "Fortran 2008: COMPLEX argument" }
+  z8 = acos(z8) ! { dg-error "Fortran 2008: COMPLEX argument" }
+  z4 = atan(z4) ! { dg-error "Fortran 2008: COMPLEX argument" }
+  z8 = atan(z8) ! { dg-error "Fortran 2008: COMPLEX argument" }
+END PROGRAM ArcTrigHyp
diff --git a/gcc/testsuite/gfortran.dg/complex_intrinsic_7.f90 b/gcc/testsuite/gfortran.dg/complex_intrinsic_7.f90
new file mode 100644
index 000000000..dcc6bf91f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/complex_intrinsic_7.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/33197
+!
+! Fortran 2008 complex trigonometric functions: tan, cosh, sinh, tanh
+!
+! Compile-time simplificiations
+!
+implicit none
+real(4), parameter :: pi  = 2*acos(0.0_4)
+real(8), parameter :: pi8 = 2*acos(0.0_8)
+real(4), parameter :: eps  = 10*epsilon(0.0_4)
+real(8), parameter :: eps8 = 10*epsilon(0.0_8)
+complex(4), parameter :: z0_0  = cmplx(0.0_4, 0.0_4, kind=4)
+complex(4), parameter :: z1_1  = cmplx(1.0_4, 1.0_4, kind=4)
+complex(4), parameter :: zp_p  = cmplx(pi,    pi,    kind=4)
+complex(8), parameter :: z80_0 = cmplx(0.0_8, 0.0_8, kind=8)
+complex(8), parameter :: z81_1 = cmplx(1.0_8, 1.0_8, kind=8)
+complex(8), parameter :: z8p_p = cmplx(pi8,   pi8,   kind=8)
+
+if (abs(tan(z0_0)  - cmplx(0.0,0.0,4)) > eps) call abort()
+if (abs(tan(z1_1)  - cmplx(0.27175257,1.0839232,4)) > eps) call abort()
+if (abs(tan(z80_0) - cmplx(0.0_8,0.0_8,8)) > eps8) call abort()
+if (abs(tan(z81_1) - cmplx(0.27175258531951174_8,1.0839233273386946_8,8)) > eps8) call abort()
+
+if (abs(cosh(z0_0)  - cmplx(1.0,0.0,4)) > eps) call abort()
+if (abs(cosh(z1_1)  - cmplx(0.83372992,0.98889768,4)) > eps) call abort()
+if (abs(cosh(z80_0) - cmplx(1.0_8,0.0_8,8)) > eps8) call abort()
+if (abs(cosh(z81_1) - cmplx(0.83373002513114913_8,0.98889770576286506_8,8)) > eps8) call abort()
+
+if (abs(sinh(z0_0)  - cmplx(0.0,0.0,4)) > eps) call abort()
+if (abs(sinh(z1_1)  - cmplx(0.63496387,1.2984575,4)) > eps) call abort()
+if (abs(sinh(z80_0) - cmplx(0.0_8,0.0_8,8)) > eps8) call abort()
+if (abs(sinh(z81_1) - cmplx(0.63496391478473613_8,1.2984575814159773_8,8)) > eps8) call abort()
+
+if (abs(tanh(z0_0)  - cmplx(0.0,0.0,4)) > eps) call abort()
+if (abs(tanh(z1_1)  - cmplx(1.0839232,0.27175257,4)) > eps) call abort()
+if (abs(tanh(z80_0) - cmplx(0.0_8,0.0_8,8)) > eps8) call abort()
+if (abs(tanh(z81_1) - cmplx(1.0839233273386946_8,0.27175258531951174_8,8)) > eps8) call abort()
+
+end
+! { dg-final { scan-tree-dump-times "abort" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/complex_intrinsic_8.f90 b/gcc/testsuite/gfortran.dg/complex_intrinsic_8.f90
new file mode 100644
index 000000000..255449dda
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/complex_intrinsic_8.f90
@@ -0,0 +1,49 @@
+! { dg-do link }
+!
+! PR fortran/33197
+!
+! Fortran complex trigonometric functions: acos, asin, atan, acosh, asinh, atanh
+!
+! Compile-time simplifications
+!
+implicit none
+real(4), parameter :: pi  = 2*acos(0.0_4)
+real(8), parameter :: pi8 = 2*acos(0.0_8)
+real(4), parameter :: eps  = 10*epsilon(0.0_4)
+real(8), parameter :: eps8 = 10*epsilon(0.0_8)
+complex(4), parameter :: z0_0  = cmplx(0.0_4, 0.0_4, kind=4)
+complex(4), parameter :: z1_1  = cmplx(1.0_4, 1.0_4, kind=4)
+complex(8), parameter :: z80_0 = cmplx(0.0_8, 0.0_8, kind=8)
+complex(8), parameter :: z81_1 = cmplx(1.0_8, 1.0_8, kind=8)
+
+if (abs(acos(z0_0)  - cmplx(pi/2,-0.0,4)) > eps) call link_error()
+if (abs(acos(z1_1)  - cmplx(0.904556894, -1.06127506,4)) > eps) call link_error()
+if (abs(acos(z80_0)  - cmplx(pi8/2,-0.0_8,8)) > eps8) call link_error()
+if (abs(acos(z81_1)  - cmplx(0.90455689430238140_8, -1.0612750619050357_8,8)) > eps8) call link_error()
+
+if (abs(asin(z0_0)  - cmplx(0.0,0.0,4)) > eps) call link_error()
+if (abs(asin(z1_1)  - cmplx(0.66623943, 1.06127506,4)) > eps) call link_error()
+if (abs(asin(z80_0)  - cmplx(0.0_8,0.0_8,8)) > eps8) call link_error()
+if (abs(asin(z81_1)  - cmplx(0.66623943249251527_8, 1.0612750619050357_8,8)) > eps8) call link_error()
+
+if (abs(atan(z0_0)  - cmplx(0.0,0.0,4)) > eps) call link_error()
+if (abs(atan(z1_1)  - cmplx(1.01722196, 0.40235947,4)) > eps) call link_error()
+if (abs(atan(z80_0)  - cmplx(0.0_8,0.0_8,8)) > eps8) call link_error()
+if (abs(atan(z81_1)  - cmplx(1.0172219678978514_8, 0.40235947810852507_8,8)) > eps8) call link_error()
+
+if (abs(acosh(z0_0)  - cmplx(0.0,pi/2,4)) > eps) call link_error()
+if (abs(acosh(z1_1)  - cmplx(1.06127506, 0.90455689,4)) > eps) call link_error()
+if (abs(acosh(z80_0)  - cmplx(0.0_8,pi8/2,8)) > eps8) call link_error()
+if (abs(acosh(z81_1)  - cmplx(1.0612750619050357_8, 0.90455689430238140_8,8)) > eps8) call link_error()
+
+if (abs(asinh(z0_0)  - cmplx(0.0,0.0,4)) > eps) call link_error()
+if (abs(asinh(z1_1)  - cmplx(1.06127506, 0.66623943,4)) > eps) call link_error()
+if (abs(asinh(z80_0)  - cmplx(0.0_8,0.0_8,8)) > eps8) call link_error()
+if (abs(asinh(z81_1)  - cmplx(1.0612750619050357_8, 0.66623943249251527_8,8)) > eps8) call link_error()
+
+if (abs(atanh(z0_0)  - cmplx(0.0,0.0,4)) > eps) call link_error()
+if (abs(atanh(z1_1)  - cmplx(0.40235947, 1.01722196,4)) > eps) call link_error()
+if (abs(atanh(z80_0)  - cmplx(0.0_8,0.0_8,8)) > eps8) call link_error()
+if (abs(atanh(z81_1)  - cmplx(0.40235947810852507_8, 1.0172219678978514_8,8)) > eps8) call link_error()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/complex_parameter_1.f90 b/gcc/testsuite/gfortran.dg/complex_parameter_1.f90
new file mode 100644
index 000000000..7b631a6cc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/complex_parameter_1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+  integer,parameter :: i = 42
+  real,parameter :: x = 17.
+  complex,parameter :: z = (1.,2.)
+  complex,parameter :: c1 = (i, 0.5) ! { dg-error "Fortran 2003: PARAMETER symbol in complex constant" }
+  complex,parameter :: c2 = (x, 0.5) ! { dg-error "Fortran 2003: PARAMETER symbol in complex constant" }
+  complex,parameter :: c3 = (z, 0.) ! { dg-error "Fortran 2003: PARAMETER symbol in complex constant" }
+  print *, c1, c2, c3
+  end
diff --git a/gcc/testsuite/gfortran.dg/complex_read.f90 b/gcc/testsuite/gfortran.dg/complex_read.f90
new file mode 100644
index 000000000..102a13522
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/complex_read.f90
@@ -0,0 +1,58 @@
+! { dg-do run { target fd_truncate } }
+! Test of the fix to the bug in NIST fm906.for.
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+program complex_read
+  complex            ::  a
+  open (10, status="scratch")
+
+! Test that we have not broken the one line form.
+
+  write (10, *) " ( 0.99  ,  9.9  )"
+  rewind (10)
+  read (10,*) a
+  if (a.ne.(0.99, 9.90)) call abort ()
+
+! Test a new record after the.comma (the original bug).
+
+  rewind (10)
+  write (10, *) " ( 99.0   ,"
+  write (10, *) "   999.0  )"
+  rewind (10)
+  read (10,*) a
+  if (a.ne.(99.0, 999.0)) call abort ()
+
+! Test a new record before the.comma 
+
+  rewind (10)
+  write (10, *) " ( 0.99  "
+  write (10, *) " , 9.9  )"
+  rewind (10)
+  read (10,*) a
+  if (a.ne.(0.99, 9.90)) call abort ()
+
+! Test a new records before and after the.comma 
+
+  rewind (10)
+  write (10, *) " ( 99.0   "
+  write (10, *) ",         "
+  write (10, *) "  999.0  )"
+  rewind (10)
+  read (10,*) a
+  if (a.ne.(99.0, 999.0)) call abort ()
+
+! Test a new records and blank records before and after the.comma 
+
+  rewind (10)
+  write (10, *) " ( 0.99   "
+  write (10, *) "          "
+  write (10, *) ",         "
+  write (10, *) "          "
+  write (10, *) "  9.9    )"
+  rewind (10)
+  read (10,*) a
+  if (a.ne.(0.99, 9.9)) call abort ()
+
+  close (10)
+end program complex_read
+
diff --git a/gcc/testsuite/gfortran.dg/complex_write.f90 b/gcc/testsuite/gfortran.dg/complex_write.f90
new file mode 100644
index 000000000..694c069e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/complex_write.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! pr 19071
+! test case provided by
+!   Thomas.Koenig@online.de
+       program cio      
+       complex a      
+       real r1,r2      
+       a = cmplx(1.0, 2.0)      
+       open(unit=74,status='scratch')      
+       write(74,'(1P,E13.5)')a      
+       rewind(74)
+!  can read the complex in as two reals, one on each line
+       read(74,'(E13.5)')r1,r2      
+       if (r1.ne.1.0 .and. r2.ne.2.0) call abort
+       end
diff --git a/gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_1.f90 b/gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_1.f90
new file mode 100644
index 000000000..19cef2bfd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_1.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! Tests the fix for PR26976, in which non-compliant elemental
+! intrinsic function results were not detected.  At the same
+! time, the means to tests the compliance of TRANSFER with the
+! optional SIZE parameter was added.
+!
+! Contributed by Dominique Dhumieres  <dominiq@lps.ens.fr>
+!
+real(4) :: pi, a(2), b(3)
+character(26) :: ch
+
+pi = acos(-1.0)
+b = pi
+
+a = cos(b) ! { dg-error "Different shape for array assignment" }
+
+a = -pi
+b = cos(a) ! { dg-error "Different shape for array assignment" }
+
+ch = "abcdefghijklmnopqrstuvwxyz"
+a = transfer (ch, pi, 3) ! { dg-error "Different shape for array assignment" }
+
+! This already generated an error
+b = reshape ((/1.0/),(/1/)) ! { dg-error "Different shape for array assignment" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_2.f90 b/gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_2.f90
new file mode 100644
index 000000000..0ced3301f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_2.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+!
+! Testcases from PR32002.
+!
+PROGRAM test_pr32002
+
+  CALL test_1()                       ! scalar/vector
+  CALL test_2()                       ! vector/vector
+  CALL test_3()                       ! matrix/vector
+  CALL test_4()                       ! matrix/matrix
+
+CONTAINS
+  ELEMENTAL FUNCTION f(x)
+    INTEGER, INTENT(in) :: x
+    INTEGER :: f
+    f = x
+  END FUNCTION
+
+  SUBROUTINE test_1()
+    INTEGER :: a = 0, b(2) = 0
+    a = f(b)                          ! { dg-error "Incompatible ranks" }
+    b = f(a)                          ! ok, set all array elements to f(a)
+  END SUBROUTINE
+
+  SUBROUTINE test_2()
+    INTEGER :: a(2) = 0, b(3) = 0
+    a = f(b)                          ! { dg-error "Different shape" }
+    a = f(b(1:2))                     ! ok, slice, stride 1
+    a = f(b(1:3:2))                   ! ok, slice, stride 2
+  END SUBROUTINE
+
+  SUBROUTINE test_3()
+    INTEGER :: a(4) = 0, b(2,2) = 0
+    a = f(b)                          ! { dg-error "Incompatible ranks" }
+    a = f(RESHAPE(b, (/ 4 /)))        ! ok, same shape
+  END SUBROUTINE
+
+  SUBROUTINE test_4()
+    INTEGER :: a(2,2) = 0, b(3,3) = 0
+    a = f(b)                          ! { dg-error "Different shape" }
+    a = f(b(1:3, 1:2))                ! { dg-error "Different shape" }
+    a = f(b(1:3:2, 1:3:2))            ! ok, same shape
+  END SUBROUTINE
+END PROGRAM
diff --git a/gcc/testsuite/gfortran.dg/conflicts.f90 b/gcc/testsuite/gfortran.dg/conflicts.f90
new file mode 100644
index 000000000..d17cb041d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/conflicts.f90
@@ -0,0 +1,51 @@
+! { dg-do compile }
+! Check for conflicts
+! PR fortran/29657
+
+function f1() ! { dg-error "PROCEDURE attribute conflicts with SAVE attribute" }
+  implicit none
+  real, save :: f1
+  f1 = 1.0
+end function f1
+
+function f2() ! { dg-error "PROCEDURE attribute conflicts with SAVE attribute" }
+  implicit none
+  real :: f2
+  save f2
+  f2 = 1.0
+end function f2
+
+subroutine f3()
+  implicit none
+  dimension f3(3) ! { dg-error "SUBROUTINE attribute conflicts with DIMENSION attribute" }
+end subroutine f3
+
+subroutine f4(b)
+  implicit none
+  real :: b
+  entry b ! { dg-error "DUMMY attribute conflicts with ENTRY attribute" }
+end subroutine f4
+
+function f5(a)
+  implicit none
+  real :: a,f5
+  entry a ! { dg-error "DUMMY attribute conflicts with ENTRY attribute" }
+  f5 = 3.4
+end function f5
+
+subroutine f6(cos)
+  implicit none
+  real :: cos
+  intrinsic cos ! { dg-error "DUMMY attribute conflicts with INTRINSIC attribute" }
+end subroutine f6
+
+subroutine f7(sin)
+  implicit none
+  real :: sin
+  external sin
+end subroutine f7
+
+program test
+  implicit none
+  dimension test(3) ! { dg-error "PROGRAM attribute conflicts with DIMENSION attribute" }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/conflicts_2.f90 b/gcc/testsuite/gfortran.dg/conflicts_2.f90
new file mode 100644
index 000000000..665667294
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/conflicts_2.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+! Check conflicts:
+! - PARAMETER and BIND(C), PR fortran/33310
+! - INTRINSIC and ENTRY, PR fortran/33284
+!
+
+subroutine a
+ intrinsic  cos
+entry cos(x) ! { dg-error "ENTRY attribute conflicts with INTRINSIC" }
+ real x
+ x = 0
+end subroutine
+
+module m
+    use iso_c_binding
+    implicit none
+    TYPE, bind(C) :: the_distribution
+        INTEGER(c_int) :: parameters(1)
+    END TYPE the_distribution
+    TYPE (the_distribution), parameter, bind(C) :: & ! { dg-error "PARAMETER attribute conflicts with BIND.C." }
+                          the_beta = the_distribution((/0/))
+end module m
+
+end
diff --git a/gcc/testsuite/gfortran.dg/constant_substring.f b/gcc/testsuite/gfortran.dg/constant_substring.f
new file mode 100644
index 000000000..4ca11bc16
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/constant_substring.f
@@ -0,0 +1,13 @@
+! Simplify constant substring
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+      character*2 a
+      character*4 b
+      character*6 c
+      parameter (a="12")
+      parameter (b = a(1:2))
+      write (c,'("#",A,"#")') b
+      if (c .ne. '#12  #') call abort
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/contained_1.f90 b/gcc/testsuite/gfortran.dg/contained_1.f90
new file mode 100644
index 000000000..05216b228
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/contained_1.f90
@@ -0,0 +1,35 @@
+! PR15986
+! Siblings may be used as actual arguments, in which case they look like
+! variables during parsing.  Also checks that actual variables aren't replaced
+! by siblings with the same name
+! { dg-do run }
+module contained_1_mod
+integer i
+contains
+subroutine a
+  integer :: c = 42
+  call sub(b, c)
+end subroutine a
+subroutine b()
+  i = i + 1
+end subroutine b
+subroutine c
+end subroutine
+end module
+
+subroutine sub (proc, var)
+  external proc1
+  integer var
+
+  if (var .ne. 42) call abort
+  call proc
+end subroutine
+
+program contained_1
+  use contained_1_mod
+  i = 0
+  call a
+  if (i .ne. 1) call abort
+end program
+
+! { dg-final { cleanup-modules "contained_1_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/contained_3.f90 b/gcc/testsuite/gfortran.dg/contained_3.f90
new file mode 100644
index 000000000..5ae41597c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/contained_3.f90
@@ -0,0 +1,50 @@
+! { dg-do run }
+! Tests the fix for PR33897, in which gfortran missed that the
+! declaration of 'setbd' in 'nxtstg2' made it external.  Also
+! the ENTRY 'setbd' would conflict with the external 'setbd'.
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+!
+MODULE ksbin1_aux_mod
+ CONTAINS
+  SUBROUTINE nxtstg1()
+    INTEGER :: i
+    i = setbd()  ! available by host association.
+    if (setbd () .ne. 99 ) call abort ()
+  END SUBROUTINE nxtstg1
+
+  SUBROUTINE nxtstg2()
+    INTEGER :: i
+    integer :: setbd  ! makes it external.
+    i = setbd()       ! this is the PR
+    if (setbd () .ne. 42 ) call abort ()
+  END SUBROUTINE nxtstg2
+
+  FUNCTION binden()
+    INTEGER :: binden
+    INTEGER :: setbd
+    binden = 0
+  ENTRY setbd()
+    setbd = 99
+  END FUNCTION binden
+END MODULE ksbin1_aux_mod
+
+PROGRAM test
+  USE ksbin1_aux_mod, only : nxtstg1, nxtstg2
+  integer setbd ! setbd is external, since not use assoc.
+  CALL nxtstg1()
+  CALL nxtstg2()
+  if (setbd () .ne. 42 ) call abort ()
+  call foo
+contains
+  subroutine foo
+    USE ksbin1_aux_mod ! module setbd is available
+    if (setbd () .ne. 99 ) call abort ()
+  end subroutine
+END PROGRAM test
+
+INTEGER FUNCTION setbd()
+  setbd=42
+END FUNCTION setbd
+
+! { dg-final { cleanup-modules "ksbin1_aux_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/contained_equivalence_1.f90 b/gcc/testsuite/gfortran.dg/contained_equivalence_1.f90
new file mode 100644
index 000000000..7c6b0126c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/contained_equivalence_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! This program tests that equivalence only associates variables in
+! the same scope.
+!
+! provided by Paul Thomas - pault@gcc.gnu.org
+!
+program contained_equiv
+  real a
+  a = 1.0
+  call foo ()
+  if (a.ne.1.0) call abort ()
+contains
+  subroutine foo ()
+    real b
+    equivalence (a, b)
+    b = 2.0
+  end subroutine foo
+end program contained_equiv
diff --git a/gcc/testsuite/gfortran.dg/contained_module_proc_1.f90 b/gcc/testsuite/gfortran.dg/contained_module_proc_1.f90
new file mode 100644
index 000000000..a1e589293
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/contained_module_proc_1.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! Tests the check for PR31292, in which the module procedure
+! statement would put the symbol for assign_t in the wrong
+! namespace and this caused the interface checking to fail.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module chk_gfortran
+   implicit none
+   type t
+      integer x
+   end type t
+   contains
+      function is_gfortran()
+         logical is_gfortran
+         interface assignment(=)
+            module procedure assign_t
+         end interface assignment(=)
+         type(t) y(3)
+
+         y%x = (/1,2,3/)
+         y = y((/2,3,1/))
+         is_gfortran = y(3)%x == 1
+      end function is_gfortran
+
+      elemental subroutine assign_t(lhs,rhs)
+         type(t), intent(in) :: rhs
+         type(t), intent(out) :: lhs
+
+         lhs%x = rhs%x
+      end subroutine assign_t
+end module chk_gfortran
+
+program fire
+   use chk_gfortran
+   implicit none
+   if(.not. is_gfortran()) call abort()
+end program fire
+! { dg-final { cleanup-modules "chk_gfortran" } }
+
diff --git a/gcc/testsuite/gfortran.dg/contains.f90 b/gcc/testsuite/gfortran.dg/contains.f90
new file mode 100644
index 000000000..221488afb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/contains.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! Check whether empty contains are allowd
+! PR fortran/29806
+module x
+ contains
+end module x ! { dg-error "CONTAINS statement without FUNCTION or SUBROUTINE statement" }
+
+program y
+  contains
+end program y ! { dg-error "CONTAINS statement without FUNCTION or SUBROUTINE statement" }
diff --git a/gcc/testsuite/gfortran.dg/contains_empty_1.f03 b/gcc/testsuite/gfortran.dg/contains_empty_1.f03
new file mode 100644
index 000000000..51b5dd90b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/contains_empty_1.f03
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f2003 -pedantic" }
+program test
+  print *, 'hello there'
+contains
+end program test ! { dg-error "Fortran 2008: CONTAINS statement without" }
+
+module truc
+  integer, parameter :: answer = 42
+contains
+end module truc ! { dg-error "Fortran 2008: CONTAINS statement without" }
diff --git a/gcc/testsuite/gfortran.dg/contains_empty_2.f03 b/gcc/testsuite/gfortran.dg/contains_empty_2.f03
new file mode 100644
index 000000000..62e18f43d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/contains_empty_2.f03
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-std=f2008 -pedantic" }
+
+program test
+  print *, 'hello there'
+contains
+end program test
+
+module truc
+  integer, parameter :: answer = 42
+contains
+end module truc
+
+! { dg-final { cleanup-modules "truc" } }
diff --git a/gcc/testsuite/gfortran.dg/contiguous_1.f90 b/gcc/testsuite/gfortran.dg/contiguous_1.f90
new file mode 100644
index 000000000..e75c08d8e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/contiguous_1.f90
@@ -0,0 +1,177 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/40632
+!
+! CONTIGUOUS compile-time tests
+!
+
+! C448: Must be an array with POINTER attribute
+type t1
+  integer, contiguous :: ca(5) ! { dg-error "Component .ca. at .1. has the CONTIGUOUS" }
+end type t1
+type t2
+  integer, contiguous, allocatable :: cb(:) ! { dg-error "Component .cb. at .1. has the CONTIGUOUS" }
+end type t2
+type t3
+  integer, contiguous, pointer :: cc(:) ! OK
+end type t3
+type t4
+  integer, pointer, contiguous :: cd ! { dg-error "Component .cd. at .1. has the CONTIGUOUS" }
+end type t4
+end
+
+! C530: Must be an array and (a) a POINTER or (b) assumed shape.
+subroutine test(x, y)
+  integer, pointer :: x(:)
+  integer, intent(in) :: y(:)
+  contiguous :: x, y
+
+  integer, contiguous :: a(5) ! { dg-error ".a. at .1. has the CONTIGUOUS attribute" }
+  integer, contiguous, allocatable :: b(:) ! { dg-error ".b. at .1. has the CONTIGUOUS attribute" }
+  integer, contiguous, pointer :: c(:) ! OK
+  integer, pointer, contiguous :: d ! { dg-error ".d. at .1. has the CONTIGUOUS attribute" }
+end
+
+! Pointer assignment check:
+! If the pointer object has the CONTIGUOUS attribute, the pointer target shall be contiguous.
+! Note: This is not compile-time checkable; but F2008, 5.3.7 except in a very few cases.
+subroutine ptr_assign()
+  integer, pointer, contiguous :: ptr1(:)
+  integer, target :: tgt(5)
+  ptr1 => tgt
+end subroutine
+
+
+! C1239 (R1223) If an actual argument is a nonpointer array that has the ASYNCHRONOUS or VOLATILE
+! attribute but is not simply contiguous (6.5.4), and the corresponding dummy argument has either the
+! VOLATILE or ASYNCHRONOUS attribute, that dummy argument shall be an assumed-shape array
+! that does not have the CONTIGUOUS attribute.
+
+subroutine C1239
+  type t
+    integer :: e(4)
+  end type t
+  type(t), volatile :: f
+  integer, asynchronous :: a(4), b(4)
+  integer, volatile :: c(4), d(4)
+  call test (a,b,c)      ! OK
+  call test (a,b(::2),c) ! { dg-error "array without CONTIGUOUS" }
+  call test (a(::2),b,c) ! { dg-error "array without CONTIGUOUS" }
+
+  call test (a,b,f%e)      ! OK
+  call test (a,f%e,c)      ! OK
+  call test (f%e,b,c)      ! OK
+  call test (a,b,f%e(::2)) ! OK
+  call test (a,f%e(::2),c) ! { dg-error "array without CONTIGUOUS" }
+  call test (f%e(::2),b,c) ! { dg-error "array without CONTIGUOUS" }
+contains
+  subroutine test(u, v, w)
+    integer, asynchronous :: u(:), v(*)
+    integer, volatile :: w(:)
+    contiguous :: u
+  end subroutine test
+end subroutine C1239
+
+
+! C1240 (R1223) If an actual argument is an array pointer that has the ASYNCHRONOUS or VOLATILE
+! attribute but does not have the CONTIGUOUS attribute, and the corresponding dummy argument has
+! either the VOLATILE or ASYNCHRONOUS attribute, that dummy argument shall be an array pointer
+! or an assumed-shape array that does not have the CONTIGUOUS attribute.
+
+subroutine C1240
+  type t
+    integer,pointer :: e(:)
+  end type t
+  type(t), volatile :: f
+  integer, pointer, asynchronous :: a(:), b(:)
+  integer,pointer, volatile :: c(:), d(:)
+  call test (a,b,c)      ! { dg-error "array without CONTIGUOUS" }
+  call test (a,b(::2),c) ! { dg-error "array without CONTIGUOUS" }
+  call test (a(::2),b,c) ! { dg-error "array without CONTIGUOUS" }
+
+  call test (a,b,f%e)      ! { dg-error "array without CONTIGUOUS" }
+  call test (a,f%e,c)      ! { dg-error "array without CONTIGUOUS" }
+  call test (f%e,b,c)      ! { dg-error "array without CONTIGUOUS" }
+  call test (a,b,f%e(::2)) ! { dg-error "array without CONTIGUOUS" }
+  call test (a,f%e(::2),c) ! { dg-error "array without CONTIGUOUS" }
+  call test (f%e(::2),b,c) ! { dg-error "array without CONTIGUOUS" }
+
+  call test2(a,b)
+  call test3(a,b)
+  call test2(c,d)
+  call test3(c,d)
+  call test2(f%e,d)
+  call test3(c,f%e)
+contains
+  subroutine test(u, v, w)
+    integer, asynchronous :: u(:), v(*)
+    integer, volatile :: w(:)
+    contiguous :: u
+  end subroutine test
+  subroutine test2(x,y)
+    integer, asynchronous :: x(:)
+    integer, volatile :: y(:)
+  end subroutine test2 
+  subroutine test3(x,y)
+    integer, pointer, asynchronous :: x(:)
+    integer, pointer, volatile :: y(:)
+  end subroutine test3
+end subroutine C1240
+
+
+
+! 12.5.2.7 Pointer dummy variables
+! C1241 The actual argument corresponding to a dummy pointer with the CONTIGUOUS attribute shall be
+! simply contiguous (6.5.4).
+
+subroutine C1241
+  integer, pointer, contiguous :: a(:)
+  integer, pointer :: b(:)
+  call test(a)
+  call test(b) ! { dg-error "must be simply contigous" }
+contains
+  subroutine test(x)
+    integer, pointer, contiguous :: x(:)
+  end subroutine test
+end subroutine C1241
+
+
+! 12.5.2.8 Coarray dummy variables
+! If the dummy argument is an array coarray that has the CONTIGUOUS attribute or is not of assumed shape,
+! the corresponding actual argument shall be simply contiguous
+
+subroutine sect12528(cob)
+  integer, save :: coa(6)[*]
+  integer :: cob(:)[*]
+
+  call test(coa)
+  call test2(coa)
+  call test3(coa)
+
+  call test(cob) ! { dg-error "must be simply contiguous" }
+  call test2(cob) ! { dg-error "must be simply contiguous" }
+  call test3(cob)
+contains
+  subroutine test(x)
+    integer, contiguous :: x(:)[*]
+  end subroutine test
+  subroutine test2(x)
+    integer :: x(*)[*]
+  end subroutine test2
+  subroutine test3(x)
+    integer :: x(:)[*]
+  end subroutine test3
+end subroutine sect12528
+
+
+
+subroutine test34
+  implicit none
+  integer, volatile,pointer :: a(:,:),i
+  call foo(a(2,2:3:2)) ! { dg-error "must be simply contigous" }
+contains
+  subroutine foo(x)
+    integer, pointer, contiguous, volatile :: x(:)
+  end subroutine
+end subroutine test34
diff --git a/gcc/testsuite/gfortran.dg/contiguous_2.f90 b/gcc/testsuite/gfortran.dg/contiguous_2.f90
new file mode 100644
index 000000000..782d23dc7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/contiguous_2.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/40632
+!
+! CONTIGUOUS compile-time tests
+!
+
+integer, pointer, contiguous :: a(:) ! { dg-error "Fortran 2008:" }
+integer, pointer :: b(:)
+contiguous :: b ! { dg-error "Fortran 2008:" }
+end
diff --git a/gcc/testsuite/gfortran.dg/contiguous_3.f90 b/gcc/testsuite/gfortran.dg/contiguous_3.f90
new file mode 100644
index 000000000..aac55367a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/contiguous_3.f90
@@ -0,0 +1,65 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/40632
+!
+! CONTIGUOUS compile-time tests: Check that contigous
+! works properly.
+
+subroutine test1(a,b)
+  integer, pointer, contiguous :: test1_a(:)
+  call foo(test1_a)
+  call foo(test1_a(::1))
+  call foo(test1_a(::2))
+contains
+  subroutine foo(b)
+    integer :: b(*)
+  end subroutine foo
+end subroutine test1
+
+! For the first two no pack is done; for the third one, an array descriptor
+! (cf. below test3) is created for packing.
+!
+! { dg-final { scan-tree-dump-times "_internal_pack.*test1_a" 0 "original" } }
+! { dg-final { scan-tree-dump-times "_internal_unpack.*test1_a" 0 "original" } }
+
+
+subroutine t2(a1,b1,c2,d2)
+  integer, pointer, contiguous :: a1(:), b1(:)
+  integer, pointer :: c2(:), d2(:)
+  a1 = b1
+  c2 = d2
+end subroutine t2
+
+! { dg-final { scan-tree-dump-times "= a1->dim.0..stride;" 0 "original" } }
+! { dg-final { scan-tree-dump-times "= b1->dim.0..stride;" 0 "original" } }
+! { dg-final { scan-tree-dump-times "= c2->dim.0..stride;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "= d2->dim.0..stride;" 1 "original" } }
+
+
+subroutine test3()
+  implicit none
+  integer :: test3_a(8),i
+  test3_a = [(i,i=1,8)]
+  call foo(test3_a(::1))
+  call foo(test3_a(::2))
+  call bar(test3_a(::1))
+  call bar(test3_a(::2))
+contains
+  subroutine foo(x)
+    integer, contiguous :: x(:)
+    print *, x
+  end subroutine
+  subroutine bar(x)
+    integer :: x(:)
+    print *, x
+  end subroutine bar
+end subroutine test3
+
+! Once for test1 (third call), once for test3 (second call)
+! { dg-final { scan-tree-dump-times "data = origptr" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_internal_pack .&parm" 2 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_internal_unpack .&parm" 2 "original" } }
+
+
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/continuation_1.f90 b/gcc/testsuite/gfortran.dg/continuation_1.f90
new file mode 100644
index 000000000..1036db9cb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/continuation_1.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options -Wampersand }
+! PR 19101  Test line continuations and spaces.  Note: the missing ampersand
+! before "world" is non standard default behavior.  Use -std=f95, -std=f2003,
+! -pedantic, -Wall, or -Wampersand to catch this error
+! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>.
+program main
+  character (len=40) &
+  c
+  c = "Hello, &
+         world!" ! { dg-warning "Missing '&' in continued character constant" }
+  if (c.ne.&
+                                   "Hello, world!")&
+                               call abort();end program main
+
diff --git a/gcc/testsuite/gfortran.dg/continuation_10.f90 b/gcc/testsuite/gfortran.dg/continuation_10.f90
new file mode 100644
index 000000000..8071dd7b6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/continuation_10.f90
@@ -0,0 +1,55 @@
+! { dg-do compile }
+! { dg-options -std=f95 }
+! PR35882 Miscounted continuation lines when interspersed with data
+program test_mod
+   implicit none
+
+   integer, dimension(50) :: array
+
+   array = 1
+
+   print "(a, i8)", &
+      "Line 1", &
+      array(2), &
+      "Line 3", &
+      array(4), &
+      "Line 5", &
+      array(6), &
+      "Line 7", &
+      array(8), &
+      "Line 9", &
+      array(10), &
+      "Line 11", &
+      array(12), &
+      "Line 13", &
+      array(14), &
+      "Line 15", &
+      array(16), &
+      "Line 17", &
+      array(18), &
+      "Line 19", &
+      array(20), &
+      "Line 21", &
+      array(22), &
+      "Line 23", &
+      array(24), &
+      "Line 25", &
+      array(26), &
+      "Line 27", &
+      array(28), &
+      "Line 29", &
+      array(30), &
+      "Line 31", &
+      array(32), &
+      "Line 33", &
+      array(34), &
+      "Line 35", &
+      array(36), &
+      "Line 37", &
+      array(38), &
+      "Line 39", &
+      array(40), & ! { dg-warning "Limit of 39 continuations exceeded" }
+      "Line 41", &
+      array(42), &
+      "Line 43"
+end program
diff --git a/gcc/testsuite/gfortran.dg/continuation_11.f90 b/gcc/testsuite/gfortran.dg/continuation_11.f90
new file mode 100644
index 000000000..d8cd46b8a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/continuation_11.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-Wall -pedantic" }
+! Before a bogus warning was printed
+!
+! PR fortran/39811
+!
+implicit none
+character(len=70) :: str
+write(str,'(a)') 'Print rather a lot of ampersands &&&&&
+   &&&&&
+   &&&&&'
+if (len(trim(str)) /= 44 &
+    .or. str /= 'Print rather a lot of ampersands &&&&&&&&&&&') &
+    call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/continuation_12.f90 b/gcc/testsuite/gfortran.dg/continuation_12.f90
new file mode 100644
index 000000000..171d826cb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/continuation_12.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+! PR46705 Spurious "Missing '&' in continued character constant" warning occurs twice
+character(15) :: astring
+1 FORMAT (''&
+   ' abcdefg x')
+write(astring, 1)
+if (astring.ne."' abcdefg x") call abort
+END
diff --git a/gcc/testsuite/gfortran.dg/continuation_2.f90 b/gcc/testsuite/gfortran.dg/continuation_2.f90
new file mode 100644
index 000000000..e72624856
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/continuation_2.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! PR 19260  Test line continuations and spaces.
+! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>.
+x = si&  ! { dg-error "Unclassifiable statement" }
+n(3.14159/2)
+end
diff --git a/gcc/testsuite/gfortran.dg/continuation_3.f90 b/gcc/testsuite/gfortran.dg/continuation_3.f90
new file mode 100644
index 000000000..169f06f65
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/continuation_3.f90
@@ -0,0 +1,91 @@
+! { dg-do compile }
+! { dg-options -std=f95 }
+! PR 19262  Test limit on line continuations. Test case derived form case in PR
+! by Steve Kargl.  Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+print *, &
+       "1" // & !  1
+       "2" // & !  2
+       "3" // & !  3
+       "4" // & !  4
+       "5" // & !  5
+       "6" // & !  6
+       "7" // & !  7
+       "8" // & !  8
+       "9" // & !  9
+       "0" // & ! 10
+       "1" // & ! 11
+       "2" // & ! 12
+       "3" // & ! 13
+       "4" // & ! 14
+       "5" // & ! 15
+       "6" // & ! 16
+       "7" // & ! 17
+       "8" // & ! 18
+       "9" // & ! 19
+       "0" // & ! 20
+       "1" // & ! 21
+       "2" // & ! 22
+       "3" // & ! 23
+       "4" // & ! 24
+       "5" // & ! 25
+       "6" // & ! 26
+       "7" // & ! 27
+       "8" // & ! 28
+       "9" // & ! 29
+       "0" // & ! 30
+       "1" // & ! 31
+       "2" // & ! 32
+       "3" // & ! 33
+       "4" // & ! 34
+       "5" // & ! 35
+       "6" // & ! 36
+       "7" // & ! 37
+       "8" // & ! 38
+       "9"
+print *, &
+       "1" // & !  1
+       "2" // & !  2
+       "3" // & !  3
+       "4" // & !  4
+       "5" // & !  5
+       "6" // & !  6
+       "7" // & !  7
+       "8" // & !  8
+       "9" // & !  9
+       "0" // & ! 10
+       "1" // & ! 11
+       "2" // & ! 12
+       "3" // & ! 13
+       "4" // & ! 14
+       "5" // & ! 15
+       "6" // & ! 16
+       "7" // & ! 17
+       "8" // & ! 18
+       "9" // & ! 19
+       "0" // & ! 20
+       "1" // & ! 21
+       "2" // & ! 22
+       "3" // & ! 23
+       "4" // & ! 24
+       "5" // & ! 25
+       "6" // & ! 26
+       "7" // & ! 27
+       "8" // & ! 28
+       "9" // & ! 29
+!
+   !
+       "0" // & ! 30
+       "1" // & ! 31
+!
+!
+       "2" // & ! 32
+       "3" // & ! 33
+       "4" // & ! 34
+       "5" // & ! 35
+       "6" // & ! 36
+       "7" // & ! 37
+       "8" // & ! 38
+       "9" // & ! 39
+       "0"      ! { dg-warning "Limit of 39 continuations exceeded" }
+
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/continuation_4.f90 b/gcc/testsuite/gfortran.dg/continuation_4.f90
new file mode 100644
index 000000000..7dfbf5d0c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/continuation_4.f90
@@ -0,0 +1,262 @@
+! { dg-do compile }
+! { dg-options -std=f2003 }
+! PR 19262  Test limit on line continuations. Test case derived form case in PR
+! by Steve Kargl.  Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+print *, &
+       "1" // & !  1  Counting in groups of 40.
+       "2" // & !  2
+       "3" // & !  3
+       "4" // & !  4
+       "5" // & !  5
+       "6" // & !  6
+       "7" // & !  7
+       "8" // & !  8
+       "9" // & !  9
+       "0" // & ! 10
+       "1" // & ! 11
+       "2" // & ! 12
+       "3" // & ! 13
+       "4" // & ! 14
+       "5" // & ! 15
+       "6" // & ! 16
+       "7" // & ! 17
+       "8" // & ! 18
+       "9" // & ! 19
+       "0" // & ! 20
+       "1" // & ! 21
+       "2" // & ! 22
+       "3" // & ! 23
+       "4" // & ! 24
+       "5" // & ! 25
+       "6" // & ! 26
+       "7" // & ! 27
+       "8" // & ! 28
+       "9" // & ! 29
+       "0" // & ! 30
+       "1" // & ! 31
+       "2" // & ! 32
+       "3" // & ! 33
+       "4" // & ! 34
+       "5" // & ! 35
+       "6" // & ! 36
+       "7" // & ! 37
+       "8" // & ! 38
+       "9" // & ! 39
+       "0" // & ! 40
+       "1" // & !  1
+       "2" // & !  2
+       "3" // & !  3
+       "4" // & !  4
+       "5" // & !  5
+       "6" // & !  6
+       "7" // & !  7
+       "8" // & !  8
+       "9" // & !  9
+       "0" // & ! 10
+       "1" // & ! 11
+       "2" // & ! 12
+       "3" // & ! 13
+       "4" // & ! 14
+       "5" // & ! 15
+       "6" // & ! 16
+       "7" // & ! 17
+       "8" // & ! 18
+       "9" // & ! 19
+       "0" // & ! 20
+       "1" // & ! 21
+       "2" // & ! 22
+       "3" // & ! 23
+       "4" // & ! 24
+       "5" // & ! 25
+       "6" // & ! 26
+       "7" // & ! 27
+       "8" // & ! 28
+       "9" // & ! 29
+       "0" // & ! 30
+       "1" // & ! 31
+       "2" // & ! 32
+       "3" // & ! 33
+       "4" // & ! 34
+       "5" // & ! 35
+       "6" // & ! 36
+       "7" // & ! 37
+       "8" // & ! 38
+       "9" // & ! 39
+       "0" // & ! 80
+       "1" // & !  1
+       "2" // & !  2
+       "3" // & !  3
+       "4" // & !  4
+       "5" // & !  5
+       "6" // & !  6
+       "7" // & !  7
+       "8" // & !  8
+       "9" // & !  9
+       "0" // & ! 10
+       "1" // & ! 11
+       "2" // & ! 12
+       "3" // & ! 13
+       "4" // & ! 14
+       "5" // & ! 15
+       "6" // & ! 16
+       "7" // & ! 17
+       "8" // & ! 18
+       "9" // & ! 19
+       "0" // & ! 20
+       "1" // & ! 21
+       "2" // & ! 22
+       "3" // & ! 23
+       "4" // & ! 24
+       "5" // & ! 25
+       "6" // & ! 26
+       "7" // & ! 27
+       "8" // & ! 28
+       "9" // & ! 29
+       "0" // & ! 30
+       "1" // & ! 31
+       "2" // & ! 32
+       "3" // & ! 33
+       "4" // & ! 34
+       "5" // & ! 35
+       "6" // & ! 36
+       "7" // & ! 37
+       "8" // & ! 38
+       "9" // & ! 39
+       "0" // & ! 120
+       "1" // & !  1
+       "2" // & !  2
+       "3" // & !  3
+       "4" // & !  4
+       "5" // & !  5
+       "6" // & !  6
+       "7" // & !  7
+       "8" // & !  8
+       "9" // & !  9
+       "0" // & ! 10
+       "1" // & ! 11
+       "2" // & ! 12
+       "3" // & ! 13
+       "4" // & ! 14
+       "5" // & ! 15
+       "6" // & ! 16
+       "7" // & ! 17
+       "8" // & ! 18
+       "9" // & ! 19
+       "0" // & ! 20
+       "1" // & ! 21
+       "2" // & ! 22
+       "3" // & ! 23
+       "4" // & ! 24
+       "5" // & ! 25
+       "6" // & ! 26
+       "7" // & ! 27
+       "8" // & ! 28
+       "9" // & ! 29
+       "0" // & ! 30
+       "1" // & ! 31
+       "2" // & ! 32
+       "3" // & ! 33
+       "4" // & ! 34
+       "5" // & ! 35
+       "6" // & ! 36
+       "7" // & ! 37
+       "8" // & ! 38
+       "9" // & ! 39
+       "0" // & ! 160
+       "1" // & !  1
+       "2" // & !  2
+       "3" // & !  3
+       "4" // & !  4
+       "5" // & !  5
+       "6" // & !  6
+       "7" // & !  7
+       "8" // & !  8
+       "9" // & !  9
+       "0" // & ! 10
+       "1" // & ! 11
+       "2" // & ! 12
+       "3" // & ! 13
+       "4" // & ! 14
+       "5" // & ! 15
+       "6" // & ! 16
+       "7" // & ! 17
+       "8" // & ! 18
+       "9" // & ! 19
+       "0" // & ! 20
+       "1" // & ! 21
+       "2" // & ! 22
+       "3" // & ! 23
+       "4" // & ! 24
+       "5" // & ! 25
+       "6" // & ! 26
+       "7" // & ! 27
+       "8" // & ! 28
+       "9" // & ! 29
+       "0" // & ! 30
+       "1" // & ! 31
+       "2" // & ! 32
+       "3" // & ! 33
+       "4" // & ! 34
+       "5" // & ! 35
+       "6" // & ! 36
+       "7" // & ! 37
+       "8" // & ! 38
+       "9" // & ! 39
+       "0" // & ! 200
+       "1" // & !  1
+       "2" // & !  2
+       "3" // & !  3
+       "4" // & !  4
+       "5" // & !  5
+       "6" // & !  6
+       "7" // & !  7
+       "8" // & !  8
+       "9" // & !  9
+       "0" // & ! 10
+       "1" // & ! 11
+       "2" // & ! 12
+       "3" // & ! 13
+       "4" // & ! 14
+       "5" // & ! 15
+       "6" // & ! 16
+       "7" // & ! 17
+       "8" // & ! 18
+       "9" // & ! 19
+       "0" // & ! 20
+       "1" // & ! 21
+       "2" // & ! 22
+       "3" // & ! 23
+       "4" // & ! 24
+       "5" // & ! 25
+       "6" // & ! 26
+       "7" // & ! 27
+       "8" // & ! 28
+       "9" // & ! 29
+       "0" // & ! 30
+       "1" // & ! 31
+       "2" // & ! 32
+       "3" // & ! 33
+       "4" // & ! 34
+       "5" // & ! 35
+       "6" // & ! 36
+       "7" // & ! 37
+       "8" // & ! 38
+       "9" // & ! 39
+       "0" // & ! 240
+       "1" // & !  1
+       "2" // & !  2
+       "3" // & !  3
+       "4" // & !  4
+       "5" // & !  5
+       "6" // & !  6
+       "7" // & !  7
+       "8" // & !  8
+       "9" // & !  9
+       "0" // & ! 10
+       "1" // & ! 11
+       "2" // & ! 12
+       "3" // & ! 13
+       "4" // & ! 14
+       "5" // & ! 255
+       "0"      ! { dg-warning "Limit of 255 continuations exceeded" }
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/continuation_5.f b/gcc/testsuite/gfortran.dg/continuation_5.f
new file mode 100644
index 000000000..aeb240368
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/continuation_5.f
@@ -0,0 +1,54 @@
+! { dg-do compile }
+! { dg-options -std=f95 }
+! PR 19262  Test limit on line continuations. Test case derived form case in PR
+! by Steve Kargl.  Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+       print *,
+     c "1" // !  1
+     c "2" // !  2
+     c "3" // !  3
+     c "4" // !  4
+     c "5" // !  5
+     c "6" // !  6
+     c "7" // !  7
+     c "8" // !  8
+     c "9" // !  9
+     c "0" // ! 10
+     c "1" // ! 11
+     c "2" // ! 12
+     c "3" // ! 13
+     c "4" // ! 14
+     c "5" // ! 15
+     c "6" // ! 16
+     c "7" // ! 17
+     c "8" // ! 18
+     c "9"    ! 19
+       print *,
+     c "1" // !  1
+     c "2" // !  2
+     c "3" // !  3
+     c "4" // !  4
+     c "5" // !  5
+     c "6" // !  6
+     c "7" // !  7
+     c "8" // !  8
+     c "9" // !  9
+!
+c
+*
+C
+     c "0" // ! 10
+     c "1" // ! 11
+     c "2" // ! 12
+     c "3" // ! 13
+     c "4" // ! 14
+c
+ 
+ !
+                          !
+     c "5" // ! 15
+     c "6" // ! 16
+     c "7" // ! 17
+     c "8" // ! 18
+     c "9" // ! 19
+     c "0"    ! { dg-warning "Limit of 19 continuations exceeded" }
+       end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/continuation_6.f b/gcc/testsuite/gfortran.dg/continuation_6.f
new file mode 100644
index 000000000..9bf64ad4e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/continuation_6.f
@@ -0,0 +1,264 @@
+! { dg-do compile }
+! { dg-options -std=f2003 }
+! PR 19262  Test limit on line continuations. Test case derived form case in PR
+! by Steve Kargl.  Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+       print *,
+     c "1" // !  1 Counting by 40.
+     c "2" // !  2
+     c "3" // !  3
+     c "4" // !  4
+     c "5" // !  5
+     c "6" // !  6
+     c "7" // !  7
+     c "8" // !  8
+     c "9" // !  9
+     c "0" // ! 10
+     c "1" // ! 11
+     c "2" // ! 12
+     c "3" // ! 13
+     c "4" // ! 14
+     c "5" // ! 15
+     c "6" // ! 16
+     c "7" // ! 17
+     c "8" // ! 18
+     c "9" // ! 19
+     c "0" // ! 20
+     c "1" // ! 21
+     c "2" // ! 22
+     c "3" // ! 23
+     c "4" // ! 24
+     c "5" // ! 25
+     c "6" // ! 26
+     c "7" // ! 27
+     c "8" // ! 28
+     c "9" // ! 29
+     c "0" // ! 30
+     c "1" // ! 31
+     c "2" // ! 32
+     c "3" // ! 33
+     c "4" // ! 34
+     c "5" // ! 35
+     c "6" // ! 36
+     c "7" // ! 37
+     c "8" // ! 38
+     c "9" // ! 39
+     c "0" // ! 40
+     c "1" // !  1
+     c "2" // !  2
+     c "3" // !  3
+     c "4" // !  4
+     c "5" // !  5
+     c "6" // !  6
+     c "7" // !  7
+     c "8" // !  8
+     c "9" // !  9
+     c "0" // ! 10
+     c "1" // ! 11
+     c "2" // ! 12
+     c "3" // ! 13
+     c "4" // ! 14
+     c "5" // ! 15
+     c "6" // ! 16
+     c "7" // ! 17
+     c "8" // ! 18
+     c "9" // ! 19
+     c "0" // ! 20
+     c "1" // ! 21
+     c "2" // ! 22
+     c "3" // ! 23
+     c "4" // ! 24
+     c "5" // ! 25
+     c "6" // ! 26
+     c "7" // ! 27
+     c "8" // ! 28
+     c "9" // ! 29
+     c "0" // ! 30
+     c "1" // ! 31
+     c "2" // ! 32
+     c "3" // ! 33
+     c "4" // ! 34
+     c "5" // ! 35
+     c "6" // ! 36
+     c "7" // ! 37
+     c "8" // ! 38
+     c "9" // ! 39
+     c "0" // ! 80
+     c "1" // !  1
+     c "2" // !  2
+     c "3" // !  3
+     c "4" // !  4
+     c "5" // !  5
+     c "6" // !  6
+     c "7" // !  7
+     c "8" // !  8
+     c "9" // !  9
+     c "0" // ! 10
+     c "1" // ! 11
+     c "2" // ! 12
+     c "3" // ! 13
+     c "4" // ! 14
+     c "5" // ! 15
+     c "6" // ! 16
+     c "7" // ! 17
+     c "8" // ! 18
+     c "9" // ! 19
+     c "0" // ! 20
+     c "1" // ! 21
+     c "2" // ! 22
+     c "3" // ! 23
+     c "4" // ! 24
+     c "5" // ! 25
+     c "6" // ! 26
+     c "7" // ! 27
+     c "8" // ! 28
+     c "9" // ! 29
+     c "0" // ! 30
+     c "1" // ! 31
+     c "2" // ! 32
+     c "3" // ! 33
+     c "4" // ! 34
+     c "5" // ! 35
+     c "6" // ! 36
+     c "7" // ! 37
+     c "8" // ! 38
+     c "9" // ! 39
+     c "0" // ! 120
+     c "1" // !  1
+     c "2" // !  2
+     c "3" // !  3
+     c "4" // !  4
+     c "5" // !  5
+     c "6" // !  6
+     c "7" // !  7
+     c "8" // !  8
+     c "9" // !  9
+     c "0" // ! 10
+     c "1" // ! 11
+     c "2" // ! 12
+     c "3" // ! 13
+     c "4" // ! 14
+     c "5" // ! 15
+     c "6" // ! 16
+     c "7" // ! 17
+     c "8" // ! 18
+     c "9" // ! 19
+     c "0" // ! 20
+     c "1" // ! 21
+     c "2" // ! 22
+     c "3" // ! 23
+     c "4" // ! 24
+     c "5" // ! 25
+     c "6" // ! 26
+     c "7" // ! 27
+     c "8" // ! 28
+     c "9" // ! 29
+     c "0" // ! 30
+     c "1" // ! 31
+     c "2" // ! 32
+     c "3" // ! 33
+     c "4" // ! 34
+     c "5" // ! 35
+     c "6" // ! 36
+     c "7" // ! 37
+     c "8" // ! 38
+     c "9" // ! 39
+     c "0" // ! 160
+     c "1" // !  1
+     c "2" // !  2
+     c "3" // !  3
+     c "4" // !  4
+     c "5" // !  5
+     c "6" // !  6
+     c "7" // !  7
+     c "8" // !  8
+     c "9" // !  9
+     c "0" // ! 10
+     c "1" // ! 11
+     c "2" // ! 12
+     c "3" // ! 13
+     c "4" // ! 14
+     c "5" // ! 15
+     c "6" // ! 16
+     c "7" // ! 17
+     c "8" // ! 18
+     c "9" // ! 19
+     c "0" // ! 20
+     c "1" // ! 21
+     c "2" // ! 22
+     c "3" // ! 23
+     c "4" // ! 24
+     c "5" // ! 25
+     c "6" // ! 26
+     c "7" // ! 27
+     c "8" // ! 28
+     c "9" // ! 29
+     c "0" // ! 30
+     c "1" // ! 31
+     c "2" // ! 32
+     c "3" // ! 33
+     c "4" // ! 34
+     c "5" // ! 35
+     c "6" // ! 36
+     c "7" // ! 37
+     c "8" // ! 38
+     c "9" // ! 39
+     c "0" // ! 200
+     c "1" // !  1
+     c "2" // !  2
+     c "3" // !  3
+     c "4" // !  4
+     c "5" // !  5
+     c "6" // !  6
+     c "7" // !  7
+     c "8" // !  8
+     c "9" // !  9
+     c "0" // ! 10
+     c "1" // ! 11
+     c "2" // ! 12
+     c "3" // ! 13
+     c "4" // ! 14
+     c "5" // ! 15
+     c "6" // ! 16
+     c "7" // ! 17
+     c "8" // ! 18
+     c "9" // ! 19
+     c "0" // ! 20
+     c "1" // ! 21
+     c "2" // ! 22
+     c "3" // ! 23
+     c "4" // ! 24
+     c "5" // ! 25
+     c "6" // ! 26
+     c "7" // ! 27
+     c "8" // ! 28
+     c "9" // ! 29
+     c "0" // ! 30
+     c "1" // ! 31
+     c "2" // ! 32
+     c "3" // ! 33
+     c "4" // ! 34
+     c "5" // ! 35
+     c "6" // ! 36
+     c "7" // ! 37
+     c "8" // ! 38
+     c "9" // ! 39
+     c "0" // ! 240
+     c "1" // !  1
+     c "2" // !  2
+     c "3" // !  3
+     c "4" // !  4
+     c "5" // !  5
+     c "6" // !  6
+     c "7" // !  7
+     c "8" // !  8
+     c "9" // !  9
+     c "0" // ! 10
+     c "1" // ! 11
+     c "2" // ! 12
+     c "3" // ! 13
+     c "4" // ! 14
+     c "5" // ! 255 
+     c "6"    ! { dg-warning "Limit of 255 continuations exceeded" }
+     
+       end
+       
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/continuation_7.f90 b/gcc/testsuite/gfortran.dg/continuation_7.f90
new file mode 100644
index 000000000..02602e86a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/continuation_7.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-Wall -std=f95" }
+! There should only two warnings be printed.
+! PR fortran/30968
+print *, "Foo bar&
+        &Bar foo"
+print *, "Foo bar&
+        Bar foo" ! { dg-warning "Missing '&' in continued character constant" }
+print *, "Foo bar"&
+        &, "Bar foo"
+print *, "Foo bar"&
+        , "Bar foo"
+
+print '(&
+    a)', 'Hello' ! { dg-warning "Missing '&' in continued character constant" }
+print '(&
+   &a)', 'Hello'
+print '('&
+   &//'a)', 'Hello'
+print '('&
+   // "a)", 'Hello'
+end
diff --git a/gcc/testsuite/gfortran.dg/continuation_8.f90 b/gcc/testsuite/gfortran.dg/continuation_8.f90
new file mode 100644
index 000000000..251af99ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/continuation_8.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! PR31495 Is this continuation legal? 
+program print_ascertain
+character (len=50) :: str
+str = "hello world &
+&    &
+&!"
+if (str.ne."hello world     !") call abort
+end program print_ascertain
diff --git a/gcc/testsuite/gfortran.dg/continuation_9.f90 b/gcc/testsuite/gfortran.dg/continuation_9.f90
new file mode 100644
index 000000000..04a7c331e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/continuation_9.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+  &  
+&
+ &
+end
+! { dg-warning "not allowed by itself in line 3" "" {target "*-*-*"} 0 }
+! { dg-warning "not allowed by itself in line 4" "" {target "*-*-*"} 0 }
+! { dg-warning "not allowed by itself in line 5" "" {target "*-*-*"} 0 }
diff --git a/gcc/testsuite/gfortran.dg/convert_1.f90 b/gcc/testsuite/gfortran.dg/convert_1.f90
new file mode 100644
index 000000000..87d3babb6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/convert_1.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! PR 26201: Check that the __convert_*_* functions are treated as intrinsics
+! rather than module functions.
+! Testcase contributed by Philippe Schaffnit and François-Xavier Coudert.
+MODULE MODULE_A
+    REAL :: a = 0
+END MODULE MODULE_A
+
+MODULE MODULE_B
+    REAL :: b = 0
+END MODULE MODULE_B
+
+USE MODULE_A
+USE MODULE_B
+a = 0
+END
+
+! { dg-final { cleanup-modules "MODULE_A MODULE_B" } }
diff --git a/gcc/testsuite/gfortran.dg/convert_2.f90 b/gcc/testsuite/gfortran.dg/convert_2.f90
new file mode 100644
index 000000000..9f9060688
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/convert_2.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! Check for correct ordering of character variables with CONVERT
+
+program main
+  implicit none
+  integer, parameter :: two_swap = 2**25
+  integer(kind=4) i,j
+  character(len=2) :: c,d
+  open(20,file="convert.dat",form="unformatted",convert="swap") ! { dg-warning "CONVERT" }
+  write (20) "ab"
+  close (20)
+  open(20,file="convert.dat",form="unformatted",access="stream")
+  read(20) i,c,j
+  if (i .ne. two_swap .or. j .ne. two_swap .or. c .ne. "ab") call abort
+  close (20)
+  open(20,file="convert.dat",form="unformatted",convert="swap") ! { dg-warning "CONVERT" }
+  read (20) d
+  close (20,status="delete")
+  if (d .ne. "ab") call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/convert_implied_open.f90 b/gcc/testsuite/gfortran.dg/convert_implied_open.f90
new file mode 100644
index 000000000..9c25b5d96
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/convert_implied_open.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-fconvert=swap" }
+! PR 26735 - implied open didn't use to honor -fconvert
+program main
+  implicit none
+  integer (kind=4) :: i1, i2, i3
+  write (10) 1_4
+  close (10)
+  open (10, form="unformatted", access="direct", recl=4)
+  read (10,rec=1) i1
+  read (10,rec=2) i2
+  read (10,rec=3) i3
+  if (i1 /= 4 .or. i2 /= 1 .or. i3 /= 4) call abort
+  close (10,status="delete")
+end program main
diff --git a/gcc/testsuite/gfortran.dg/count_init_expr.f03 b/gcc/testsuite/gfortran.dg/count_init_expr.f03
new file mode 100644
index 000000000..ad7b74b96
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/count_init_expr.f03
@@ -0,0 +1,15 @@
+! { dg-do run }
+
+  INTEGER            :: i
+  INTEGER, PARAMETER :: m(4,4) = RESHAPE([ (i, i=1, 16) ], [4, 4] )
+  INTEGER, PARAMETER :: sevens = COUNT (m == 7)
+  INTEGER, PARAMETER :: odd(4) = COUNT (MOD(m, 2) == 1, dim=1)
+  INTEGER, PARAMETER :: even = COUNT (MOD(m, 2) == 0)
+
+  IF (sevens /= 1) CALL abort()
+  IF (ANY(odd /= [ 2,2,2,2 ])) CALL abort()
+  IF (even /= 8) CALL abort()
+
+  ! check the kind parameter
+  IF (KIND(COUNT (m == 7, KIND=2)) /= 2) CALL abort()
+END
diff --git a/gcc/testsuite/gfortran.dg/count_mask_1.f90 b/gcc/testsuite/gfortran.dg/count_mask_1.f90
new file mode 100644
index 000000000..f9859fa2d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/count_mask_1.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+! PR 36590, PR 36681
+program test
+  logical(kind=1),parameter     :: t=.true.,f=.false.
+  logical(kind=1),dimension(9)  :: hexa,hexb
+  data hexa/f,f,t,t,f,f,f,t,f/,hexb/f,t,f,f,f,t,t,f,f/
+  isum=count(hexa(1:9).eqv.hexb(1:9))
+end program   
diff --git a/gcc/testsuite/gfortran.dg/cr_lf.f90 b/gcc/testsuite/gfortran.dg/cr_lf.f90
new file mode 100644
index 000000000..eb5500e01
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cr_lf.f90
@@ -0,0 +1,64 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+! PR41328 and PR41168 Improper read of CR-LF sequences.
+! Test case prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program main
+   implicit none
+   integer :: iostat, n_chars_read, k
+   character(len=1) :: buffer(64) = ""
+   character (len=80) :: u
+
+   ! Set up the test file with normal file end.
+   open(unit=10, file="crlftest", form="unformatted", access="stream",&
+   & status="replace")
+   write(10) "a\rb\rc\r" ! CR at the end of each record.
+   close(10, status="keep")
+
+   open(unit=10, file="crlftest", form="formatted", status="old")
+   
+   read( unit=10, fmt='(64A)', advance='NO', iostat=iostat,          &
+         size=n_chars_read ) buffer
+   if (n_chars_read.ne.1) call abort
+   if (any(buffer(1:n_chars_read).ne."a")) call abort
+   if (.not.is_iostat_eor(iostat)) call abort
+
+   read( unit=10, fmt='(64A)', advance='NO', iostat=iostat,          &
+         size=n_chars_read ) buffer
+   if (n_chars_read.ne.1) call abort
+   if (any(buffer(1:n_chars_read).ne."b")) call abort
+   if (.not.is_iostat_eor(iostat)) call abort
+
+   read( unit=10, fmt='(64A)', advance='NO', iostat=iostat,          &
+         size=n_chars_read ) buffer
+   if (n_chars_read.ne.1) call abort
+   if (any(buffer(1:n_chars_read).ne."c")) call abort
+   if (.not.is_iostat_eor(iostat)) call abort
+
+   read( unit=10, fmt='(64A)', advance='NO', iostat=iostat,          &
+         size=n_chars_read ) buffer
+   if (n_chars_read.ne.0) call abort
+   if (any(buffer(1:n_chars_read).ne."a")) call abort
+   if (.not.is_iostat_end(iostat)) call abort
+   close(10, status="delete")
+
+   ! Set up the test file with normal file end.
+   open(unit=10, file="crlftest", form="unformatted", access="stream",&
+   & status="replace")
+   write(10) "a\rb\rc\rno end of line marker" ! Note, no CR at end of file.
+   close(10, status="keep")
+
+   open(unit=10, file="crlftest", status='old')
+
+   do k = 1, 10
+     read(10,'(a80)',end=101,err=100) u
+     !print *,k,' : ',u(1:len_trim(u))
+   enddo
+   
+100 continue
+   close(10, status="delete")
+   call abort
+
+101 continue
+   close(10, status="delete")
+   if (u(1:len_trim(u)).ne."no end of line marker") call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/cray_pointers_1.f90 b/gcc/testsuite/gfortran.dg/cray_pointers_1.f90
new file mode 100644
index 000000000..87ace6848
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cray_pointers_1.f90
@@ -0,0 +1,68 @@
+! { dg-do compile }
+! { dg-options "-fcray-pointer" }
+
+! Bad type for pointer
+subroutine err1
+  real ipt
+  real array(10)
+  pointer (ipt, array) ! { dg-error "integer" }
+end subroutine err1
+
+! Multiple declarations for the same pointee
+subroutine err2
+  real array(10)
+  pointer (ipt1, array)
+  pointer (ipt2, array) ! { dg-error "multiple" }
+end subroutine err2
+
+! Vector assignment to an assumed size array
+subroutine err3
+  real target(10)
+  real array(*)
+  pointer (ipt, array)
+  ipt = loc (target)
+  array = 0    ! { dg-error "upper bound in the last dimension" }
+end subroutine err3
+
+subroutine err4
+  pointer (ipt, ipt) ! { dg-error "POINTER attribute" }
+end subroutine err4
+
+! duplicate array specs
+subroutine err5
+  pointer (ipt, array(7))
+  real array(10)      ! { dg-error "Duplicate array" }  
+end subroutine err5
+
+subroutine err6
+  real array(10)
+  pointer (ipt, array(7))  ! { dg-error "Duplicate array" }
+end subroutine err6
+
+! parsing stuff
+subroutine err7
+  pointer (                  ! { dg-error "variable name" }
+  pointer (ipt               ! { dg-error "Expected" }
+  pointer (ipt,              ! { dg-error "variable name" }
+  pointer (ipt,a1            ! { dg-error "Expected" }
+  pointer (ipt,a2),          ! { dg-error "Expected" }
+  pointer (ipt,a3),(         ! { dg-error "variable name" }
+  pointer (ipt,a4),(ipt2     ! { dg-error "Expected" }
+  pointer (ipt,a5),(ipt2,    ! { dg-error "variable name" }
+  pointer (ipt,a6),(ipt2,a7  ! { dg-error "Expected" }
+end subroutine err7
+
+! more attributes
+subroutine err8(array)
+  real array(10)
+  integer dim(2)
+  integer, pointer :: f90ptr
+  integer, target :: f90targ
+  pointer (ipt, array)    ! { dg-error "DUMMY" }
+  pointer (dim, elt1)     ! { dg-error "DIMENSION" }
+  pointer (f90ptr, elt2)  ! { dg-error "POINTER" }
+  pointer (ipt, f90ptr)   ! { dg-error "POINTER" }
+  pointer (f90targ, elt3) ! { dg-error "TARGET" }
+  pointer (ipt, f90targ)  ! { dg-error "TARGET" }
+end subroutine err8
+
diff --git a/gcc/testsuite/gfortran.dg/cray_pointers_2.f90 b/gcc/testsuite/gfortran.dg/cray_pointers_2.f90
new file mode 100644
index 000000000..82ce29159
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cray_pointers_2.f90
@@ -0,0 +1,3614 @@
+! Using two spaces between dg-do and run is a hack to keep gfortran-dg-runtest
+! from cycling through optimization options for this expensive test.
+! { dg-do  run }
+! { dg-options "-O3 -fcray-pointer -fbounds-check -fno-inline" }
+! { dg-timeout-factor 4 }
+!
+! Series of routines for testing a Cray pointer implementation
+!
+! Note: Some of the test cases violate Fortran's alias rules;
+! the "-fno-inline option" for now prevents failures.
+!
+program craytest
+  common /errors/errors(400)
+  common /foo/foo ! To prevent optimizations
+  integer foo
+  integer i
+  logical errors
+  errors = .false.
+  foo = 0
+  call ptr1
+  call ptr2
+  call ptr3
+  call ptr4
+  call ptr5
+  call ptr6
+  call ptr7
+  call ptr8
+  call ptr9(9,10,11)
+  call ptr10(9,10,11)
+  call ptr11(9,10,11)
+  call ptr12(9,10,11)
+  call ptr13(9,10)
+  call parmtest
+! NOTE: Tests 1 through 12 were removed from this file
+! and placed in loc_1.f90, so we start at 13
+  do i=13,400
+     if (errors(i)) then
+!        print *,"Test",i,"failed."
+        call abort()
+     endif
+  end do
+  if (foo.eq.0) then
+!     print *,"Test did not run correctly."
+     call abort()
+  endif
+end program craytest
+
+! ptr1 through ptr13 that Cray pointees are correctly used with
+! a variety of declaration styles
+subroutine ptr1
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  type(drvd) dpte1(n)
+  type(drvd) dpte2(m,n)
+  type(drvd) dpte3(o,m,n)
+  integer ipte1 (n)
+  integer ipte2 (m,n)
+  integer ipte3 (o,m,n)
+  real rpte1(n)
+  real rpte2(m,n)
+  real rpte3(o,m,n)
+  character chpte1(n)
+  character chpte2(m,n)
+  character chpte3(o,m,n)
+  character*8 ch8pte1(n)
+  character*8 ch8pte2(m,n)
+  character*8 ch8pte3(o,m,n)
+
+  pointer(iptr1,dpte1)
+  pointer(iptr2,dpte2)
+  pointer(iptr3,dpte3)
+  pointer(iptr4,ipte1)
+  pointer(iptr5,ipte2)
+  pointer(iptr6,ipte3)
+  pointer(iptr7,rpte1)
+  pointer(iptr8,rpte2)
+  pointer(iptr9,rpte3)
+  pointer(iptr10,chpte1)
+  pointer(iptr11,chpte2)
+  pointer(iptr12,chpte3)
+  pointer(iptr13,ch8pte1)
+  pointer(iptr14,ch8pte2)
+  pointer(iptr15,ch8pte3)
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #13
+        errors(13) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #14
+        errors(14) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #15
+        errors(15) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #16
+        errors(16) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #17
+        errors(17) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #18
+        errors(18) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #19
+        errors(19) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #20
+        errors(20) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #21
+        errors(21) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #22
+        errors(22) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #23
+           errors(23) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #24
+           errors(24) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #25
+           errors(25) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #26
+           errors(26) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #27
+           errors(27) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #28
+           errors(28) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #29
+           errors(29) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #30
+           errors(30) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #31
+           errors(31) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #32
+           errors(32) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #33
+              errors(33) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #34
+              errors(34) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #35
+              errors(35) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #36
+              errors(36) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #37
+              errors(37) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #38
+              errors(38) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #39
+              errors(39) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #40
+              errors(40) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #41
+              errors(41) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #42
+              errors(42) = .true.
+           endif
+        end do
+     end do
+  end do
+
+  rtarg3 = .5
+  ! Vector syntax
+  do, i=1,n
+     ipte3 = i
+     rpte3 = rpte3+1
+     do, j=1,m
+        do k=1,o
+           if (intne(itarg3(k,j,i), i)) then
+              ! Error #43
+              errors(43) = .true.
+           endif
+
+           if (realne(rtarg3(k,j,i), i+.5)) then
+              ! Error #44
+              errors(44) = .true.
+           endif
+        end do
+     end do
+  end do
+
+end subroutine ptr1
+
+
+subroutine ptr2
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  type(drvd) dpte1
+  type(drvd) dpte2
+  type(drvd) dpte3
+  integer ipte1
+  integer ipte2
+  integer ipte3
+  real rpte1
+  real rpte2
+  real rpte3
+  character chpte1
+  character chpte2
+  character chpte3
+  character*8 ch8pte1
+  character*8 ch8pte2
+  character*8 ch8pte3
+
+  pointer(iptr1,dpte1(n))
+  pointer(iptr2,dpte2(m,n))
+  pointer(iptr3,dpte3(o,m,n))
+  pointer(iptr4,ipte1(n))
+  pointer(iptr5,ipte2 (m,n))
+  pointer(iptr6,ipte3(o,m,n))
+  pointer(iptr7,rpte1(n))
+  pointer(iptr8,rpte2(m,n))
+  pointer(iptr9,rpte3(o,m,n))
+  pointer(iptr10,chpte1(n))
+  pointer(iptr11,chpte2(m,n))
+  pointer(iptr12,chpte3(o,m,n))
+  pointer(iptr13,ch8pte1(n))
+  pointer(iptr14,ch8pte2(m,n))
+  pointer(iptr15,ch8pte3(o,m,n))
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #45
+        errors(45) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #46
+        errors(46) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #47
+        errors(47) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #48
+        errors(48) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #49
+        errors(49) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #50
+        errors(50) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #51
+        errors(51) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #52
+        errors(52) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #53
+        errors(53) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #54
+        errors(54) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #55
+           errors(55) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #56
+           errors(56) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #57
+           errors(57) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #58
+           errors(58) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #59
+           errors(59) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #60
+           errors(60) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #61
+           errors(61) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #62
+           errors(62) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #63
+           errors(63) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #64
+           errors(64) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #65
+              errors(65) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #66
+              errors(66) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #67
+              errors(67) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #68
+              errors(68) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #69
+              errors(69) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #70
+              errors(70) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #71
+              errors(71) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #72
+              errors(72) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #73
+              errors(73) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #74
+              errors(74) = .true.
+           endif
+        end do
+     end do
+  end do
+
+  rtarg3 = .5
+  ! Vector syntax
+  do, i=1,n
+     ipte3 = i
+     rpte3 = rpte3+1
+     do, j=1,m
+        do k=1,o
+           if (intne(itarg3(k,j,i), i)) then
+              ! Error #75
+              errors(75) = .true.
+           endif
+
+           if (realne(rtarg3(k,j,i), i+.5)) then
+              ! Error #76
+              errors(76) = .true.
+           endif
+        end do
+     end do
+  end do
+end subroutine ptr2
+
+subroutine ptr3
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  pointer(iptr1,dpte1(n))
+  pointer(iptr2,dpte2(m,n))
+  pointer(iptr3,dpte3(o,m,n))
+  pointer(iptr4,ipte1(n))
+  pointer(iptr5,ipte2 (m,n))
+  pointer(iptr6,ipte3(o,m,n))
+  pointer(iptr7,rpte1(n))
+  pointer(iptr8,rpte2(m,n))
+  pointer(iptr9,rpte3(o,m,n))
+  pointer(iptr10,chpte1(n))
+  pointer(iptr11,chpte2(m,n))
+  pointer(iptr12,chpte3(o,m,n))
+  pointer(iptr13,ch8pte1(n))
+  pointer(iptr14,ch8pte2(m,n))
+  pointer(iptr15,ch8pte3(o,m,n))
+
+  type(drvd) dpte1
+  type(drvd) dpte2
+  type(drvd) dpte3
+  integer ipte1
+  integer ipte2
+  integer ipte3
+  real rpte1
+  real rpte2
+  real rpte3
+  character chpte1
+  character chpte2
+  character chpte3
+  character*8 ch8pte1
+  character*8 ch8pte2
+  character*8 ch8pte3
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #77
+        errors(77) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #78
+        errors(78) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #79
+        errors(79) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #80
+        errors(80) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #81
+        errors(81) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #82
+        errors(82) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #83
+        errors(83) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #84
+        errors(84) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #85
+        errors(85) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #86
+        errors(86) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #87
+           errors(87) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #88
+           errors(88) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #89
+           errors(89) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #90
+           errors(90) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #91
+           errors(91) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #92
+           errors(92) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #93
+           errors(93) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #94
+           errors(94) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #95
+           errors(95) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #96
+           errors(96) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #97
+              errors(97) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #98
+              errors(98) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #99
+              errors(99) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #100
+              errors(100) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #101
+              errors(101) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #102
+              errors(102) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #103
+              errors(103) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #104
+              errors(104) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #105
+              errors(105) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #106
+              errors(106) = .true.
+           endif
+        end do
+     end do
+  end do
+
+  rtarg3 = .5
+  ! Vector syntax
+  do, i=1,n
+     ipte3 = i
+     rpte3 = rpte3+1
+     do, j=1,m
+        do k=1,o
+           if (intne(itarg3(k,j,i), i)) then
+              ! Error #107
+              errors(107) = .true.
+           endif
+
+           if (realne(rtarg3(k,j,i), i+.5)) then
+              ! Error #108
+              errors(108) = .true.
+           endif
+        end do
+     end do
+  end do
+end subroutine ptr3
+
+subroutine ptr4
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  pointer(iptr1,dpte1),(iptr2,dpte2),(iptr3,dpte3)
+  pointer    (iptr4,ipte1),  (iptr5,ipte2) ,(iptr6,ipte3),(iptr7,rpte1)
+  pointer(iptr8,rpte2)
+  pointer(iptr9,rpte3),(iptr10,chpte1)
+  pointer(iptr11,chpte2),(iptr12,chpte3),(iptr13,ch8pte1)
+  pointer(iptr14,ch8pte2)
+  pointer(iptr15,ch8pte3)
+
+  type(drvd) dpte1(n)
+  type(drvd) dpte2(m,n)
+  type(drvd) dpte3(o,m,n)
+  integer ipte1 (n)
+  integer ipte2 (m,n)
+  integer ipte3 (o,m,n)
+  real rpte1(n)
+  real rpte2(m,n)
+  real rpte3(o,m,n)
+  character chpte1(n)
+  character chpte2(m,n)
+  character chpte3(o,m,n)
+  character*8 ch8pte1(n)
+  character*8 ch8pte2(m,n)
+  character*8 ch8pte3(o,m,n)
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #109
+        errors(109) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #110
+        errors(110) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #111
+        errors(111) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #112
+        errors(112) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #113
+        errors(113) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #114
+        errors(114) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #115
+        errors(115) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #116
+        errors(116) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #117
+        errors(117) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #118
+        errors(118) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #119
+           errors(119) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #120
+           errors(120) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #121
+           errors(121) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #122
+           errors(122) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #123
+           errors(123) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #124
+           errors(124) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #125
+           errors(125) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #126
+           errors(126) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #127
+           errors(127) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #128
+           errors(128) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #129
+              errors(129) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #130
+              errors(130) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #131
+              errors(131) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #132
+              errors(132) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #133
+              errors(133) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #134
+              errors(134) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #135
+              errors(135) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #136
+              errors(136) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #137
+              errors(137) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #138
+              errors(138) = .true.
+           endif
+        end do
+     end do
+  end do
+
+  rtarg3 = .5
+  ! Vector syntax
+  do, i=1,n
+     ipte3 = i
+     rpte3 = rpte3+1
+     do, j=1,m
+        do k=1,o
+           if (intne(itarg3(k,j,i), i)) then
+              ! Error #139
+              errors(139) = .true.
+           endif
+
+           if (realne(rtarg3(k,j,i), i+.5)) then
+              ! Error #140
+              errors(140) = .true.
+           endif
+        end do
+     end do
+  end do
+
+end subroutine ptr4
+
+subroutine ptr5
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  type(drvd) dpte1(*)
+  type(drvd) dpte2(m,*)
+  type(drvd) dpte3(o,m,*)
+  integer ipte1 (*)
+  integer ipte2 (m,*)
+  integer ipte3 (o,m,*)
+  real rpte1(*)
+  real rpte2(m,*)
+  real rpte3(o,m,*)
+  character chpte1(*)
+  character chpte2(m,*)
+  character chpte3(o,m,*)
+  character*8 ch8pte1(*)
+  character*8 ch8pte2(m,*)
+  character*8 ch8pte3(o,m,*)
+
+  pointer(iptr1,dpte1)
+  pointer(iptr2,dpte2)
+  pointer(iptr3,dpte3)
+  pointer(iptr4,ipte1)
+  pointer(iptr5,ipte2)
+  pointer(iptr6,ipte3)
+  pointer(iptr7,rpte1)
+  pointer(iptr8,rpte2)
+  pointer(iptr9,rpte3)
+  pointer(iptr10,chpte1)
+  pointer(iptr11,chpte2)
+  pointer(iptr12,chpte3)
+  pointer(iptr13,ch8pte1)
+  pointer(iptr14,ch8pte2)
+  pointer(iptr15,ch8pte3)
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #141
+        errors(141) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #142
+        errors(142) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #143
+        errors(143) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #144
+        errors(144) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #145
+        errors(145) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #146
+        errors(146) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #147
+        errors(147) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #148
+        errors(148) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #149
+        errors(149) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #150
+        errors(150) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #151
+           errors(151) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #152
+           errors(152) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #153
+           errors(153) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #154
+           errors(154) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #155
+           errors(155) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #156
+           errors(156) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #157
+           errors(157) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #158
+           errors(158) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #159
+           errors(159) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #160
+           errors(160) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #161
+              errors(161) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #162
+              errors(162) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #163
+              errors(163) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #164
+              errors(164) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #165
+              errors(165) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #166
+              errors(166) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #167
+              errors(167) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #168
+              errors(168) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #169
+              errors(169) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #170
+              errors(170) = .true.
+           endif
+        end do
+     end do
+  end do
+
+end subroutine ptr5
+
+
+subroutine ptr6
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  type(drvd) dpte1
+  type(drvd) dpte2
+  type(drvd) dpte3
+  integer ipte1
+  integer ipte2
+  integer ipte3
+  real rpte1
+  real rpte2
+  real rpte3
+  character chpte1
+  character chpte2
+  character chpte3
+  character*8 ch8pte1
+  character*8 ch8pte2
+  character*8 ch8pte3
+
+  pointer(iptr1,dpte1(*))
+  pointer(iptr2,dpte2(m,*))
+  pointer(iptr3,dpte3(o,m,*))
+  pointer(iptr4,ipte1(*))
+  pointer(iptr5,ipte2 (m,*))
+  pointer(iptr6,ipte3(o,m,*))
+  pointer(iptr7,rpte1(*))
+  pointer(iptr8,rpte2(m,*))
+  pointer(iptr9,rpte3(o,m,*))
+  pointer(iptr10,chpte1(*))
+  pointer(iptr11,chpte2(m,*))
+  pointer(iptr12,chpte3(o,m,*))
+  pointer(iptr13,ch8pte1(*))
+  pointer(iptr14,ch8pte2(m,*))
+  pointer(iptr15,ch8pte3(o,m,*))
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #171
+        errors(171) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #172
+        errors(172) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #173
+        errors(173) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #174
+        errors(174) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #175
+        errors(175) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #176
+        errors(176) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #177
+        errors(177) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #178
+        errors(178) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #179
+        errors(179) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #180
+        errors(180) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #181
+           errors(181) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #182
+           errors(182) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #183
+           errors(183) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #184
+           errors(184) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #185
+           errors(185) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #186
+           errors(186) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #187
+           errors(187) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #188
+           errors(188) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #189
+           errors(189) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #190
+           errors(190) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #191
+              errors(191) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #192
+              errors(192) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #193
+              errors(193) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #194
+              errors(194) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #195
+              errors(195) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #196
+              errors(196) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #197
+              errors(197) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #198
+              errors(198) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #199
+              errors(199) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #200
+              errors(200) = .true.
+           endif
+        end do
+     end do
+  end do
+
+end subroutine ptr6
+
+subroutine ptr7
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  pointer(iptr1,dpte1(*))
+  pointer(iptr2,dpte2(m,*))
+  pointer(iptr3,dpte3(o,m,*))
+  pointer(iptr4,ipte1(*))
+  pointer(iptr5,ipte2 (m,*))
+  pointer(iptr6,ipte3(o,m,*))
+  pointer(iptr7,rpte1(*))
+  pointer(iptr8,rpte2(m,*))
+  pointer(iptr9,rpte3(o,m,*))
+  pointer(iptr10,chpte1(*))
+  pointer(iptr11,chpte2(m,*))
+  pointer(iptr12,chpte3(o,m,*))
+  pointer(iptr13,ch8pte1(*))
+  pointer(iptr14,ch8pte2(m,*))
+  pointer(iptr15,ch8pte3(o,m,*))
+
+  type(drvd) dpte1
+  type(drvd) dpte2
+  type(drvd) dpte3
+  integer ipte1
+  integer ipte2
+  integer ipte3
+  real rpte1
+  real rpte2
+  real rpte3
+  character chpte1
+  character chpte2
+  character chpte3
+  character*8 ch8pte1
+  character*8 ch8pte2
+  character*8 ch8pte3
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #201
+        errors(201) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #202
+        errors(202) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #203
+        errors(203) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #204
+        errors(204) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #205
+        errors(205) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #206
+        errors(206) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #207
+        errors(207) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #208
+        errors(208) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #209
+        errors(209) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #210
+        errors(210) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #211
+           errors(211) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #212
+           errors(212) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #213
+           errors(213) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #214
+           errors(214) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #215
+           errors(215) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #216
+           errors(216) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #217
+           errors(217) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #218
+           errors(218) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #219
+           errors(219) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #220
+           errors(220) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #221
+              errors(221) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #222
+              errors(222) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #223
+              errors(223) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #224
+              errors(224) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #225
+              errors(225) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #226
+              errors(226) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #227
+              errors(227) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #228
+              errors(228) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #229
+              errors(229) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #230
+              errors(230) = .true.
+           endif
+        end do
+     end do
+  end do
+
+end subroutine ptr7
+
+subroutine ptr8
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  pointer(iptr1,dpte1)
+  pointer(iptr2,dpte2)
+  pointer(iptr3,dpte3)
+  pointer(iptr4,ipte1)
+  pointer(iptr5,ipte2)
+  pointer(iptr6,ipte3)
+  pointer(iptr7,rpte1)
+  pointer(iptr8,rpte2)
+  pointer(iptr9,rpte3)
+  pointer(iptr10,chpte1)
+  pointer(iptr11,chpte2)
+  pointer(iptr12,chpte3)
+  pointer(iptr13,ch8pte1)
+  pointer(iptr14,ch8pte2)
+  pointer(iptr15,ch8pte3)
+
+  type(drvd) dpte1(*)
+  type(drvd) dpte2(m,*)
+  type(drvd) dpte3(o,m,*)
+  integer ipte1 (*)
+  integer ipte2 (m,*)
+  integer ipte3 (o,m,*)
+  real rpte1(*)
+  real rpte2(m,*)
+  real rpte3(o,m,*)
+  character chpte1(*)
+  character chpte2(m,*)
+  character chpte3(o,m,*)
+  character*8 ch8pte1(*)
+  character*8 ch8pte2(m,*)
+  character*8 ch8pte3(o,m,*)
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #231
+        errors(231) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #232
+        errors(232) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #233
+        errors(233) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #234
+        errors(234) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #235
+        errors(235) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #236
+        errors(236) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #237
+        errors(237) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #238
+        errors(238) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #239
+        errors(239) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #240
+        errors(240) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #241
+           errors(241) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #242
+           errors(242) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #243
+           errors(243) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #244
+           errors(244) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #245
+           errors(245) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #246
+           errors(246) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #247
+           errors(247) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #248
+           errors(248) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #249
+           errors(249) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #250
+           errors(250) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #251
+              errors(251) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #252
+              errors(252) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #253
+              errors(253) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #254
+              errors(254) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #255
+              errors(255) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #256
+              errors(256) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #257
+              errors(257) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #258
+              errors(258) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #259
+              errors(259) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #260
+              errors(260) = .true.
+           endif
+        end do
+     end do
+  end do
+end subroutine ptr8
+
+
+subroutine ptr9(nnn,mmm,ooo)
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer :: nnn,mmm,ooo
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  type(drvd) dpte1(nnn)
+  type(drvd) dpte2(mmm,nnn)
+  type(drvd) dpte3(ooo,mmm,nnn)
+  integer ipte1 (nnn)
+  integer ipte2 (mmm,nnn)
+  integer ipte3 (ooo,mmm,nnn)
+  real rpte1(nnn)
+  real rpte2(mmm,nnn)
+  real rpte3(ooo,mmm,nnn)
+  character chpte1(nnn)
+  character chpte2(mmm,nnn)
+  character chpte3(ooo,mmm,nnn)
+  character*8 ch8pte1(nnn)
+  character*8 ch8pte2(mmm,nnn)
+  character*8 ch8pte3(ooo,mmm,nnn)
+
+  pointer(iptr1,dpte1)
+  pointer(iptr2,dpte2)
+  pointer(iptr3,dpte3)
+  pointer(iptr4,ipte1)
+  pointer(iptr5,ipte2)
+  pointer(iptr6,ipte3)
+  pointer(iptr7,rpte1)
+  pointer(iptr8,rpte2)
+  pointer(iptr9,rpte3)
+  pointer(iptr10,chpte1)
+  pointer(iptr11,chpte2)
+  pointer(iptr12,chpte3)
+  pointer(iptr13,ch8pte1)
+  pointer(iptr14,ch8pte2)
+  pointer(iptr15,ch8pte3)
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #261
+        errors(261) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #262
+        errors(262) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #263
+        errors(263) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #264
+        errors(264) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #265
+        errors(265) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #266
+        errors(266) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #267
+        errors(267) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #268
+        errors(268) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #269
+        errors(269) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #270
+        errors(270) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #271
+           errors(271) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #272
+           errors(272) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #273
+           errors(273) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #274
+           errors(274) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #275
+           errors(275) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #276
+           errors(276) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #277
+           errors(277) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #278
+           errors(278) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #279
+           errors(279) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #280
+           errors(280) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #281
+              errors(281) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #282
+              errors(282) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #283
+              errors(283) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #284
+              errors(284) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #285
+              errors(285) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #286
+              errors(286) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #287
+              errors(287) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #288
+              errors(288) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #289
+              errors(289) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #290
+              errors(290) = .true.
+           endif
+        end do
+     end do
+  end do
+
+  rtarg3 = .5
+  ! Vector syntax
+  do, i=1,n
+     ipte3 = i
+     rpte3 = rpte3+1
+     do, j=1,m
+        do k=1,o
+           if (intne(itarg3(k,j,i), i)) then
+              ! Error #291
+              errors(291) = .true.
+           endif
+
+           if (realne(rtarg3(k,j,i), i+.5)) then
+              ! Error #292
+              errors(292) = .true.
+           endif
+        end do
+     end do
+  end do
+
+end subroutine ptr9
+
+subroutine ptr10(nnn,mmm,ooo)
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer :: nnn,mmm,ooo
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  type(drvd) dpte1
+  type(drvd) dpte2
+  type(drvd) dpte3
+  integer ipte1
+  integer ipte2
+  integer ipte3
+  real rpte1
+  real rpte2
+  real rpte3
+  character chpte1
+  character chpte2
+  character chpte3
+  character*8 ch8pte1
+  character*8 ch8pte2
+  character*8 ch8pte3
+
+  pointer(iptr1,dpte1(nnn))
+  pointer(iptr2,dpte2(mmm,nnn))
+  pointer(iptr3,dpte3(ooo,mmm,nnn))
+  pointer(iptr4,ipte1(nnn))
+  pointer(iptr5,ipte2 (mmm,nnn))
+  pointer(iptr6,ipte3(ooo,mmm,nnn))
+  pointer(iptr7,rpte1(nnn))
+  pointer(iptr8,rpte2(mmm,nnn))
+  pointer(iptr9,rpte3(ooo,mmm,nnn))
+  pointer(iptr10,chpte1(nnn))
+  pointer(iptr11,chpte2(mmm,nnn))
+  pointer(iptr12,chpte3(ooo,mmm,nnn))
+  pointer(iptr13,ch8pte1(nnn))
+  pointer(iptr14,ch8pte2(mmm,nnn))
+  pointer(iptr15,ch8pte3(ooo,mmm,nnn))
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #293
+        errors(293) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #294
+        errors(294) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #295
+        errors(295) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #296
+        errors(296) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #297
+        errors(297) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #298
+        errors(298) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #299
+        errors(299) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #300
+        errors(300) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #301
+        errors(301) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #302
+        errors(302) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #303
+           errors(303) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #304
+           errors(304) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #305
+           errors(305) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #306
+           errors(306) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #307
+           errors(307) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #308
+           errors(308) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #309
+           errors(309) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #310
+           errors(310) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #311
+           errors(311) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #312
+           errors(312) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #313
+              errors(313) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #314
+              errors(314) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #315
+              errors(315) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #316
+              errors(316) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #317
+              errors(317) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #318
+              errors(318) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #319
+              errors(319) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #320
+              errors(320) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #321
+              errors(321) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #322
+              errors(322) = .true.
+           endif
+        end do
+     end do
+  end do
+
+  rtarg3 = .5
+  ! Vector syntax
+  do, i=1,n
+     ipte3 = i
+     rpte3 = rpte3+1
+     do, j=1,m
+        do k=1,o
+           if (intne(itarg3(k,j,i), i)) then
+              ! Error #323
+              errors(323) = .true.
+           endif
+
+           if (realne(rtarg3(k,j,i), i+.5)) then
+              ! Error #324
+              errors(324) = .true.
+           endif
+        end do
+     end do
+  end do
+end subroutine ptr10
+
+subroutine ptr11(nnn,mmm,ooo)
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer :: nnn,mmm,ooo
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  pointer(iptr1,dpte1(nnn))
+  pointer(iptr2,dpte2(mmm,nnn))
+  pointer(iptr3,dpte3(ooo,mmm,nnn))
+  pointer(iptr4,ipte1(nnn))
+  pointer(iptr5,ipte2 (mmm,nnn))
+  pointer(iptr6,ipte3(ooo,mmm,nnn))
+  pointer(iptr7,rpte1(nnn))
+  pointer(iptr8,rpte2(mmm,nnn))
+  pointer(iptr9,rpte3(ooo,mmm,nnn))
+  pointer(iptr10,chpte1(nnn))
+  pointer(iptr11,chpte2(mmm,nnn))
+  pointer(iptr12,chpte3(ooo,mmm,nnn))
+  pointer(iptr13,ch8pte1(nnn))
+  pointer(iptr14,ch8pte2(mmm,nnn))
+  pointer(iptr15,ch8pte3(ooo,mmm,nnn))
+
+  type(drvd) dpte1
+  type(drvd) dpte2
+  type(drvd) dpte3
+  integer ipte1
+  integer ipte2
+  integer ipte3
+  real rpte1
+  real rpte2
+  real rpte3
+  character chpte1
+  character chpte2
+  character chpte3
+  character*8 ch8pte1
+  character*8 ch8pte2
+  character*8 ch8pte3
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #325
+        errors(325) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #326
+        errors(326) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #327
+        errors(327) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #328
+        errors(328) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #329
+        errors(329) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #330
+        errors(330) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #331
+        errors(331) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #332
+        errors(332) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #333
+        errors(333) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #334
+        errors(334) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #335
+           errors(335) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #336
+           errors(336) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #337
+           errors(337) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #338
+           errors(338) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #339
+           errors(339) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #340
+           errors(340) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #341
+           errors(341) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #342
+           errors(342) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #343
+           errors(343) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #344
+           errors(344) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #345
+              errors(345) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #346
+              errors(346) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #347
+              errors(347) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #348
+              errors(348) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #349
+              errors(349) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #350
+              errors(350) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #351
+              errors(351) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #352
+              errors(352) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #353
+              errors(353) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #354
+              errors(354) = .true.
+           endif
+        end do
+     end do
+  end do
+
+  rtarg3 = .5
+  ! Vector syntax
+  do, i=1,n
+     ipte3 = i
+     rpte3 = rpte3+1
+     do, j=1,m
+        do k=1,o
+           if (intne(itarg3(k,j,i), i)) then
+              ! Error #355
+              errors(355) = .true.
+           endif
+
+           if (realne(rtarg3(k,j,i), i+.5)) then
+              ! Error #356
+              errors(356) = .true.
+           endif
+        end do
+     end do
+  end do
+end subroutine ptr11
+
+subroutine ptr12(nnn,mmm,ooo)
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: i,j,k
+  integer :: nnn,mmm,ooo
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+  type drvd
+     real r1
+     integer i1
+     integer i2(5)
+  end type drvd
+  type(drvd) dtarg1(n)
+  type(drvd) dtarg2(m,n)
+  type(drvd) dtarg3(o,m,n)
+
+  pointer(iptr1,dpte1)
+  pointer(iptr2,dpte2)
+  pointer(iptr3,dpte3)
+  pointer(iptr4,ipte1)
+  pointer(iptr5,ipte2)
+  pointer(iptr6,ipte3)
+  pointer(iptr7,rpte1)
+  pointer(iptr8,rpte2)
+  pointer(iptr9,rpte3)
+  pointer(iptr10,chpte1)
+  pointer(iptr11,chpte2)
+  pointer(iptr12,chpte3)
+  pointer(iptr13,ch8pte1)
+  pointer(iptr14,ch8pte2)
+  pointer(iptr15,ch8pte3)
+
+  type(drvd) dpte1(nnn)
+  type(drvd) dpte2(mmm,nnn)
+  type(drvd) dpte3(ooo,mmm,nnn)
+  integer ipte1 (nnn)
+  integer ipte2 (mmm,nnn)
+  integer ipte3 (ooo,mmm,nnn)
+  real rpte1(nnn)
+  real rpte2(mmm,nnn)
+  real rpte3(ooo,mmm,nnn)
+  character chpte1(nnn)
+  character chpte2(mmm,nnn)
+  character chpte3(ooo,mmm,nnn)
+  character*8 ch8pte1(nnn)
+  character*8 ch8pte2(mmm,nnn)
+  character*8 ch8pte3(ooo,mmm,nnn)
+
+  iptr1 = loc(dtarg1)
+  iptr2 = loc(dtarg2)
+  iptr3 = loc(dtarg3)
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr6 = loc(itarg3)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)
+  iptr9 = loc(rtarg3)
+  iptr10= loc(chtarg1)
+  iptr11= loc(chtarg2)
+  iptr12= loc(chtarg3)
+  iptr13= loc(ch8targ1)
+  iptr14= loc(ch8targ2)
+  iptr15= loc(ch8targ3)
+
+
+  do, i=1,n
+     dpte1(i)%i1=i
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #357
+        errors(357) = .true.
+     endif
+
+     dtarg1(i)%i1=2*dpte1(i)%i1
+     if (intne(dpte1(i)%i1, dtarg1(i)%i1)) then
+        ! Error #358
+        errors(358) = .true.
+     endif
+
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #359
+        errors(359) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #360
+        errors(360) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #361
+        errors(361) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #362
+        errors(362) = .true.
+     endif
+
+     chpte1(i) = 'a'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #363
+        errors(363) = .true.
+     endif
+
+     chtarg1(i) = 'z'
+     if (chne(chpte1(i), chtarg1(i))) then
+        ! Error #364
+        errors(364) = .true.
+     endif
+
+     ch8pte1(i) = 'aaaaaaaa'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #365
+        errors(365) = .true.
+     endif
+
+     ch8targ1(i) = 'zzzzzzzz'
+     if (ch8ne(ch8pte1(i), ch8targ1(i))) then
+        ! Error #366
+        errors(366) = .true.
+     endif
+
+     do, j=1,m
+        dpte2(j,i)%r1=1.0
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #367
+           errors(367) = .true.
+        endif
+
+        dtarg2(j,i)%r1=2*dpte2(j,i)%r1
+        if (realne(dpte2(j,i)%r1, dtarg2(j,i)%r1)) then
+           ! Error #368
+           errors(368) = .true.
+        endif
+
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #369
+           errors(369) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #370
+           errors(370) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #371
+           errors(371) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #372
+           errors(372) = .true.
+        endif
+
+        chpte2(j,i) = 'a'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #373
+           errors(373) = .true.
+        endif
+
+        chtarg2(j,i) = 'z'
+        if (chne(chpte2(j,i), chtarg2(j,i))) then
+           ! Error #374
+           errors(374) = .true.
+        endif
+
+        ch8pte2(j,i) = 'aaaaaaaa'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #375
+           errors(375) = .true.
+        endif
+
+        ch8targ2(j,i) = 'zzzzzzzz'
+        if (ch8ne(ch8pte2(j,i), ch8targ2(j,i))) then
+           ! Error #376
+           errors(376) = .true.
+        endif
+        do k=1,o
+           dpte3(k,j,i)%i2(1+mod(i,5))=i
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #377
+              errors(377) = .true.
+           endif
+
+           dtarg3(k,j,i)%i2(1+mod(i,5))=2*dpte3(k,j,i)%i2(1+mod(i,5))
+           if (intne(dpte3(k,j,i)%i2(1+mod(i,5)), &
+                dtarg3(k,j,i)%i2(1+mod(i,5)))) then
+              ! Error #378
+              errors(378) = .true.
+           endif
+
+           ipte3(k,j,i) = i
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #379
+              errors(379) = .true.
+           endif
+
+           itarg3(k,j,i) = -ipte3(k,j,i)
+           if (intne(ipte3(k,j,i), itarg3(k,j,i))) then
+              ! Error #380
+              errors(380) = .true.
+           endif
+
+           rpte3(k,j,i) = i * 2.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #381
+              errors(381) = .true.
+           endif
+
+           rtarg3(k,j,i) = i * 3.0
+           if (realne(rpte3(k,j,i), rtarg3(k,j,i))) then
+              ! Error #382
+              errors(382) = .true.
+           endif
+
+           chpte3(k,j,i) = 'a'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #383
+              errors(383) = .true.
+           endif
+
+           chtarg3(k,j,i) = 'z'
+           if (chne(chpte3(k,j,i), chtarg3(k,j,i))) then
+              ! Error #384
+              errors(384) = .true.
+           endif
+
+           ch8pte3(k,j,i) = 'aaaaaaaa'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #385
+              errors(385) = .true.
+           endif
+
+           ch8targ3(k,j,i) = 'zzzzzzzz'
+           if (ch8ne(ch8pte3(k,j,i), ch8targ3(k,j,i))) then
+              ! Error #386
+              errors(386) = .true.
+           endif
+        end do
+     end do
+  end do
+
+  rtarg3 = .5
+  ! Vector syntax
+  do, i=1,n
+     ipte3 = i
+     rpte3 = rpte3+1
+     do, j=1,m
+        do k=1,o
+           if (intne(itarg3(k,j,i), i)) then
+              ! Error #387
+              errors(387) = .true.
+           endif
+
+           if (realne(rtarg3(k,j,i), i+.5)) then
+              ! Error #388
+              errors(388) = .true.
+           endif
+        end do
+     end do
+  end do
+
+end subroutine ptr12
+
+! Misc
+subroutine ptr13(nnn,mmm)
+  common /errors/errors(400)
+  logical :: errors, intne, realne, chne, ch8ne
+  integer :: nnn,mmm
+  integer :: i,j
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+
+  integer ipte1
+  integer ipte2
+  real rpte1
+  real rpte2
+
+  dimension ipte1(n)
+  dimension rpte2(mmm,nnn)
+
+  pointer(iptr4,ipte1)
+  pointer(iptr5,ipte2)
+  pointer(iptr7,rpte1)
+  pointer(iptr8,rpte2)
+
+  dimension ipte2(mmm,nnn)
+  dimension rpte1(n)
+
+  iptr4 = loc(itarg1)
+  iptr5 = loc(itarg2)
+  iptr7 = loc(rtarg1)
+  iptr8 = loc(rtarg2)  
+
+  do, i=1,n
+     ipte1(i) = i
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #389
+        errors(389) = .true.
+     endif
+
+     itarg1(i) = -ipte1(i)
+     if (intne(ipte1(i), itarg1(i))) then
+        ! Error #390
+        errors(390) = .true.
+     endif
+
+     rpte1(i) = i * 5.0
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #391
+        errors(391) = .true.
+     endif
+
+     rtarg1(i) = i * (-5.0)
+     if (realne(rpte1(i), rtarg1(i))) then
+        ! Error #392
+        errors(392) = .true.
+     endif
+
+     do, j=1,m
+        ipte2(j,i) = i
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #393
+           errors(393) = .true.
+        endif
+
+        itarg2(j,i) = -ipte2(j,i)
+        if (intne(ipte2(j,i), itarg2(j,i))) then
+           ! Error #394
+           errors(394) = .true.
+        endif
+
+        rpte2(j,i) = i * (-2.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #395
+           errors(395) = .true.
+        endif
+
+        rtarg2(j,i) = i * (-3.0)
+        if (realne(rpte2(j,i), rtarg2(j,i))) then
+           ! Error #396
+           errors(396) = .true.
+        endif
+
+     end do
+  end do
+end subroutine ptr13
+
+
+! Test the passing of pointers and pointees as parameters
+subroutine parmtest
+  integer, parameter :: n = 12
+  integer, parameter :: m = 13
+  integer iarray(m,n)
+  pointer (ipt,iptee)
+  integer iptee (m,n)
+
+  ipt = loc(iarray)
+  !  write(*,*) "loc(iarray)",loc(iarray)
+  call parmptr(ipt,iarray,n,m)
+  !  write(*,*) "loc(iptee)",loc(iptee)
+  call parmpte(iptee,iarray,n,m)
+end subroutine parmtest
+
+subroutine parmptr(ipointer,intarr,n,m)
+  common /errors/errors(400)
+  logical :: errors, intne
+  integer :: n,m,i,j
+  integer intarr(m,n)
+  pointer (ipointer,newpte)
+  integer newpte(m,n)
+  ! write(*,*) "loc(newpte)",loc(newpte)
+  ! write(*,*) "loc(intarr)",loc(intarr) 
+  ! write(*,*) "loc(newpte(1,1))",loc(newpte(1,1))
+  ! newpte(1,1) = 101
+  ! write(*,*) "newpte(1,1)=",newpte(1,1)
+  ! write(*,*) "intarr(1,1)=",intarr(1,1)
+  do, i=1,n
+     do, j=1,m
+        newpte(j,i) = i
+        if (intne(newpte(j,i),intarr(j,i))) then
+           ! Error #397
+           errors(397) = .true.
+        endif
+
+        call donothing(newpte(j,i),intarr(j,i))
+        intarr(j,i) = -newpte(j,i)
+        if (intne(newpte(j,i),intarr(j,i))) then
+           ! Error #398
+           errors(398) = .true.
+        endif
+     end do
+  end do
+end subroutine parmptr
+
+subroutine parmpte(pointee,intarr,n,m)
+  common /errors/errors(400)
+  logical :: errors, intne
+  integer :: n,m,i,j
+  integer pointee (m,n)
+  integer intarr (m,n)
+  !  write(*,*) "loc(pointee)",loc(pointee)
+  !  write(*,*) "loc(intarr)",loc(intarr)
+  !  write(*,*) "loc(pointee(1,1))",loc(pointee(1,1))
+  !  pointee(1,1) = 99
+  !  write(*,*) "pointee(1,1)=",pointee(1,1)
+  !  write(*,*) "intarr(1,1)=",intarr(1,1)
+
+  do, i=1,n
+     do, j=1,m
+        pointee(j,i) = i
+        if (intne(pointee(j,i),intarr(j,i))) then
+           ! Error #399
+           errors(399) = .true.
+        endif
+
+        intarr(j,i) = 2*pointee(j,i)
+        call donothing(pointee(j,i),intarr(j,i))
+        if (intne(pointee(j,i),intarr(j,i))) then
+           ! Error #400
+           errors(400) = .true.
+        endif
+     end do
+  end do
+end subroutine parmpte
+
+! Separate function calls to break Cray pointer-indifferent optimization
+logical function intne(ii,jj)
+  integer :: i,j
+  common /foo/foo
+  integer foo
+  foo = foo + 1
+  intne = ii.ne.jj
+  if (intne) then
+     write (*,*) ii," doesn't equal ",jj
+  endif
+end function intne
+
+logical function realne(r1,r2)
+  real :: r1, r2  
+  common /foo/foo
+  integer foo
+  foo = foo + 1
+  realne = r1.ne.r2
+  if (realne) then
+     write (*,*) r1," doesn't equal ",r2
+  endif
+end function realne
+
+logical function chne(ch1,ch2)
+  character :: ch1, ch2  
+  common /foo/foo
+  integer foo
+  foo = foo + 1
+  chne = ch1.ne.ch2
+  if (chne) then
+     write (*,*) ch1," doesn't equal ",ch2
+  endif
+end function chne
+
+logical function ch8ne(ch1,ch2)
+  character*8 :: ch1, ch2  
+  common /foo/foo
+  integer foo
+  foo = foo + 1
+  ch8ne = ch1.ne.ch2
+  if (ch8ne) then
+     write (*,*) ch1," doesn't equal ",ch2
+  endif
+end function ch8ne
+
+subroutine donothing(ii,jj)
+  common/foo/foo
+  integer :: ii,jj,foo
+  if (foo.le.1) then
+     foo = 1
+  else
+     foo = foo - 1
+  endif
+  if (foo.eq.0) then
+     ii = -1
+     jj = 1
+!     print *,"Test did not run correctly"
+     call abort()
+  endif
+end subroutine donothing
+
diff --git a/gcc/testsuite/gfortran.dg/cray_pointers_3.f90 b/gcc/testsuite/gfortran.dg/cray_pointers_3.f90
new file mode 100644
index 000000000..de50eee77
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cray_pointers_3.f90
@@ -0,0 +1,5 @@
+! { dg-do compile }
+program crayerr
+  real dpte1(10)
+  pointer (iptr1,dpte1) ! { dg-error "fcray-pointer" }
+end program crayerr
diff --git a/gcc/testsuite/gfortran.dg/cray_pointers_4.f90 b/gcc/testsuite/gfortran.dg/cray_pointers_4.f90
new file mode 100644
index 000000000..85e7ae758
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cray_pointers_4.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-fcray-pointer" }
+
+subroutine err1
+  integer :: in_common1, in_common2, v, w, equiv1, equiv2
+  common /in_common1/ in_common1
+  pointer (ipt1, in_common1)		! { dg-error "conflicts with COMMON" }
+  pointer (ipt2, in_common2)
+  common /in_common2/ in_common2	! { dg-error "conflicts with COMMON" }
+  equivalence (v, equiv1)
+  pointer (ipt3, equiv1)		! { dg-error "conflicts with EQUIVALENCE" }
+  pointer (ipt4, equiv2)
+  equivalence (w, equiv2)		! { dg-error "conflicts with EQUIVALENCE" }
+end subroutine err1
diff --git a/gcc/testsuite/gfortran.dg/cray_pointers_5.f90 b/gcc/testsuite/gfortran.dg/cray_pointers_5.f90
new file mode 100644
index 000000000..21081194b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cray_pointers_5.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! { dg-options "-fcray-pointer -fno-strict-aliasing" }
+
+module cray_pointers_5
+  integer :: var (10), arr(100)
+  pointer (ipt, var)
+end module cray_pointers_5
+
+  use cray_pointers_5
+  integer :: i
+
+  forall (i = 1:100) arr(i) = i
+  ipt = loc (arr)
+  if (any (var .ne. (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10/))) call abort
+end
+
+! { dg-final { cleanup-modules "cray_pointers_5" } }
diff --git a/gcc/testsuite/gfortran.dg/cray_pointers_6.f90 b/gcc/testsuite/gfortran.dg/cray_pointers_6.f90
new file mode 100644
index 000000000..f89f88092
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cray_pointers_6.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-fcray-pointer" }
+! PR fortran/25358 
+subroutine adw_set
+   implicit none
+   real*8    Adw_xabcd_8(*)  
+   pointer(Adw_xabcd_8_ , Adw_xabcd_8)
+   common/ Adw / Adw_xabcd_8_
+   integer n
+   Adw_xabcd_8(1:n) = 1
+   return
+end subroutine adw_set
diff --git a/gcc/testsuite/gfortran.dg/cray_pointers_7.f90 b/gcc/testsuite/gfortran.dg/cray_pointers_7.f90
new file mode 100644
index 000000000..1fe52c0af
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cray_pointers_7.f90
@@ -0,0 +1,43 @@
+! { dg-do run }
+! { dg-options "-fcray-pointer" }
+
+! Test the implementation of Cray pointers to procedures.
+program cray_pointers_7
+  implicit none
+  integer tmp
+  integer, external :: fn
+  external sub
+  
+  ! We can't mix function and subroutine pointers.
+  pointer (subptr,subpte)
+  pointer (fnptr,fnpte)
+  
+  ! Declare pointee types.
+  external subpte
+  integer, external :: fnpte
+  
+  tmp = 0
+  
+  ! Check pointers to subroutines.
+  subptr = loc(sub)
+  call subpte(tmp)
+  if (tmp .ne. 17) call abort()
+
+  ! Check pointers to functions.
+  fnptr = loc(fn)
+  tmp = fnpte(7)
+  if (tmp .ne. 14) call abort()
+  
+end program cray_pointers_7
+
+! Trivial subroutine to be called through a Cray pointer.
+subroutine sub(i)
+  integer i
+  i = 17
+end subroutine sub
+
+! Trivial function to be called through a Cray pointer.
+function fn(i)
+  integer fn,i
+  fn = 2*i
+end function fn
diff --git a/gcc/testsuite/gfortran.dg/cray_pointers_8.f90 b/gcc/testsuite/gfortran.dg/cray_pointers_8.f90
new file mode 100644
index 000000000..887c9625a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cray_pointers_8.f90
@@ -0,0 +1,63 @@
+! { dg-do run }
+! { dg-options "-fcray-pointer" }
+!
+! Test the fix for PR36528 in which the Cray pointer was not passed
+! correctly to 'euler' so that an undefined reference to fcn was
+! generated by the linker.
+!
+! Reported by Tobias Burnus  <burnus@gcc.gnu.org>
+! from http://groups.google.com/group/comp.lang.fortran/msg/86b65bad78e6af78
+!
+real function p1(x)
+  real, intent(in) :: x
+  p1 = x
+end
+
+real function euler(xp,xk,dx,f)
+  real, intent(in) :: xp, xk, dx
+  interface
+    real function f(x)
+      real, intent(in) :: x
+    end function
+  end interface
+  real x, y
+  y = 0.0
+  x = xp
+  do while (x .le. xk)
+    y = y + f(x)*dx
+    x = x + dx
+  end do
+  euler = y
+end
+program main
+  interface
+    real function p1 (x)
+      real, intent(in) :: x
+    end function
+    real function fcn (x)
+      real, intent(in) :: x
+    end function
+    real function euler (xp,xk,dx,f)
+      real, intent(in) :: xp, xk ,dx
+      interface
+        real function f(x)
+          real, intent(in) :: x
+        end function
+      end interface
+    end function
+  end interface
+  real x, xp, xk, dx, y, z
+  pointer (pfcn, fcn)
+  pfcn = loc(p1)
+  xp = 0.0
+  xk = 1.0
+  dx = 0.0005
+  y = 0.0
+  x = xp
+  do while (x .le. xk)
+    y = y + fcn(x)*dx
+    x = x + dx
+  end do
+  z = euler(0.0,1.0,0.0005,fcn)
+  if (abs (y - z) .gt. 1e-6) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/cray_pointers_9.f90 b/gcc/testsuite/gfortran.dg/cray_pointers_9.f90
new file mode 100644
index 000000000..81bcb199a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cray_pointers_9.f90
@@ -0,0 +1,104 @@
+! { dg-do compile }
+! { dg-options "-fcray-pointer" }
+!
+! Test the fix for PR36703 in which the Cray pointer was not passed
+! correctly so that the call to 'fun' at line 102 caused an ICE.
+!
+! Contributed by James van Buskirk on com.lang.fortran
+! http://groups.google.com/group/comp.lang.fortran/msg/b600c081a3654936
+! Reported by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+module funcs
+   use ISO_C_BINDING           ! Added this USE statement
+   implicit none
+! Interface block for function program fptr will invoke
+! to get the C_FUNPTR
+   interface
+      function get_proc(mess) bind(C,name='BlAh')
+         use ISO_C_BINDING
+         implicit none
+         character(kind=C_CHAR) mess(*)
+         type(C_FUNPTR) get_proc
+      end function get_proc
+   end interface
+end module funcs
+
+module other_fun
+   use ISO_C_BINDING
+   implicit none
+   private
+! Message to be returned by procedure pointed to
+! by the C_FUNPTR
+   character, allocatable, save :: my_message(:)
+! Interface block for the procedure pointed to
+! by the C_FUNPTR
+   public abstract_fun
+   abstract interface
+      function abstract_fun(x)
+         use ISO_C_BINDING
+         import my_message
+         implicit none
+         integer(C_INT) x(:)
+         character(size(my_message),C_CHAR) abstract_fun(size(x))
+      end function abstract_fun
+   end interface
+   contains
+! Procedure to store the message and get the C_FUNPTR
+      function gp(message) bind(C,name='BlAh')
+         character(kind=C_CHAR) message(*)
+         type(C_FUNPTR) gp
+         integer(C_INT64_T) i
+
+         i = 1
+         do while(message(i) /= C_NULL_CHAR)
+            i = i+1
+         end do
+	 allocate (my_message(i+1))      ! Added this allocation
+         my_message = message(int(1,kind(i)):i-1)
+         gp = get_funloc(make_mess,aux)
+      end function gp
+
+! Intermediate procedure to pass the function and get
+! back the C_FUNPTR
+      function get_funloc(x,y)
+         procedure(abstract_fun) x
+         type(C_FUNPTR) y
+         external y
+         type(C_FUNPTR) get_funloc
+
+         get_funloc = y(x)
+      end function get_funloc
+
+! Procedure to convert the function to C_FUNPTR
+      function aux(x)
+         interface
+            subroutine x() bind(C)
+            end subroutine x
+         end interface
+         type(C_FUNPTR) aux
+
+         aux = C_FUNLOC(x)
+      end function aux
+
+! Procedure pointed to by the C_FUNPTR
+      function make_mess(x)
+         integer(C_INT) x(:)
+         character(size(my_message),C_CHAR) make_mess(size(x))
+
+         make_mess = transfer(my_message,make_mess(1))
+      end function make_mess
+end module other_fun
+
+program fptr
+   use funcs
+   use other_fun
+   implicit none
+   procedure(abstract_fun) fun        ! Removed INTERFACE
+   pointer(p,fun)
+   type(C_FUNPTR) fp
+
+   fp = get_proc('Hello, world'//achar(0))
+   p = transfer(fp,p)
+   write(*,'(a)') fun([1,2,3])
+end program fptr
+! { dg-final { cleanup-modules "funcs other_fun" } }
diff --git a/gcc/testsuite/gfortran.dg/cshift_bounds_1.f90 b/gcc/testsuite/gfortran.dg/cshift_bounds_1.f90
new file mode 100644
index 000000000..5932004f2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cshift_bounds_1.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! Check that empty arrays are handled correctly in
+! cshift and eoshift
+program main
+  character(len=50) :: line
+  character(len=3), dimension(2,2) :: a, b
+  integer :: n1, n2
+  line = '-1-2'
+  read (line,'(2I2)') n1, n2
+  call foo(a, b, n1, n2)
+  a = 'abc'
+  write (line,'(4A)') eoshift(a, 3)
+  write (line,'(4A)') cshift(a, 3)
+  write (line,'(4A)') cshift(a(:,1:n1), 3)
+  write (line,'(4A)') eoshift(a(1:n2,:), 3)
+end program main
+
+subroutine foo(a, b, n1, n2)
+  character(len=3), dimension(2, n1) :: a
+  character(len=3), dimension(n2, 2) :: b
+  a = cshift(b,1)
+  a = eoshift(b,1)
+end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/cshift_bounds_2.f90 b/gcc/testsuite/gfortran.dg/cshift_bounds_2.f90
new file mode 100644
index 000000000..0f3c75f4e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cshift_bounds_2.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! { dg-options "-fbounds-check -fno-realloc-lhs" }
+! { dg-shouldfail "Incorrect extent in return value of CSHIFT intrinsic in dimension 2: is 3, should be 2" }
+program main
+  integer, dimension(:,:), allocatable :: a, b
+  allocate (a(2,2))
+  allocate (b(2,3))
+  a = 1
+  b = cshift(a,1)
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return value of CSHIFT intrinsic in dimension 2: is 3, should be 2" }
diff --git a/gcc/testsuite/gfortran.dg/cshift_bounds_3.f90 b/gcc/testsuite/gfortran.dg/cshift_bounds_3.f90
new file mode 100644
index 000000000..33e387f32
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cshift_bounds_3.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect size in SHIFT argument of CSHIFT intrinsic: should not be zero-sized" }
+program main
+  real, dimension(1,0) :: a, b, c
+  integer :: sp(3), i
+  a = 4.0
+  sp = 1
+  i = 1
+  b = cshift (a,sp(1:i)) ! Invalid
+end program main
+! { dg-output "Fortran runtime error: Incorrect size in SHIFT argument of CSHIFT intrinsic: should not be zero-sized" }
diff --git a/gcc/testsuite/gfortran.dg/cshift_bounds_4.f90 b/gcc/testsuite/gfortran.dg/cshift_bounds_4.f90
new file mode 100644
index 000000000..4a3fcfbd1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cshift_bounds_4.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-shouldfail "Incorrect extent in SHIFT argument of CSHIFT intrinsic in dimension 1: is 3, should be 2" }
+! { dg-options "-fbounds-check" }
+program main
+  integer, dimension(:,:), allocatable :: a, b
+  integer, dimension(:), allocatable :: sh
+  allocate (a(2,2))
+  allocate (b(2,2))
+  allocate (sh(3))
+  a = 1
+  b = cshift(a,sh)
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in SHIFT argument of CSHIFT intrinsic in dimension 1: is 3, should be 2" }
diff --git a/gcc/testsuite/gfortran.dg/cshift_large_1.f90 b/gcc/testsuite/gfortran.dg/cshift_large_1.f90
new file mode 100644
index 000000000..e9d064e21
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cshift_large_1.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_int }
+! Program to test the cshift intrinsic for kind=16 integers
+program intrinsic_cshift
+   integer, parameter :: k=16
+   integer(kind=k), dimension(3_k, 3_k) :: a
+   integer(kind=k), dimension(3_k, 3_k, 2_k) :: b
+
+   ! Scalar shift
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = cshift (a, 1_k, 1_k)
+   if (any (a .ne. reshape ((/2_k, 3_k, 1_k, 5_k, 6_k, 4_k, 8_k, 9_k, 7_k/), (/3_k, 3_k/)))) &
+      call abort
+
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = cshift (a, -2_k, dim = 2_k)
+   if (any (a .ne. reshape ((/4_k, 5_k, 6_k, 7_k, 8_k, 9_k, 1_k, 2_k, 3_k/), (/3_k, 3_k/)))) &
+      call abort
+
+   ! Array shift
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = cshift (a, (/1_k, 0_k, -1_k/))
+   if (any (a .ne. reshape ((/2_k, 3_k, 1_k, 4_k, 5_k, 6_k, 9_k, 7_k, 8_k/), (/3_k, 3_k/)))) &
+      call abort
+
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = cshift (a, (/2_k, -2_k, 0_k/), dim = 2_k)
+   if (any (a .ne. reshape ((/7_k, 5_k, 3_k, 1_k, 8_k, 6_k, 4_k, 2_k, 9_k/), (/3_k, 3_k/)))) &
+      call abort
+
+   ! Test arrays > rank 2
+   b = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k, 11_k, 12_k, 13_k, 14_k, 15_k, 16_k, 17_k,&
+         18_k, 19_k/), (/3_k, 3_k, 2_k/))
+   b = cshift (b, 1_k)
+   if (any (b .ne. reshape ((/2_k, 3_k, 1_k, 5_k, 6_k, 4_k, 8_k, 9_k, 7_k, 12_k, 13_k, 11_k, 15_k,&
+     16_k, 14_k, 18_k, 19_k, 17_k/), (/3_k, 3_k, 2_k/)))) &
+      call abort
+
+   b = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k, 11_k, 12_k, 13_k, 14_k, 15_k, 16_k, 17_k,&
+         18_k, 19_k/), (/3_k, 3_k, 2_k/))
+   b = cshift (b, reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)), 3_k)
+   if (any (b .ne. reshape ((/11_k, 2_k, 13_k, 4_k, 15_k, 6_k, 17_k, 8_k, 19_k, 1_k, 12_k, 3_k,&
+     14_k, 5_k, 16_k, 7_k, 18_k, 9_k/), (/3_k, 3_k, 2_k/)))) &
+      call abort
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/cshift_nan_1.f90 b/gcc/testsuite/gfortran.dg/cshift_nan_1.f90
new file mode 100644
index 000000000..896ecb3a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cshift_nan_1.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! Test cshift where the values are eight bytes,
+! but are aligned on a four-byte boundary.  The
+! integers correspond to NaN values.
+program main
+  implicit none
+  integer :: i
+  type t
+     sequence
+     integer :: a,b
+  end type t
+  type(t), dimension(4) :: u,v
+  common /foo/ u, i, v
+
+  u(1)%a = 2142240768
+  u(2)%a = 2144337920
+  u(3)%a = -5242880
+  u(4)%a = -3145728
+  u%b = (/(i,i=-1,-4,-1)/)
+  v(1:3:2) = cshift(u(1:3:2),1)
+  v(2:4:2) = cshift(u(2:4:2),-1)
+  if (any(v%a /= (/-5242880, -3145728, 2142240768, 2144337920 /))) call abort
+  if (any(v%b /= (/-3, -4, -1, -2/))) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/cshift_shift_real_1.f90 b/gcc/testsuite/gfortran.dg/cshift_shift_real_1.f90
new file mode 100644
index 000000000..93f4a1cd4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cshift_shift_real_1.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! PR 34549 - a real value was accepted for shift.
+program main
+  implicit none
+  real, dimension(2,2) :: r
+  data r /1.0, 2.0, 3.0, 4.0/
+  print *,cshift(r,shift=2.3,dim=1) ! { dg-error "must be INTEGER" }
+end program main
diff --git a/gcc/testsuite/gfortran.dg/cshift_shift_real_2.f90 b/gcc/testsuite/gfortran.dg/cshift_shift_real_2.f90
new file mode 100644
index 000000000..0d92945d2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cshift_shift_real_2.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! PR35724 Compile time segmentation fault for CSHIFT with negative third arg
+      SUBROUTINE RA0072(DDA,LDA,nf10,nf1,mf1,nf2)
+      REAL DDA(10,10)
+      LOGICAL LDA(10,10)
+      WHERE (LDA) DDA = CSHIFT(DDA,1,-MF1)  ! MF1 works, -1 works
+      END SUBROUTINE
+
diff --git a/gcc/testsuite/gfortran.dg/csqrt_2.f b/gcc/testsuite/gfortran.dg/csqrt_2.f
new file mode 100644
index 000000000..dc3d9a80d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/csqrt_2.f
@@ -0,0 +1,19 @@
+c { dg-do run }
+c Fix PR libgfortran/24313
+      complex x, y
+      complex z
+      z = cmplx(0.707106, -0.707106)
+      x = cmplx(0.0,-1.0)
+      y = sqrt(x)
+      if (abs(y - z) / abs(z) > 1.e-4) call abort
+
+      x = cmplx(tiny(1.),-1.0)
+      y = sqrt(x)
+      if (abs(y - z) / abs(z) > 1.e-4) call abort
+
+      x = cmplx(-tiny(1.),-1.0)
+      y = sqrt(x)
+      if (abs(y - z) / abs(z) > 1.e-4) call abort
+
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/ctrl-z.f90 b/gcc/testsuite/gfortran.dg/ctrl-z.f90
new file mode 100644
index 000000000..7f20d35ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ctrl-z.f90
@@ -0,0 +1,5 @@
+! { dg-do compile }
+! PR 30532 Ctrl-Z in source file
+! Test case from PR.  Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+      print *,""
+      end
diff --git a/gcc/testsuite/gfortran.dg/d_lines_1.f b/gcc/testsuite/gfortran.dg/d_lines_1.f
new file mode 100644
index 000000000..04909b147
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/d_lines_1.f
@@ -0,0 +1,5 @@
+! { dg-do compile }
+! { dg-options "-fd-lines-as-comments" }
+d This is a comment.
+D This line, too.
+      end
diff --git a/gcc/testsuite/gfortran.dg/d_lines_2.f b/gcc/testsuite/gfortran.dg/d_lines_2.f
new file mode 100644
index 000000000..b2e4df5bb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/d_lines_2.f
@@ -0,0 +1,6 @@
+! { dg-do compile }
+c { dg-options "-fd-lines-as-code" }
+      i = 0
+d     end
+      subroutine s
+D     end
diff --git a/gcc/testsuite/gfortran.dg/d_lines_3.f b/gcc/testsuite/gfortran.dg/d_lines_3.f
new file mode 100644
index 000000000..53b75addc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/d_lines_3.f
@@ -0,0 +1,10 @@
+C { dg-do compile }
+C { dg-options "-fd-lines-as-code" }
+C Verifies that column numbers are dealt with correctly when handling D lines.
+C234567890
+d     i = 0 ! this may not move to the left
+d    1  + 1 ! this should be a continuation line
+      goto 2345
+d23450continue ! statement labels are correctly identified
+      end
+      
diff --git a/gcc/testsuite/gfortran.dg/d_lines_4.f b/gcc/testsuite/gfortran.dg/d_lines_4.f
new file mode 100644
index 000000000..224ca137a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/d_lines_4.f
@@ -0,0 +1,3 @@
+! { dg-do compile }
+c verify that debug lines are rejected if none of -fd-lines-as-* are given.
+d ! { dg-error "Non-numeric character" }
diff --git a/gcc/testsuite/gfortran.dg/d_lines_5.f b/gcc/testsuite/gfortran.dg/d_lines_5.f
new file mode 100644
index 000000000..8b0e2d84f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/d_lines_5.f
@@ -0,0 +1,3 @@
+! { dg-do compile }
+c { dg-options "-fd-lines-as-code" }
+d ! This didn't work in an early version of the support for -fd-lines*
diff --git a/gcc/testsuite/gfortran.dg/data_array_1.f90 b/gcc/testsuite/gfortran.dg/data_array_1.f90
new file mode 100644
index 000000000..46c9a5bb7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_array_1.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! PR32928 DATA statement with array element as initializer is rejected
+! Test case by Jerry DeLisle  <jvdelisle @gcc.gnu.org>
+program chkdata
+    integer, parameter,dimension(4) :: myint = [ 4,3,2,1 ]
+    character(3), parameter, dimension(3) :: mychar = [ "abc", "def", "ghi" ]
+    character(50) :: buffer
+    integer :: a(5)
+    character(5) :: c(5)
+    data a(1:2) / myint(4), myint(2) /
+    data a(3:5) / myint(1), myint(3), myint(1) /
+    data c / mychar(1), mychar(2), mychar(3), mychar(1), mychar(2) /
+    buffer = ""
+    if (any(a.ne.[1,3,4,2,4])) call abort
+    write(buffer,'(5(a))')c
+    if (buffer.ne."abc  def  ghi  abc  def  ") call abort
+end program chkdata
diff --git a/gcc/testsuite/gfortran.dg/data_array_2.f90 b/gcc/testsuite/gfortran.dg/data_array_2.f90
new file mode 100644
index 000000000..20777a2a7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_array_2.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! PR32928 DATA statement with array element as initializer is rejected
+integer, parameter,dimension(4) :: myint = [ 4,3,2,1 ]
+integer :: a(5)
+data a(1:2) / myint(a(1)), myint(2) / ! { dg-error "Invalid initializer" }
+end
diff --git a/gcc/testsuite/gfortran.dg/data_array_3.f90 b/gcc/testsuite/gfortran.dg/data_array_3.f90
new file mode 100644
index 000000000..d9de791b4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_array_3.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! PR32928 DATA statement with array element as initializer is rejected
+integer, parameter,dimension(4) :: myint = [ 4,3,2,1 ]
+integer :: a(5),b
+data a(1:2) / myint(b), myint(2) / ! { dg-error "Invalid initializer" }
+end
diff --git a/gcc/testsuite/gfortran.dg/data_array_4.f90 b/gcc/testsuite/gfortran.dg/data_array_4.f90
new file mode 100644
index 000000000..3df30317e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_array_4.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! PR32928 DATA statement with array element as initializer is rejected
+IMPLICIT NONE
+INTEGER , PARAMETER :: NTAB = 3
+REAL :: SR(NTAB) , SR3(NTAB)
+DATA SR/NTAB*0.0/ , SR3/NTAB*0.0/
+end
diff --git a/gcc/testsuite/gfortran.dg/data_array_5.f90 b/gcc/testsuite/gfortran.dg/data_array_5.f90
new file mode 100644
index 000000000..1d4e4e758
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_array_5.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! Tests the fix for PR36371, in which the locus for the errors pointed to
+! the paramter declaration rather than the data statement.
+!
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+!
+program chkdata
+  character(len=3), parameter :: mychar(3) = [ "abc", "def", "ghi" ]
+  integer, parameter :: myint(3) = [1, 2, 3]
+  integer :: c(2)
+  character(4) :: i(2)
+  data c / mychar(1), mychar(3) / ! { dg-error "Incompatible types in DATA" }
+  data i / myint(3), myint(2) /   ! { dg-error "Incompatible types in DATA" }
+end program chkdata
diff --git a/gcc/testsuite/gfortran.dg/data_array_6.f b/gcc/testsuite/gfortran.dg/data_array_6.f
new file mode 100644
index 000000000..64b492bc2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_array_6.f
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! PR fortran/38404 - location marker in wrong line
+! Testcase contributed by Steve Chapel <steve DOT chapel AT a2pg DOT com>
+!
+
+      CHARACTER(len=72) TEXT(3)
+      DATA (TEXT(I),I=1,3)/
+     &'a string without issues',
+     &'a string with too many characters properly broken into the next
+     &line but too long to fit the variable',
+     &                                                                '
+     &a string that started just at the end of the last line -- some 
+     &may not be helped'/
+
+      ! { dg-warning "truncated" "" { target *-*-* } 10 }
+      ! { dg-warning "truncated" "" { target *-*-* } 12 }
+
+      END
diff --git a/gcc/testsuite/gfortran.dg/data_bounds_1.f90 b/gcc/testsuite/gfortran.dg/data_bounds_1.f90
new file mode 100644
index 000000000..b20aa415b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_bounds_1.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! Checks the fix for PR32315, in which the bounds checks below were not being done.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+program chkdata
+    character(len=20), dimension(4) :: string
+    character(len=20), dimension(0:1,3:4) :: string2
+
+    data (string(i) ,i = 4, 5) /'D', 'E'/ ! { dg-error "above array upper bound" }
+    data (string(i) ,i = 0, 1) /'A', 'B'/ ! { dg-error "below array lower bound" }
+    data (string(i) ,i = 1, 4) /'A', 'B', 'C', 'D'/
+
+    data ((string2(i, j) ,i = 1, 2), j = 3, 4) /'A', 'B', 'C', 'D'/ ! { dg-error "above array upper bound" }
+    data ((string2(i, j) ,i = 0, 1), j = 2, 3) /'A', 'B', 'C', 'D'/ ! { dg-error "below array lower bound" }
+    data ((string2(i, j) ,i = 0, 1), j = 3, 4) /'A', 'B', 'C', 'D'/
+end program chkdata
diff --git a/gcc/testsuite/gfortran.dg/data_char_1.f90 b/gcc/testsuite/gfortran.dg/data_char_1.f90
new file mode 100644
index 000000000..96db4fd30
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_char_1.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! Test character variables in data statements
+! Also substrings of character variables.
+! PR14976 PR16228 
+program data_char_1
+  character(len=5) :: a(2)
+  character(len=5) :: b(2)
+  data a /'Hellow', 'orld'/       ! { dg-warning "truncated" }
+  data b(:)(1:4), b(1)(5:5), b(2)(5:5) &
+      /'abcdefg', 'hi', 'j', 'k'/ ! { dg-warning "truncated" }
+  
+  if ((a(1) .ne. 'Hello') .or. (a(2) .ne. 'orld ')) call abort
+  if ((b(1) .ne. 'abcdj') .or. (b(2) .ne. 'hi  k')) call abort
+end program
diff --git a/gcc/testsuite/gfortran.dg/data_char_2.f90 b/gcc/testsuite/gfortran.dg/data_char_2.f90
new file mode 100644
index 000000000..26e31a14f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_char_2.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+!  Test that getting a character from a
+! string data works.
+
+CHARACTER*10       INTSTR
+CHARACTER          C1
+DATA               INTSTR / '0123456789' /
+
+C1 = INTSTR(1:1)
+if(C1 .ne. '0')  call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/data_char_3.f90 b/gcc/testsuite/gfortran.dg/data_char_3.f90
new file mode 100644
index 000000000..022ec5c12
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_char_3.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! { dg-options "-O2" }
+! Tests the fix PR29392, in which the iterator valued substring
+! reference would cause a segfault.
+!
+! Contributed by Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>   
+!
+  character(LEN=2) :: a(2) 
+  data ((a(I)(k:k),I=1,2),k=1,2) /2*'a',2*'z'/ 
+  IF (ANY(a.NE."az")) CALL ABORT() 
+  END 
diff --git a/gcc/testsuite/gfortran.dg/data_components_1.f90 b/gcc/testsuite/gfortran.dg/data_components_1.f90
new file mode 100644
index 000000000..2ce677e9f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_components_1.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! Check the fix for PR30879, in which the structure
+! components in the DATA values would cause a syntax
+! error.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+  TYPE T1
+   INTEGER :: I
+  END TYPE T1
+
+  TYPE(T1), PARAMETER :: D1=T1(2)
+  TYPE(T1) :: D2(2)
+
+  INTEGER :: a(2)
+
+  DATA (a(i),i=1,D1%I) /D1%I*D1%I/
+
+  DATA (D2(i),i=1,D1%I) /D1%I*T1(4)/
+
+  print *, a
+  print *, D2
+  END
diff --git a/gcc/testsuite/gfortran.dg/data_constraints_1.f90 b/gcc/testsuite/gfortran.dg/data_constraints_1.f90
new file mode 100644
index 000000000..bcf23ba34
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_constraints_1.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! Tests standard indepedendent constraints for variables in a data statement
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+  module global
+   integer n
+  end module global
+
+  use global
+  integer q
+  data n /0/            ! { dg-error "Cannot change attributes" }
+  n = 1
+  n = foo (n)
+contains
+  function foo (m) result (bar)
+  integer p (m), bar
+  integer, allocatable :: l(:)
+  allocate (l(1))
+  data l /42/           ! { dg-error "conflicts with ALLOCATABLE" }
+  data p(1) /1/         ! { dg-error "non-constant array in DATA" }
+  data q /1/            ! { dg-error "Host associated variable" }
+  data m /1/            ! { dg-error "conflicts with DUMMY attribute" }
+  data bar /99/         ! { dg-error "conflicts with RESULT" }
+  end function foo
+  function foobar ()
+  integer foobar
+  data foobar /0/       ! { dg-error "conflicts with FUNCTION" }
+  end function foobar
+end
+
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/data_constraints_2.f90 b/gcc/testsuite/gfortran.dg/data_constraints_2.f90
new file mode 100644
index 000000000..46de3c814
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_constraints_2.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! Tests constraints for variables in a data statement that are commonly
+! relaxed.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+  common // a
+  common /b/ c
+  integer d
+  data a /1/            ! { dg-error "common block variable" }
+  data c /2/            ! { dg-error "common block variable" }
+  data d /3/
+  data d /4/            ! { dg-error " re-initialization" }
+end
diff --git a/gcc/testsuite/gfortran.dg/data_implied_do_1.f90 b/gcc/testsuite/gfortran.dg/data_implied_do_1.f90
new file mode 100644
index 000000000..1cc977c34
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_implied_do_1.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! Test of the patch for PR23232, in which implied do loop
+! variables were not permitted in DATA statements.
+! 
+! Contributed by Roger Ferrer Ibáñez <rofi@ya.com> 
+!
+PROGRAM p
+  REAL :: TWO_ARRAY (3, 3)
+  INTEGER :: K, J
+  DATA ((TWO_ARRAY (K, J), K = 1, J-1), J = 1, 3) /3 * 1.0/
+  DATA ((TWO_ARRAY (K, J), K = J, 3), J = 1, 3) /6 * 2.0/
+  if (any (reshape (two_array, (/9/)) &
+      .ne. (/2.0,2.0,2.0,1.0,2.0,2.0,1.0,1.0,2.0/))) call abort ()
+END PROGRAM
+
diff --git a/gcc/testsuite/gfortran.dg/data_initialized.f90 b/gcc/testsuite/gfortran.dg/data_initialized.f90
new file mode 100644
index 000000000..56cf059ae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_initialized.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! Tests fix for PR17737 - already initialized variable cannot appear
+! in data statement
+      integer :: i, j = 1
+      data i/0/
+      data i/0/   ! { dg-error "Extension: re-initialization" }
+      data j/2/   ! { dg-error "Extension: re-initialization" }
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/data_initialized_2.f90 b/gcc/testsuite/gfortran.dg/data_initialized_2.f90
new file mode 100644
index 000000000..c6331cd0c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_initialized_2.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! Tests the fix for PR32236, in which the error below manifested itself
+! as an ICE.
+! Contributed by Bob Arduini <r.f.arduini@larc.nasa.gov>
+  real :: x(2) = 1.0 ! { dg-error "already is initialized" }
+  data x /1.0, 2.0/  ! { dg-error "already is initialized" }
+  print *, x
+end
diff --git a/gcc/testsuite/gfortran.dg/data_invalid.f90 b/gcc/testsuite/gfortran.dg/data_invalid.f90
new file mode 100644
index 000000000..960a8f3d3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_invalid.f90
@@ -0,0 +1,122 @@
+! { dg-do compile }
+! { dg-options "-std=f95 -fmax-errors=0" }
+!
+! Testcases from PR fortran/24978
+!
+
+SUBROUTINE data_init_scalar_invalid()
+  integer :: a
+  data       a / 1 /
+  data       a / 1 /                             ! { dg-error "re-initialization" }
+
+  integer :: b = 0
+  data       b / 1 /                             ! { dg-error "re-initialization" }
+END SUBROUTINE
+
+SUBROUTINE data_init_array_invalid()
+  ! initialize (at least) one element, re-initialize full array
+  integer :: a(3)
+  data       a(2) / 2 /
+  data       a    / 3*1 /                        ! { dg-error "re-initialization" }
+
+  ! initialize (at least) one element, re-initialize subsection including the element
+  integer :: b(3)
+  data       b(2)   / 2 /
+  data       b(1:2) / 2*1 /                      ! { dg-error "re-initialization" }
+
+  ! initialize subsection, re-initialize (intersecting) subsection
+  integer :: c(3)
+  data       c(1:2) / 2*1 /
+  data       c(2:3) / 1,1 /                      ! { dg-error "re-initialization" }
+
+  ! initialize subsection, re-initialize full array
+  integer :: d(3)
+  data       d(2:3) / 2*1 /
+  data       d      / 2*2, 3 /                   ! { dg-error "re-initialization" }
+
+  ! full array initializer, re-initialize (at least) one element
+  integer :: e(3)
+  data       e    / 3*1 /
+  data       e(2) / 2 /                          ! { dg-error "re-initialization" }
+
+  integer :: f(3) = 0                            ! { dg-error "already is initialized" }
+  data       f(2) / 1 /
+
+  ! full array initializer, re-initialize subsection
+  integer :: g(3)
+  data       g      / 3*1 /
+  data       g(1:2) / 2*2 /                      ! { dg-error "re-initialization" }
+
+  integer :: h(3) = 1                            ! { dg-error "already is initialized" }
+  data       h(2:3) / 2*2 /
+
+  ! full array initializer, re-initialize full array
+  integer :: i(3)
+  data       i   / 3*1 /
+  data       i   / 2,2,2 /                       ! { dg-error "re-initialization" }
+
+  integer :: j(3) = 1                            ! { dg-error "already is initialized" }
+  data       j   / 3*2 /
+END SUBROUTINE
+
+SUBROUTINE data_init_matrix_invalid()
+  ! initialize (at least) one element, re-initialize full matrix
+  integer :: a(3,3)
+  data       a(2,2) / 1 /
+  data       a      / 9*2 /                      ! { dg-error "re-initialization" }
+
+  ! initialize (at least) one element, re-initialize subsection
+  integer :: b(3,3)
+  data       b(2,2) / 1 /
+  data       b(2,:) / 3*2 /                      ! { dg-error "re-initialization" }
+
+  ! initialize subsection, re-initialize (intersecting) subsection
+  integer :: c(3,3)
+  data       c(3,:) / 3*1 /, c(:,3) / 3*2 /      ! { dg-error "re-initialization" }
+
+  ! initialize subsection, re-initialize full array
+  integer :: d(3,3)
+  data       d(2,:) / 1,2,3 /
+  data       d      / 9*4 /                      ! { dg-error "re-initialization" }
+
+  ! full array initializer, re-initialize (at least) one element
+  integer :: e(3,3)
+  data       e      / 9*1 /
+  data       e(2,3) / 2 /                        ! { dg-error "re-initialization" }
+
+  integer :: f(3,3) = 1                          ! { dg-error "already is initialized" }
+  data       f(3,2) / 2 /
+
+  ! full array initializer, re-initialize subsection
+  integer :: g(3,3)
+  data       g          / 9 * 1 /
+  data       g(2:3,2:3) / 2, 2*3, 4 /            ! { dg-error "re-initialization" }
+
+  integer :: h(3,3) = 1                          ! { dg-error "already is initialized" }
+  data       h(2:3,2:3) / 2, 2*3, 4 /
+
+  ! full array initializer, re-initialize full array
+  integer :: i(3,3)
+  data       i   / 3*1, 3*2, 3*3 /
+  data       i   / 9 * 1 /                       ! { dg-error "re-initialization" }
+
+  integer :: j(3,3) = 0                          ! { dg-error "already is initialized" }
+  data       j   / 9 * 1 /
+END SUBROUTINE
+
+SUBROUTINE data_init_misc_invalid()
+  ! wrong number of dimensions
+  integer :: a(3)
+  data       a(1,1) / 1 /                        ! { dg-error "Rank mismatch" }
+
+  ! index out-of-bounds, direct access
+  integer :: b(3)
+  data       b(-2) / 1 /                         ! { dg-error "below array lower bound" }
+
+  ! index out-of-bounds, implied do-loop (PR32315)
+  integer :: i
+  character(len=20), dimension(4) :: string
+  data (string(i), i = 1, 5) / 'A', 'B', 'C', 'D', 'E' /   ! { dg-error "above array upper bound" }
+END SUBROUTINE
+
+! { dg-excess-errors "" }
diff --git a/gcc/testsuite/gfortran.dg/data_namelist_conflict.f90 b/gcc/testsuite/gfortran.dg/data_namelist_conflict.f90
new file mode 100644
index 000000000..b09f167fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_namelist_conflict.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! Problem report: http://gcc.gnu.org/ml/fortran/2010-05/msg00139.html
+!
+module globals
+   implicit none
+   integer j
+   data j/1/
+end module
+
+program test
+   use globals
+   implicit none
+   character(len=80) str
+   integer :: i
+   data i/0/
+   namelist /nl/i,j
+   open(unit=10,status='scratch')
+   write(10,nl)
+   i = 42
+   j = 42
+   rewind(10)
+   read(10,nl)
+   if (i /= 0 .or. j /= 1) call abort
+   close(10)
+end program
+! { dg-final { cleanup-modules "globals" } }
diff --git a/gcc/testsuite/gfortran.dg/data_pointer_1.f90 b/gcc/testsuite/gfortran.dg/data_pointer_1.f90
new file mode 100644
index 000000000..8f081474c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_pointer_1.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! Test the fixes for PR38917 and 38918, in which the NULL values caused errors.
+!
+! Contributed by Dick Hendrickson  <dick.hendrickson@gmail.com>
+!             and Tobias Burnus  <burnus@gcc.gnu.org>
+!
+      SUBROUTINE PF0009
+!  PR38918
+      TYPE  :: HAS_POINTER
+        INTEGER, POINTER            :: PTR_S
+      END TYPE HAS_POINTER
+      TYPE (HAS_POINTER)  ::  PTR_ARRAY(5)
+
+      DATA PTR_ARRAY(1)%PTR_S  /NULL()/
+
+      end subroutine pf0009
+
+      SUBROUTINE PF0005
+! PR38917
+      REAL, SAVE, POINTER :: PTR1
+      INTEGER, POINTER       :: PTR2(:,:,:)
+      CHARACTER(LEN=1), SAVE, POINTER :: PTR3(:)
+
+      DATA  PTR1 / NULL() /
+      DATA  PTR2 / NULL() /
+      DATA  PTR3 / NULL() /
+
+      end subroutine pf0005
+
+! Tobias pointed out that this would cause an ICE rather than an error.
+      subroutine tobias
+      integer, pointer :: ptr(:)
+      data ptr(1) /NULL()/  ! { dg-error "must be a full array" }
+      end subroutine tobias
+
diff --git a/gcc/testsuite/gfortran.dg/data_value_1.f90 b/gcc/testsuite/gfortran.dg/data_value_1.f90
new file mode 100644
index 000000000..cb3e4c3ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_value_1.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! Test the fix for PR40402, in which it was not detected that X
+! is not a constant and so the DATA statement did not have
+! a constant value expression.
+!
+! Modified dg-error for PR41807
+!
+! Contributed by Philippe Marguinaud <philippe.marguinaud@meteo.fr>
+!
+      TYPE POINT
+        REAL :: X 
+      ENDTYPE
+      TYPE(POINT) :: P
+      DATA P / POINT(1.+X) / ! { dg-error "non-constant initialization" }
+      print *, p
+      END
diff --git a/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90 b/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90
new file mode 100644
index 000000000..5c00741f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_1.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+program a
+
+  implicit none
+
+  real x
+  integer j, k, n(4)
+  character(len=70) err
+  character(len=70), allocatable :: error(:)
+
+  integer, allocatable :: i(:)
+
+  type b
+    integer, allocatable :: c(:), d(:)
+  end type b
+
+  type(b) e, f(3)
+
+  deallocate(i, stat=x) ! { dg-error "must be a scalar INTEGER" }
+  deallocate(i, stat=j, stat=k) ! { dg-error "Redundant STAT" }
+  deallocate(i)
+  deallocate(i)) ! { dg-error "Syntax error in DEALLOCATE" }
+  deallocate(i, errmsg=err, errmsg=err) ! { dg-error "Redundant ERRMSG" }
+  deallocate(i, errmsg=err) ! { dg-warning "useless without a STAT" }
+  deallocate(i, stat=j, errmsg=x) ! { dg-error "must be a scalar CHARACTER" }
+
+  deallocate(err) ! { dg-error "nonprocedure pointer or an allocatable" }
+
+  deallocate(error,stat=j,errmsg=error(1)) ! { dg-error "shall not be DEALLOCATEd within" }
+  deallocate(i, stat = i(1))  ! { dg-error "shall not be DEALLOCATEd within" }
+
+  deallocate(n) ! { dg-error "must be ALLOCATABLE or a POINTER" }
+
+  deallocate(i, i) ! { dg-error "Allocate-object at" }
+
+  ! These should not fail the check for duplicate alloc-objects.
+  deallocate(f(1)%c, f(2)%d)
+  deallocate(e%c, e%d)
+
+end program a
diff --git a/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_2.f90 b/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_2.f90
new file mode 100644
index 000000000..0df758251
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_2.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+subroutine sub(i, j, err)
+   implicit none
+   character(len=*), intent(in) :: err
+   integer, intent(in) :: j
+   integer, intent(in), allocatable :: i(:)
+   integer, allocatable :: m(:)
+   integer n
+   deallocate(i)                    ! { dg-error "variable definition context" }
+   deallocate(m, stat=j)            ! { dg-error "variable definition context" }
+   deallocate(m,stat=n,errmsg=err)  ! { dg-error "variable definition context" }
+end subroutine sub
diff --git a/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_3.f90 b/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_3.f90
new file mode 100644
index 000000000..67ec14a4a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deallocate_alloc_opt_3.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+program a
+
+  implicit none
+
+  integer n
+  character(len=70) e1
+  character(len=30) e2
+  integer, allocatable :: i(:)
+
+  e1 = 'No error'
+  allocate(i(4))
+  deallocate(i, stat=n, errmsg=e1)
+  if (trim(e1) /= 'No error') call abort
+
+  e2 = 'No error'
+  allocate(i(4))
+  deallocate(i, stat=n, errmsg=e2)
+  if (trim(e2) /= 'No error') call abort
+
+  e1 = 'No error'
+  deallocate(i, stat=n, errmsg=e1)
+  if (trim(e1) /= 'Attempt to deallocate an unallocated object') call abort
+
+  e2 = 'No error'
+  deallocate(i, stat=n, errmsg=e2)
+  if (trim(e2) /= 'Attempt to deallocate an unall') call abort
+
+end program a
diff --git a/gcc/testsuite/gfortran.dg/deallocate_error_1.f90 b/gcc/testsuite/gfortran.dg/deallocate_error_1.f90
new file mode 100644
index 000000000..98ffdb3b9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deallocate_error_1.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-shouldfail "runtime error" }
+! { dg-output "At line 14.*Attempt to DEALLOCATE unallocated 'arr'" }
+
+! PR fortran/37507
+! Check that locus is printed for DEALLOCATE errors.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER, ALLOCATABLE :: arr(:)
+
+  ALLOCATE (arr(5))
+  DEALLOCATE (arr)
+  DEALLOCATE (arr)
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/deallocate_error_2.f90 b/gcc/testsuite/gfortran.dg/deallocate_error_2.f90
new file mode 100644
index 000000000..bda1adff5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deallocate_error_2.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-shouldfail "runtime error" }
+! { dg-output "At line 15.*Attempt to DEALLOCATE unallocated 'ptr'" }
+
+! PR fortran/37507
+! Check that locus is printed for DEALLOCATE errors.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER, POINTER :: ptr
+  INTEGER, ALLOCATABLE :: arr(:)
+
+  ALLOCATE (ptr, arr(5))
+  DEALLOCATE (ptr)
+  DEALLOCATE (arr, ptr)
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/deallocate_stat.f90 b/gcc/testsuite/gfortran.dg/deallocate_stat.f90
new file mode 100644
index 000000000..b691f21c7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deallocate_stat.f90
@@ -0,0 +1,77 @@
+! { dg-do run }
+! PR 17792
+! PR 21375
+! Test that the STAT argument to DEALLOCATE works with POINTERS and 
+! ALLOCATABLE arrays.
+program deallocate_stat
+   
+   implicit none
+
+   integer i
+   real, pointer :: a1(:), a2(:,:), a3(:,:,:), a4(:,:,:,:), &
+   &  a5(:,:,:,:,:), a6(:,:,:,:,:,:), a7(:,:,:,:,:,:,:)
+
+   real, allocatable :: b1(:), b2(:,:), b3(:,:,:), b4(:,:,:,:), &
+   &  b5(:,:,:,:,:), b6(:,:,:,:,:,:), b7(:,:,:,:,:,:,:)
+
+   allocate(a1(2), a2(2,2), a3(2,2,2), a4(2,2,2,2), a5(2,2,2,2,2))
+   allocate(a6(2,2,2,2,2,2), a7(2,2,2,2,2,2,2))
+
+   a1 = 1. ; a2 = 2. ; a3 = 3. ; a4 = 4. ; a5 = 5. ; a6 = 6. ; a7 = 7.
+
+   i = 13
+   deallocate(a1, stat=i) ; if (i /= 0) call abort
+   deallocate(a2, stat=i) ; if (i /= 0) call abort
+   deallocate(a3, stat=i) ; if (i /= 0) call abort
+   deallocate(a4, stat=i) ; if (i /= 0) call abort
+   deallocate(a5, stat=i) ; if (i /= 0) call abort
+   deallocate(a6, stat=i) ; if (i /= 0) call abort
+   deallocate(a7, stat=i) ; if (i /= 0) call abort
+
+   i = 14
+   deallocate(a1, stat=i) ; if (i /= 1) call abort
+   deallocate(a2, stat=i) ; if (i /= 1) call abort
+   deallocate(a3, stat=i) ; if (i /= 1) call abort
+   deallocate(a4, stat=i) ; if (i /= 1) call abort
+   deallocate(a5, stat=i) ; if (i /= 1) call abort
+   deallocate(a6, stat=i) ; if (i /= 1) call abort
+   deallocate(a7, stat=i) ; if (i /= 1) call abort
+
+   allocate(b1(2), b2(2,2), b3(2,2,2), b4(2,2,2,2), b5(2,2,2,2,2))
+   allocate(b6(2,2,2,2,2,2), b7(2,2,2,2,2,2,2))
+
+   b1 = 1. ; b2 = 2. ; b3 = 3. ; b4 = 4. ; b5 = 5. ; b6 = 6. ; b7 = 7.
+
+   i = 13
+   deallocate(b1, stat=i) ; if (i /= 0) call abort
+   deallocate(b2, stat=i) ; if (i /= 0) call abort
+   deallocate(b3, stat=i) ; if (i /= 0) call abort
+   deallocate(b4, stat=i) ; if (i /= 0) call abort
+   deallocate(b5, stat=i) ; if (i /= 0) call abort
+   deallocate(b6, stat=i) ; if (i /= 0) call abort
+   deallocate(b7, stat=i) ; if (i /= 0) call abort
+
+   i = 14
+   deallocate(b1, stat=i) ; if (i /= 1) call abort
+   deallocate(b2, stat=i) ; if (i /= 1) call abort
+   deallocate(b3, stat=i) ; if (i /= 1) call abort
+   deallocate(b4, stat=i) ; if (i /= 1) call abort
+   deallocate(b5, stat=i) ; if (i /= 1) call abort
+   deallocate(b6, stat=i) ; if (i /= 1) call abort
+   deallocate(b7, stat=i) ; if (i /= 1) call abort
+
+
+   allocate(a1(2), a2(2,2), a3(2,2,2), b4(2,2,2,2), b5(2,2,2,2,2))
+   allocate(b6(2,2,2,2,2,2))
+
+   a1 = 1. ; a2 = 2. ; a3 = 3. ; b4 = 4. ; b5 = 5. ; b6 = 6.
+
+   i = 13
+   deallocate(a1, stat=i) ;         if (i /= 0) call abort
+   deallocate(a2, a1, stat=i) ;     if (i /= 1) call abort
+   deallocate(a1, a3, a2, stat=i) ; if (i /= 2) call abort
+   deallocate(b4, stat=i) ;         if (i /= 0) call abort
+   deallocate(b4, b5, stat=i) ;     if (i /= 1) call abort
+   deallocate(b4, b5, b6, stat=i) ; if (i /= 2) call abort
+
+end program deallocate_stat
diff --git a/gcc/testsuite/gfortran.dg/debug/debug.exp b/gcc/testsuite/gfortran.dg/debug/debug.exp
new file mode 100644
index 000000000..0e0b4b91d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/debug/debug.exp
@@ -0,0 +1,41 @@
+#  Copyright (C) 2008 Free Software Foundation, Inc.
+
+#  This file is part of GCC.
+#
+#  GCC is free software; you can redistribute it and/or modify it under
+#  the terms of the GNU General Public License as published by the Free
+#  Software Foundation; either version 3, or (at your option) any later
+#  version.
+#
+#  GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+#  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+#  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+#  for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with GCC; see the file COPYING3.  If not see
+#  <http://www.gnu.org/licenses/>.
+
+# GCC testsuite that uses the `dg.exp' driver.
+
+# Load support procs.
+load_lib gfortran-dg.exp
+load_lib gfortran.exp
+
+# Debugging testsuite proc
+proc gfortran-debug-dg-test { prog do_what extra_tool_flags } {
+   return [gfortran-dg-test $prog $do_what $extra_tool_flags]
+}
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+
+gfortran_init
+
+gfortran-dg-debug-runtest gfortran_target_compile trivial.f "" \
+    [lsort [glob -nocomplain $srcdir/$subdir/*.\[fS\]]]
+
+# All done.
+dg-finish
diff --git a/gcc/testsuite/gfortran.dg/debug/pr35154-dwarf2.f b/gcc/testsuite/gfortran.dg/debug/pr35154-dwarf2.f
new file mode 100644
index 000000000..40c13a4a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/debug/pr35154-dwarf2.f
@@ -0,0 +1,38 @@
+C     Test program for common block debugging.  G. Helffrich 11 July 2004.
+C { dg-do compile }
+C { dg-skip-if "DWARF-2 only" { "*-*-*" } { "*" } { "-gdwarf-2" } }
+C { dg-skip-if "DWARF-2 only" { "*-*-*" } { "-g1" } { "" } }
+C { dg-options "-dA -gno-strict-dwarf" }
+      common i,j
+      common /label/l,m
+      i = 1
+      j = 2
+      k = 3
+      l = 4
+      m = 5
+      call sub
+      end
+      subroutine sub
+      common /label/l,m
+      logical first
+      save n
+      data first /.true./
+      if (first) then
+         n = 0
+	 first = .false.
+      endif
+      n = n + 1
+      l = l + 1
+      return
+      end
+
+C { dg-final { scan-assembler "DIE\[^\n\]*DW_TAG_common_block" } }
+C { dg-final { scan-assembler "(DW_AT_name: \"__BLNK__\"|\"__BLNK__\[^\n\]*\"\[^\n\]*DW_AT_name)" } }
+C { dg-final { scan-assembler "DIE\[^\n\]*DW_TAG_variable" } }
+C { dg-final { scan-assembler "\"i\[^\n\]*\"\[^\n\]*DW_AT_name" } }
+C { dg-final { scan-assembler "\"j\[^\n\]*\"\[^\n\]*DW_AT_name" } }
+C { dg-final { scan-assembler "DIE\[^\n\]*DW_TAG_common_block" } }
+C { dg-final { scan-assembler "(DW_AT_name: \"label\"|\"label\[^\n\]*\"\[^\n\]*DW_AT_name)" } }
+C { dg-final { scan-assembler "DIE\[^\n\]*DW_TAG_variable" } }
+C { dg-final { scan-assembler "\"l\[^\n\]*\"\[^\n\]*DW_AT_name" } }
+C { dg-final { scan-assembler "\"m\[^\n\]*\"\[^\n\]*DW_AT_name" } }
diff --git a/gcc/testsuite/gfortran.dg/debug/pr35154-stabs.f b/gcc/testsuite/gfortran.dg/debug/pr35154-stabs.f
new file mode 100644
index 000000000..a5976331b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/debug/pr35154-stabs.f
@@ -0,0 +1,35 @@
+C     Test program for common block debugging.  G. Helffrich 11 July 2004.
+C { dg-do compile }
+C { dg-skip-if "No stabs" { mmix-*-* *-*-netware* alpha*-*-* hppa*64*-*-* ia64-*-* *-*-vxworks* } { "*" } { "" } }
+C { dg-skip-if "No stabs" {*-*-* } { "*" } { "-gstabs" } }
+      common i,j
+      common /label/l,m
+      i = 1
+      j = 2
+      k = 3
+      l = 4
+      m = 5
+      call sub
+      end
+      subroutine sub
+      common /label/l,m
+      logical first
+      save n
+      data first /.true./
+      if (first) then
+         n = 0
+	 first = .false.
+      endif
+      n = n + 1
+      l = l + 1
+      return
+      end
+
+C { dg-final { scan-assembler ".stabs.*\"__BLNK__\",226" } }
+C { dg-final { scan-assembler ".stabs.*\"i:V.*\",.*,0" } }
+C { dg-final { scan-assembler ".stabs.*\"j:V.*\",.*,4" } }
+C { dg-final { scan-assembler ".stabs.*\"__BLNK__\",228" } }
+C { dg-final { scan-assembler ".stabs.*\"label_\",226" } }
+C { dg-final { scan-assembler ".stabs.*\"l:V.*\",.*,0" } }
+C { dg-final { scan-assembler ".stabs.*\"m:V.*\",.*,4" } }
+C { dg-final { scan-assembler ".stabs.*\"label_\",228" } }
diff --git a/gcc/testsuite/gfortran.dg/debug/pr37738.f b/gcc/testsuite/gfortran.dg/debug/pr37738.f
new file mode 100644
index 000000000..fddc44c7a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/debug/pr37738.f
@@ -0,0 +1,31 @@
+C PR debug/37738
+C { dg-do compile }
+C { dg-skip-if "DWARF-2 only" { "*-*-*" } { "*" } { "-gdwarf-2" } }
+C { dg-skip-if "DWARF-2 only" { "*-*-*" } { "-g1" } { "" } }
+C { dg-options "-dA -gno-strict-dwarf" }
+
+      subroutine a
+      integer*4 a_i, c_i
+      common /block/a_i, c_i
+      a_i = 1
+      c_i = 4
+      end subroutine a
+      subroutine b
+      integer*4 b_i
+      common /block/b_i, d_i
+      b_i = 2
+      d_i = 5
+      end subroutine b
+      subroutine c
+      integer*4 a_i, c_i
+      common /block/a_i, c_i
+      if (a_i .ne. 2) call abort
+      if (c_i .ne. 5) call abort
+      end subroutine c
+      program abc
+      call a
+      call b
+      call c
+      end program abc
+
+C { dg-final { scan-assembler-times "DIE\[^\n\]*DW_TAG_common_block" 3 } }
diff --git a/gcc/testsuite/gfortran.dg/debug/pr43166.f b/gcc/testsuite/gfortran.dg/debug/pr43166.f
new file mode 100644
index 000000000..a3146150b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/debug/pr43166.f
@@ -0,0 +1,14 @@
+C PR debug/43166
+C { dg-do compile }
+C { dg-options "-O" }
+      SUBROUTINE FOO ()
+      INTEGER V1
+      COMMON // V1
+      END
+      SUBROUTINE BAR ()
+      INTEGER V0,V1,V2,V3
+      COMMON // V1(4),V2(85,4),V3
+      DO V3=1,V1(1)
+      V0=V2(V3,1)
+      END DO
+      END
diff --git a/gcc/testsuite/gfortran.dg/debug/pr46756.f b/gcc/testsuite/gfortran.dg/debug/pr46756.f
new file mode 100644
index 000000000..fab06e394
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/debug/pr46756.f
@@ -0,0 +1,29 @@
+C PR debug/46756, reduced from ../20010519-1.f
+C { dg-do compile }
+C { dg-options "-O -fcompare-debug" }
+      LOGICAL QDISK,QDW,QCMPCT
+      LOGICAL LNOMA,LRAISE,LSCI,LBIG
+      ASSIGN 801 TO I800 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+      GOTO 800
+ 801  CONTINUE
+      ASSIGN 761 TO I760 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+ 761  CONTINUE
+      IF(LSCI) THEN
+         DO I=1,LENCM
+         ENDDO
+      ENDIF
+      DO WHILE((CVGMX.GT.TOLDIM).AND.(ITER.LT.ITMX))
+         IF(.NOT.QDW) THEN
+            ASSIGN 641 to I640 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+            GOTO 640
+ 641        CONTINUE
+         ENDIF
+      ENDDO
+      GOTO 700
+ 640  CONTINUE
+      GOTO I640 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" }
+ 700  CONTINUE
+      GOTO I760 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" }
+ 800  CONTINUE
+      GOTO I800 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" }
+      END
diff --git a/gcc/testsuite/gfortran.dg/debug/trivial.f b/gcc/testsuite/gfortran.dg/debug/trivial.f
new file mode 100644
index 000000000..4c3556725
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/debug/trivial.f
@@ -0,0 +1,2 @@
+      program trivial
+      end
diff --git a/gcc/testsuite/gfortran.dg/debug_1.f90 b/gcc/testsuite/gfortran.dg/debug_1.f90
new file mode 100644
index 000000000..808f41c70
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/debug_1.f90
@@ -0,0 +1,20 @@
+subroutine gfc_debug_bug (n,m,k,ax,bx,c)
+! above line must be the first line
+! { dg-do compile }
+! { dg-options "-g" }
+! PR 19195
+! we set line numbers wrongly, which made the compiler choke when emitting
+! debug information.
+  implicit none
+  integer :: n, m
+  integer :: k(n+m)
+  real    :: ax(:), bx(n), c(n+m)
+
+  integer :: i
+  real    :: f
+
+  i = k(n)
+  f = c(n)
+  f = bx(n)
+  f = ax(n)
+end subroutine gfc_debug_bug
diff --git a/gcc/testsuite/gfortran.dg/debug_2.f b/gcc/testsuite/gfortran.dg/debug_2.f
new file mode 100644
index 000000000..66bc5f6f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/debug_2.f
@@ -0,0 +1,16 @@
+# 1 "debug_2.F"
+# 1 "<built-in>"
+# 1 "<command line>"
+# 1 "debug_2.F"
+# 3 "debug_2.inc1" 1
+# 4 "debug_2.inc2" 1
+! The above lines must be present as is.
+! PR fortran/34084
+! { dg-do compile }
+! { dg-options "-g" }
+      subroutine foo
+      end subroutine foo
+# 4 "debug_2.inc1" 2
+# 2 "debug_2.F" 2
+      program bar
+      end program bar
diff --git a/gcc/testsuite/gfortran.dg/default_format_1.f90 b/gcc/testsuite/gfortran.dg/default_format_1.f90
new file mode 100644
index 000000000..e374f1b89
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/default_format_1.f90
@@ -0,0 +1,27 @@
+! { dg-do run { xfail spu-*-*  } }
+! Test XFAILed on Darwin because the system's printf() lacks
+! proper support for denormals.
+!
+! This tests that the default formats for formatted I/O of reals are
+! wide enough and have enough precision, by checking that values can
+! be written and read back.
+!
+include "default_format_1.inc"
+
+program main
+  use test_default_format
+
+  if (test (1.0_4, 0) /= 0) call abort
+  if (test (tiny(0.0_4), 1) /= 0) call abort
+  if (test (-tiny(0.0_4), -1) /= 0) call abort
+  if (test (huge(0.0_4), -1) /= 0) call abort
+  if (test (-huge(0.0_4), 1) /= 0) call abort
+
+  if (test (1.0_8, 0) /= 0) call abort
+  if (test (tiny(0.0_8), 1) /= 0) call abort
+  if (test (-tiny(0.0_8), -1) /= 0) call abort
+  if (test (huge(0.0_8), -1) /= 0) call abort
+  if (test (-huge(0.0_8), 1) /= 0) call abort
+end program main
+!
+! { dg-final { cleanup-modules "test_default_format" } }
diff --git a/gcc/testsuite/gfortran.dg/default_format_1.inc b/gcc/testsuite/gfortran.dg/default_format_1.inc
new file mode 100644
index 000000000..e5d711cf0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/default_format_1.inc
@@ -0,0 +1,74 @@
+module test_default_format
+  interface test
+    module procedure test_r4
+    module procedure test_r8
+  end interface test
+
+  integer, parameter :: count = 200
+
+contains
+  function test_r4 (start, towards) result (res)
+    integer, parameter :: k = 4
+    integer, intent(in) :: towards
+    real(k), intent(in) :: start
+
+    integer :: res, i
+    real(k) :: x, y
+    character(len=100) :: s
+
+    res = 0
+
+    if (towards >= 0) then
+      x = start
+      do i = 0, count
+        write (s,*) x
+        read (s,*) y
+        if (y /= x) res = res + 1
+        x = nearest(x,huge(x))
+      end do
+    end if
+
+    if (towards <= 0) then
+      x = start
+      do i = 0, count
+        write (s,*) x
+        read (s,*) y
+        if (y /= x) res = res + 1
+        x = nearest(x,-huge(x))
+      end do
+    end if
+  end function test_r4
+
+  function test_r8 (start, towards) result (res)
+    integer, parameter :: k = 8
+    integer, intent(in) :: towards
+    real(k), intent(in) :: start
+
+    integer :: res, i
+    real(k) :: x, y
+    character(len=100) :: s
+
+    res = 0
+
+    if (towards >= 0) then
+      x = start
+      do i = 0, count
+        write (s,*) x
+        read (s,*) y
+        if (y /= x) res = res + 1
+        x = nearest(x,huge(x))
+      end do
+    end if
+
+    if (towards <= 0) then
+      x = start
+      do i = 0, count
+        write (s,*) x
+        read (s,*) y
+        if (y /= x) res = res + 1
+        x = nearest(x,-huge(x))
+      end do
+    end if
+  end function test_r8
+
+end module test_default_format
diff --git a/gcc/testsuite/gfortran.dg/default_format_2.f90 b/gcc/testsuite/gfortran.dg/default_format_2.f90
new file mode 100644
index 000000000..264246732
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/default_format_2.f90
@@ -0,0 +1,23 @@
+! { dg-require-effective-target fortran_large_real }
+! { dg-do run { xfail powerpc*-apple-darwin* powerpc*-*-linux* } }
+! Test XFAILed on these platforms because the system's printf() lacks
+! proper support for denormalized long doubles. See PR24685
+!
+! This tests that the default formats for formatted I/O of reals are
+! wide enough and have enough precision, by checking that values can
+! be written and read back.
+!
+include "default_format_2.inc"
+
+program main
+  use test_default_format
+
+  if (test (1.0_kl, 0) /= 0) call abort
+  if (test (0.0_kl, 0) /= 0) call abort
+  if (test (tiny(0.0_kl), 1) /= 0) call abort
+  if (test (-tiny(0.0_kl), -1) /= 0) call abort
+  if (test (huge(0.0_kl), -1) /= 0) call abort
+  if (test (-huge(0.0_kl), 1) /= 0) call abort
+end program main
+!
+! { dg-final { cleanup-modules "test_default_format" } }
diff --git a/gcc/testsuite/gfortran.dg/default_format_2.inc b/gcc/testsuite/gfortran.dg/default_format_2.inc
new file mode 100644
index 000000000..7306f0706
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/default_format_2.inc
@@ -0,0 +1,43 @@
+module test_default_format
+  interface test
+    module procedure test_rl
+  end interface test
+
+  integer, parameter :: kl = selected_real_kind (precision (0.0_8) + 1)
+  integer, parameter :: count = 200
+
+contains
+
+  function test_rl (start, towards) result (res)
+    integer, parameter :: k = kl
+    integer, intent(in) :: towards
+    real(k), intent(in) :: start
+
+    integer :: res, i
+    real(k) :: x, y
+    character(len=100) :: s
+
+    res = 0
+
+    if (towards >= 0) then
+      x = start
+      do i = 0, count
+        write (s,*) x
+        read (s,*) y
+        if (y /= x) res = res + 1
+        x = nearest(x,huge(x))
+      end do
+    end if
+
+    if (towards <= 0) then
+      x = start
+      do i = 0, count
+        write (s,*) x
+        read (s,*) y
+        if (y /= x) res = res + 1
+        x = nearest(x,-huge(x))
+      end do
+    end if
+  end function test_rl
+
+end module test_default_format
diff --git a/gcc/testsuite/gfortran.dg/default_format_denormal_1.f90 b/gcc/testsuite/gfortran.dg/default_format_denormal_1.f90
new file mode 100644
index 000000000..7c9605383
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/default_format_denormal_1.f90
@@ -0,0 +1,26 @@
+! { dg-do run { xfail *-*-darwin[89]* *-*-cygwin* spu-*-* } }
+! Test XFAILed on these platforms because the system's printf() lacks
+! proper support for denormals.
+!
+! This tests that the default formats for formatted I/O of reals are
+! wide enough and have enough precision, by checking that values can
+! be written and read back.
+!
+! { dg-add-options ieee }
+
+include "default_format_1.inc"
+
+program main
+  use test_default_format
+
+  if (test (tiny(0.0_4), -1) /= 0) call abort
+  if (test (-tiny(0.0_4), 1) /= 0) call abort
+  if (test (0.0_4, 0) /= 0) call abort
+
+  if (test (tiny(0.0_8), -1) /= 0) call abort
+  if (test (-tiny(0.0_8), 1) /= 0) call abort
+  if (test (0.0_8, 0) /= 0) call abort
+
+end program main
+!
+! { dg-final { cleanup-modules "test_default_format" } }
diff --git a/gcc/testsuite/gfortran.dg/default_format_denormal_2.f90 b/gcc/testsuite/gfortran.dg/default_format_denormal_2.f90
new file mode 100644
index 000000000..36697067c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/default_format_denormal_2.f90
@@ -0,0 +1,21 @@
+! { dg-require-effective-target fortran_large_real }
+! { dg-do run { xfail powerpc*-apple-darwin* powerpc*-*-linux* } }
+! Test XFAILed on these platforms because the system's printf() lacks
+! proper support for denormalized long doubles. See PR24685
+!
+! This tests that the default formats for formatted I/O of reals are
+! wide enough and have enough precision, by checking that values can
+! be written and read back.
+!
+! { dg-add-options ieee }
+
+include "default_format_2.inc"
+
+program main
+  use test_default_format
+
+  if (test (tiny(0.0_kl), -1) /= 0) call abort
+  if (test (-tiny(0.0_kl), 1) /= 0) call abort
+end program main
+!
+! { dg-final { cleanup-modules "test_default_format" } }
diff --git a/gcc/testsuite/gfortran.dg/default_initialization_1.f90 b/gcc/testsuite/gfortran.dg/default_initialization_1.f90
new file mode 100644
index 000000000..b03b698f5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/default_initialization_1.f90
@@ -0,0 +1,21 @@
+!
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! PR 20845; for F2008: PR fortran/43185
+!
+! In ISO/IEC 1539-1:1997(E), 4th constraint in section 11.3:
+!
+!   If an object of a type for which component-initialization is specified
+!   (R429) appears in the specification-part of a module and does not have
+!   the ALLOCATABLE or POINTER attribute, the object shall have the SAVE
+!   attribute.
+!
+module bad
+   implicit none
+   type default_initialization
+      integer :: x = 42
+   end type default_initialization
+   type (default_initialization) t ! { dg-error "default initialization" }
+end module bad
+
+! { dg-final { cleanup-modules "bad" } }
diff --git a/gcc/testsuite/gfortran.dg/default_initialization_2.f90 b/gcc/testsuite/gfortran.dg/default_initialization_2.f90
new file mode 100644
index 000000000..cc7ecdc40
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/default_initialization_2.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! This tests the patch for PR29098, in which the presence of the default
+! initializer would cause allocate to fail because the latter uses
+! the interface assignment.  This, in its turn was failing because
+! no expressions were found for the other components; and a FAILURE
+! was returned from resolve_structure_cons.
+!
+! Contributed by Olav Vahtras  <vahtras@pdc.kth.se>
+!
+ MODULE MAT
+   TYPE BAS
+      INTEGER :: R = 0,C = 0
+   END TYPE BAS
+   TYPE BLOCK
+      INTEGER, DIMENSION(:), POINTER ::  R,C
+      TYPE(BAS), POINTER, DIMENSION(:) :: NO => NULL()
+   END TYPE BLOCK
+   INTERFACE ASSIGNMENT(=)
+      MODULE PROCEDURE BLASSIGN
+   END INTERFACE
+   CONTAINS
+      SUBROUTINE BLASSIGN(A,B)
+      TYPE(BLOCK), INTENT(IN) :: B
+      TYPE(BLOCK), INTENT(INOUT) :: A
+      INTEGER I,N
+      ! ...
+      END SUBROUTINE BLASSIGN
+ END MODULE MAT
+PROGRAM TEST
+USE MAT
+TYPE(BLOCK) MATRIX
+POINTER MATRIX
+ALLOCATE(MATRIX)
+END
+
+! { dg-final { cleanup-modules "mat" } }
diff --git a/gcc/testsuite/gfortran.dg/default_initialization_3.f90 b/gcc/testsuite/gfortran.dg/default_initialization_3.f90
new file mode 100644
index 000000000..43651985d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/default_initialization_3.f90
@@ -0,0 +1,108 @@
+! { dg-do run }
+! Test the fix for PR34438, in which default initializers
+! forced the derived type to be static; ie. initialized once
+! during the lifetime of the programme.  Instead, they should
+! be initialized each time they come into scope.
+!
+! Contributed by Sven Buijssen <sven.buijssen@math.uni-dortmund.de>
+! Third test is from  Dominique Dhumieres <dominiq@lps.ens.fr>
+!
+module demo
+   type myint
+     integer :: bar = 42
+   end type myint
+end module demo
+
+! As the name implies, this was the original testcase
+! provided by the contributor....
+subroutine original
+  use demo
+  integer val1 (6)
+  integer val2 (6)
+  call recfunc (1)
+  if (any (val1 .ne. (/1, 2, 3, 1, 2, 3/))) call abort ()
+  if (any (val2 .ne. (/1, 2, 3, 4, 4, 4/))) call abort ()
+contains
+
+  recursive subroutine recfunc (ivalue)
+    integer, intent(in) :: ivalue
+    type(myint) :: foo1
+    type(myint) :: foo2 = myint (99)
+    foo1%bar = ivalue
+    foo2%bar = ivalue
+    if (ivalue .le. 3) then
+      val1(ivalue) = foo1%bar
+      val2(ivalue) = foo2%bar
+      call recfunc (ivalue + 1)
+      val1(ivalue + 3) = foo1%bar
+      val2(ivalue + 3) = foo2%bar
+    endif
+  end subroutine recfunc
+end subroutine original
+
+! ...who came up with this one too.
+subroutine func (ivalue, retval1, retval2)
+  use demo
+  integer, intent(in) :: ivalue
+  type(myint) :: foo1
+  type(myint) :: foo2 = myint (77)
+  type(myint) :: retval1
+  type(myint) :: retval2
+  retval1 = foo1
+  retval2 = foo2
+  foo1%bar = 999
+  foo2%bar = 999
+end subroutine func
+
+subroutine other
+  use demo
+  interface
+    subroutine func(ivalue, rv1, rv2)
+      use demo
+      integer, intent(in) :: ivalue
+      type(myint) :: foo, rv1, rv2
+   end subroutine func
+  end interface
+  type(myint) :: val1, val2
+  call func (1, val1, val2)
+  if ((val1%bar .ne. 42) .or. (val2%bar .ne. 77)) call abort ()
+  call func (2, val1, val2)
+  if ((val1%bar .ne. 42) .or. (val2%bar .ne. 999)) call abort ()
+
+end subroutine other
+
+MODULE M1
+  TYPE T1
+    INTEGER :: i=7
+  END TYPE T1
+CONTAINS
+  FUNCTION F1(d1) RESULT(res)
+    INTEGER :: res
+    TYPE(T1), INTENT(OUT) :: d1
+    TYPE(T1), INTENT(INOUT) :: d2
+    res=d1%i
+    d1%i=0
+    RETURN
+  ENTRY   E1(d2) RESULT(res)
+    res=d2%i
+    d2%i=0
+  END FUNCTION F1
+END MODULE M1
+
+! This tests the fix of a regression caused by the first version
+! of the patch.
+subroutine dominique ()
+  USE M1
+  TYPE(T1) :: D1
+  D1=T1(3)
+  if (F1(D1) .ne. 7) call abort ()
+  D1=T1(3)
+  if (E1(D1) .ne. 3) call abort ()
+END
+
+! Run both tests.
+  call original
+  call other
+  call dominique
+end
+! { dg-final { cleanup-modules "demo M1" } }
diff --git a/gcc/testsuite/gfortran.dg/default_initialization_4.f90 b/gcc/testsuite/gfortran.dg/default_initialization_4.f90
new file mode 100644
index 000000000..7a15ba2c3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/default_initialization_4.f90
@@ -0,0 +1,22 @@
+!
+! { dg-do run }
+!
+! PR fortran/43185
+!
+! The following is valid F2008 but not valid Fortran 90/2003
+! Cf. PR 20845
+!
+module good
+   implicit none
+   type default_initialization
+      integer :: x = 42
+   end type default_initialization
+   type (default_initialization) t ! OK in F2008
+end module good
+
+use good
+if (t%x /= 42) call abort()
+t%x = 0
+if (t%x /= 0) call abort()
+end
+! { dg-final { cleanup-modules "good" } }
diff --git a/gcc/testsuite/gfortran.dg/default_initialization_5.f90 b/gcc/testsuite/gfortran.dg/default_initialization_5.f90
new file mode 100644
index 000000000..11927619d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/default_initialization_5.f90
@@ -0,0 +1,66 @@
+! { dg-do  run }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/51435
+!
+! Contributed by darmar.xxl@gmail.com
+!
+module arr_m
+    type arr_t
+        real(8), dimension(:), allocatable :: rsk
+    end type
+    type arr_t2
+        integer :: a = 77
+    end type
+end module arr_m
+!*********************
+module list_m
+    use arr_m
+    implicit none
+
+    type(arr_t2), target :: tgt
+
+    type my_list
+        type(arr_t), pointer :: head => null()
+    end type my_list
+    type my_list2
+        type(arr_t2), pointer :: head => tgt
+    end type my_list2
+end module list_m
+!***********************
+module worker_mod
+    use list_m
+    implicit none
+
+    type data_all_t
+        type(my_list) :: my_data
+    end type data_all_t
+    type data_all_t2
+        type(my_list2) :: my_data
+    end type data_all_t2
+contains
+    subroutine do_job()
+        type(data_all_t) :: dum
+        type(data_all_t2) :: dum2
+
+        if (associated(dum%my_data%head)) then
+          call abort()
+        else
+            print *, 'OK: do_job my_data%head is NOT associated'
+        end if
+
+        if (dum2%my_data%head%a /= 77) &
+          call abort()
+    end subroutine
+end module
+!***************
+program hello
+    use worker_mod
+    implicit none
+    call do_job()
+end program
+
+! { dg-final { scan-tree-dump-times "my_data.head = 0B" 1 "original" } }
+! { dg-final { scan-tree-dump-times "my_data.head = &tgt" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-modules "arr_m list_m worker_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/default_numeric_type_1.f90 b/gcc/testsuite/gfortran.dg/default_numeric_type_1.f90
new file mode 100644
index 000000000..62d633d3f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/default_numeric_type_1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+! Tests the fix for PR 31222, in which the type of the arguments of abs
+! and int below were not detected to be of default numeric type..
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+subroutine mysub1(a,b,mode,dis)
+!  integer :: mode
+!  real :: dis
+  dimension a(abs(mode)),b(int(dis))
+  print *, mod
+  write (*,*) abs(mode), nint(dis)
+end subroutine
+
+program testprog
+  call mysub1((/1.,2./),(/1.,2.,3./),-2, 3.2)
+end
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/deferred_type_param_1.f90 b/gcc/testsuite/gfortran.dg/deferred_type_param_1.f90
new file mode 100644
index 000000000..4382fae51
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_type_param_1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/45170
+!
+! Character deferred type parameter
+!
+implicit none
+character(len=:), allocatable :: str(:) ! { dg-error "Fortran 2003: deferred type parameter" }
+
+character(len=4) :: str2*(:) ! { dg-error "Fortran 2003: deferred type parameter" }
+end
diff --git a/gcc/testsuite/gfortran.dg/deferred_type_param_2.f90 b/gcc/testsuite/gfortran.dg/deferred_type_param_2.f90
new file mode 100644
index 000000000..8ac48c3f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_type_param_2.f90
@@ -0,0 +1,62 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
+! PR fortran/45170
+!
+! Character deferred type parameter
+!
+
+subroutine one(x, y) ! { dg-error "Entity .y. at .1. has a deferred type parameter" }
+  implicit none
+  character(len=:), pointer :: x
+  character(len=:) :: y
+  character(len=:), allocatable, target :: str2
+  character(len=:), target :: str ! { dg-error "deferred type parameter" }
+end subroutine one
+
+subroutine two()
+  implicit none
+  character(len=:), allocatable, target :: str1(:)
+  character(len=5), save, target :: str2
+  character(len=:), pointer :: pstr => str2
+  character(len=:), pointer :: pstr2(:)
+end subroutine two
+
+subroutine three()
+!  implicit none  ! Disabled because of PR 46152
+  character(len=:), allocatable, target :: str1(:)
+  character(len=5), save, target :: str2
+  character(len=:), pointer :: pstr
+  character(len=:), pointer :: pstr2(:)
+
+  pstr => str2
+  pstr2 => str1
+  str1 = ["abc"]
+  pstr2 => str1
+
+  allocate (character(len=77) :: str1(1))
+  allocate (pstr, source=str2)
+  allocate (pstr, mold=str2)
+  allocate (pstr) ! { dg-error "requires either a type-spec or SOURCE tag" }
+  allocate (character(len=:) :: str1(1)) ! { dg-error "cannot contain a deferred type parameter" }
+
+  str1 = [ character(len=2) :: "abc" ]
+  str1 = [ character(len=:) :: "abc" ] ! { dg-error "cannot contain a deferred type parameter" }
+end subroutine three
+
+subroutine four()
+  implicit none
+  character(len=:), allocatable, target :: str
+  character(len=:), pointer :: pstr
+  pstr => str
+  str = "abc"
+  if(len(pstr) /= len(str) .or. len(str)/= 3) call abort()
+  str = "abcd"
+  if(len(pstr) /= len(str) .or. len(str)/= 4) call abort()
+end subroutine four
+
+subroutine five()
+character(len=4) :: str*(:)
+allocatable :: str
+end subroutine five
+
diff --git a/gcc/testsuite/gfortran.dg/defined_operators_1.f90 b/gcc/testsuite/gfortran.dg/defined_operators_1.f90
new file mode 100644
index 000000000..c7868d14c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/defined_operators_1.f90
@@ -0,0 +1,68 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+! Tests the fix for PR27122, in which the requirements of 12.3.2.1.1
+! for defined operators were not enforced.
+! 
+! Based on PR test by Thomas Koenig  <tkoenig@gcc.gnu.org>
+!
+module mymod
+  interface operator (.foo.)
+     module procedure foo_0
+     module procedure foo_1
+     module procedure foo_2
+     module procedure foo_3
+     module procedure foo_1_OK  ! { dg-error "Ambiguous interfaces" }
+     module procedure foo_2_OK
+     function foo_chr (chr) ! { dg-error "cannot be assumed character length" }
+       character(*) :: foo_chr
+       character(*), intent(in) :: chr
+     end function foo_chr
+  end interface
+
+  !
+  ! PR fortran/33117
+  ! PR fortran/46478
+  ! Mixing FUNCTIONs and SUBROUTINEs in an INTERFACE hides the
+  ! errors that should be tested here. Hence split out subroutine
+  ! to test separately.
+  !
+  interface operator (.bar.)
+     subroutine bad_foo (chr) ! { dg-error "must be a FUNCTION" }
+       character(*), intent(in) :: chr
+     end subroutine bad_foo
+  end interface
+
+contains
+  function foo_0 () ! { dg-error "must have at least one argument" }
+    integer :: foo_1
+    foo_0 = 1
+  end function foo_0
+  function foo_1 (a) ! { dg-error "must be INTENT" }
+    integer :: foo_1
+    integer :: a
+    foo_1 = 1
+  end function foo_1
+  function foo_1_OK (a)
+    integer :: foo_1_OK
+    integer, intent (in) :: a
+    foo_1_OK = 1
+  end function foo_1_OK
+  function foo_2 (a, b) ! { dg-error "cannot be optional" }
+    integer :: foo_2
+    integer, intent(in) :: a
+    integer, intent(in), optional :: b
+    foo_2 = 2 * a + b
+  end function foo_2
+  function foo_2_OK (a, b)
+    real :: foo_2_OK
+    real, intent(in) :: a
+    real, intent(in) :: b
+    foo_2_OK = 2.0 * a + b
+  end function foo_2_OK
+  function foo_3 (a, b, c) ! { dg-error "must have, at most, two arguments" }
+    integer :: foo_3
+    integer, intent(in) :: a, b, c
+    foo_3 = a + 3 * b - c
+  end function foo_3
+end module mymod
+! { dg-final { cleanup-modules "mymod" } }
diff --git a/gcc/testsuite/gfortran.dg/deftype_1.f90 b/gcc/testsuite/gfortran.dg/deftype_1.f90
new file mode 100644
index 000000000..e0476d02e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deftype_1.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! Checks for excess errors.
+implicit none
+dimension i(10) ! { dg-error "has no IMPLICIT type" }
+i = 2
+end
diff --git a/gcc/testsuite/gfortran.dg/dependency_1.f90 b/gcc/testsuite/gfortran.dg/dependency_1.f90
new file mode 100644
index 000000000..5a5a89882
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! PR23906
+! Dependency analysis was using the stride from the wrong expression and
+! segfaulting
+subroutine foo(a)
+  real, dimension(:) :: a
+
+  a(1:3:2) = a(1:2) 
+  a(1:2) = a(1:3:2) 
+end subroutine
+
diff --git a/gcc/testsuite/gfortran.dg/dependency_10.f90 b/gcc/testsuite/gfortran.dg/dependency_10.f90
new file mode 100644
index 000000000..d6edde2bd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_10.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a)
+  integer, dimension (4) :: a
+  integer :: n
+
+  n = 3
+  where (a(:n) .ne. 0)
+    a(:n) = 1
+  endwhere
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_11.f90 b/gcc/testsuite/gfortran.dg/dependency_11.f90
new file mode 100644
index 000000000..3874a79a3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_11.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a)
+  integer, dimension (4) :: a
+  integer :: n
+
+  n = 3
+  where (a(:n-1) .ne. 0)
+    a(:n-1) = 1
+  endwhere
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_12.f90 b/gcc/testsuite/gfortran.dg/dependency_12.f90
new file mode 100644
index 000000000..09fe19650
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_12.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a,b)
+  integer, pointer, dimension (:,:) :: a
+  real, dimension(:,:) :: b
+
+  where (a == 0)
+    b = 0.0
+  endwhere
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_13.f90 b/gcc/testsuite/gfortran.dg/dependency_13.f90
new file mode 100644
index 000000000..887da9dbb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_13.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+   integer :: i(5)
+   real(4) :: x(5)
+   equivalence(x,i)
+
+   i = (/ 1, 0, 3, 5, 0 /)
+   where (i(1:4) .ne. 0)
+     x(2:5) = -42.
+   end where
+   end
+! { dg-final { scan-tree-dump-times "temp" 3 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_14.f90 b/gcc/testsuite/gfortran.dg/dependency_14.f90
new file mode 100644
index 000000000..71e962c15
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_14.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a,i)
+  integer, dimension (4,4) :: a
+  integer :: i
+
+  where (a(i,1:3) .ne. 0)
+    a(i+1,2:4) = 1
+  endwhere
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_15.f90 b/gcc/testsuite/gfortran.dg/dependency_15.f90
new file mode 100644
index 000000000..36eb3a464
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_15.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a,i)
+  integer, dimension (4,4) :: a
+  integer :: i
+
+  where (a(i,1:3) .ne. 0)
+    a(i-1,2:4) = 1
+  endwhere
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_16.f90 b/gcc/testsuite/gfortran.dg/dependency_16.f90
new file mode 100644
index 000000000..b669771b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_16.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a,i)
+  integer, dimension (4,4) :: a
+  integer :: i
+
+  where (a(i+1,1:3) .ne. 0)
+    a(i+2,2:4) = 1
+  endwhere
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_17.f90 b/gcc/testsuite/gfortran.dg/dependency_17.f90
new file mode 100644
index 000000000..06d15082c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_17.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a,i)
+  integer, dimension (3,3,4) :: a
+  integer :: i
+
+  where (a(1,1:2,1:3) .ne. 0)
+    a(2:3,3,2:4) = 1
+  endwhere
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_18.f90 b/gcc/testsuite/gfortran.dg/dependency_18.f90
new file mode 100644
index 000000000..cb0799d1f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_18.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a,i,j,k)
+  integer, dimension (10) :: a
+  integer :: i, j, k
+
+  a(1:5:2) = a(8:6:-1)
+
+  a(1:8) = a(2:9)
+
+  a(4:7) = a(4:1:-1)
+
+  a(i:i+2) = a(i+4:i+6)
+
+  a(j:1:-1) = a(j:5)
+
+  a(k:k+2) = a(k+1:k+3)
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_19.f90 b/gcc/testsuite/gfortran.dg/dependency_19.f90
new file mode 100644
index 000000000..b0af15855
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_19.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! Tests the fix for PR30273, in which the pointer assignment was
+! wrongly determined to have dependence because NULL() was not
+! recognised by the analysis.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+!
+module gfcbug49
+  implicit none
+
+  type spot_t
+     integer, pointer     :: vm(:,:,:)
+  end type spot_t
+
+  type rc_t
+    integer               :: n
+    type(spot_t), pointer :: spots(:) => NULL()
+  end type rc_t  
+
+contains
+
+  subroutine construct (rc, n)
+    type(rc_t), intent(out) :: rc
+    integer   , intent(in)  :: n
+    integer :: k
+    rc% n = n
+    allocate (rc% spots (n))
+    forall (k=1:n)
+       rc% spots (k)% vm => NULL() ! gfortran didn't swallow this
+    end forall
+  end subroutine construct
+
+end module gfcbug49
+! { dg-final { cleanup-modules "gfcbug49" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_2.f90 b/gcc/testsuite/gfortran.dg/dependency_2.f90
new file mode 100644
index 000000000..1cbdec795
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_2.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! Tests the fix for PR20938 in which dependencies between equivalenced 
+! arrays were not detected.
+! 
+real, dimension (3) :: a = (/1., 2., 3./), b, c
+equivalence (a(2), b), (a(1), c)
+b = a;
+if (any(b .ne. (/1., 2., 3./))) call abort ()
+b = c
+if (any(b .ne. (/1., 1., 2./))) call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/dependency_20.f90 b/gcc/testsuite/gfortran.dg/dependency_20.f90
new file mode 100644
index 000000000..ed8fa14a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_20.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+  integer :: a(4)
+
+  where (a(:) .ne. 0)
+    a(:) = (/ 1, 2, 3, 4 /)
+  endwhere
+end
+! { dg-final { scan-tree-dump-times "temp" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_21.f90 b/gcc/testsuite/gfortran.dg/dependency_21.f90
new file mode 100644
index 000000000..ca25458f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_21.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! Test the fix for PR31711 in which the dependency in the assignment
+! at line 18 was detected and then ignored.
+!
+! Contributed by Tobias Ivarsson <thobes@gmail.com>
+!
+program laplsolv
+  IMPLICIT NONE
+  integer, parameter                  :: n = 2
+  double precision,dimension(0:n+1, 0:n+1) :: T
+  integer                             :: i
+
+  T=0.0
+  T(0:n+1 , 0)     = 1.0
+  T(0:n+1 , n+1)   = 1.0
+  T(n+1   , 0:n+1) = 2.0
+
+  T(1:n,1)=(T(0:n-1,1)+T(1:n,1+1)+1d0)
+
+  if (any (T(1:n,1) .ne. 1d0 )) call abort ()
+end program laplsolv
diff --git a/gcc/testsuite/gfortran.dg/dependency_22.f90 b/gcc/testsuite/gfortran.dg/dependency_22.f90
new file mode 100644
index 000000000..bedf70276
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_22.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! Test the fix for PR37723 in which the array element reference masked the dependency
+! by inhibiting the test.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+      program try_cg0071
+      type seq
+          integer ia(10)
+      end type
+      TYPE(SEQ) UDA1R
+      type(seq) uda(1)
+
+      do j1 = 1,10
+        uda1r%ia(j1) = j1
+      enddo
+
+      uda = uda1r
+      UDA(1)%IA(1:9) = UDA(1)%IA(9:1:-1)+1
+
+      DO J1 = 1,9
+         if (UDA1R%IA(10-J1)+1 /=  Uda(1)%IA(J1)) call abort()
+      ENDDO
+
+      end
+
+
diff --git a/gcc/testsuite/gfortran.dg/dependency_23.f90 b/gcc/testsuite/gfortran.dg/dependency_23.f90
new file mode 100644
index 000000000..447d626c5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_23.f90
@@ -0,0 +1,57 @@
+! { dg-do run }
+! Test the fix for PR38863, in which an unnecessary temporary
+! generated results that are not consistent with other compilers.
+!
+! Contributed by Dick Hendrickson  <dick.hendrickson@gmail.com>
+!
+module rg0045_stuff
+  type unseq
+    integer :: i
+    logical :: l
+  end type unseq
+  interface assignment(=)
+    module procedure l_to_t, i_to_t
+  end interface
+contains
+  elemental subroutine l_to_t (arg1, arg2)
+    type(unseq), intent(inout) :: arg1
+    logical, intent(in) :: arg2
+    arg1%l = arg2
+  end subroutine l_to_t
+  elemental subroutine i_to_t (arg1, arg2)
+    type(unseq), intent(inout) :: arg1
+    integer, intent(in) :: arg2
+    arg1%i = arg2
+  end subroutine i_to_t
+  subroutine rg0045(nf1, nf2, nf3)
+    type(unseq) :: tla2l(nf3, nf2)
+    type(unseq) :: tda2l(3,2)
+    logical :: lda(nf3,nf2)
+    tda2l%l = reshape ([.true.,.false.,.true.,.false.,.true.,.false.],[3,2])
+    tda2l%i = reshape ([1, -1, 3, -1, 5, -1],[3,2])
+    lda = tda2l%l
+    tla2l%l = lda
+    tla2l%i = reshape ([1, 2, 3, 4, 5, 6], [3,2])
+!
+! The problem occurred here: gfortran was producing a temporary for these
+! assignments because the dependency checking was too restrictive.  Since
+! a temporary was used, the integer component was reset in the first assignment
+! rather than being carried over.
+!
+    where(lda)
+      tla2l = tla2l(1:3, 1:2)%l
+      tla2l = tla2l(1:3, 1:2)%i
+    elsewhere
+      tla2l = -1
+    endwhere
+    if (any (tla2l%i .ne. tda2l%i)) call abort
+    if (any (tla2l%l .neqv. tda2l%l)) call abort
+  end subroutine
+end module rg0045_stuff
+
+  use rg0045_stuff
+  call rg0045(1, 2, 3)
+end
+! { dg-final { cleanup-modules "rg0045_stuff" } }
+
+
diff --git a/gcc/testsuite/gfortran.dg/dependency_24.f90 b/gcc/testsuite/gfortran.dg/dependency_24.f90
new file mode 100644
index 000000000..9645f2075
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_24.f90
@@ -0,0 +1,81 @@
+! { dg-do run }
+! Check the fix for PR38863 comment #1, where defined assignment
+! to derived types was not treating components correctly that were
+! not set explicitly.
+!
+! Contributed by Mikael Morin  <mikael@gcc.gnu.org>
+!
+module m
+  type t
+    integer :: i,j
+  end type t
+  type ti
+    integer :: i,j = 99
+  end type ti
+  interface assignment (=)
+    module procedure i_to_t, i_to_ti
+  end interface
+contains 
+  elemental subroutine i_to_ti (p, q)
+    type(ti), intent(out) :: p
+    integer, intent(in)  :: q
+    p%i = q
+  end subroutine
+  elemental subroutine i_to_t (p, q)
+    type(t), intent(out) :: p
+    integer, intent(in)  :: q
+    p%i = q
+  end subroutine
+end module
+
+  use m
+  call test_t  ! Check original problem
+  call test_ti ! Default initializers were treated wrongly
+contains
+  subroutine test_t
+    type(t), target :: a(3)
+    type(t), target  :: b(3)
+    type(t), dimension(:), pointer :: p
+    logical :: l(3)
+
+    a%i = 1
+    a%j = [101, 102, 103]
+    b%i = 3
+    b%j = 4
+
+    p => b
+    l = .true.
+
+    where (l)
+      a = p%i         ! Comment #1 of PR38863 concerned WHERE assignment
+    end where
+    if (any (a%j .ne. [101, 102, 103])) call abort
+
+    a = p%i           ! Ordinary assignment was wrong too.
+    if (any (a%j .ne. [101, 102, 103])) call abort
+  end subroutine
+
+  subroutine test_ti
+    type(ti), target :: a(3)
+    type(ti), target  :: b(3)
+    type(ti), dimension(:), pointer :: p
+    logical :: l(3)
+
+    a%i = 1
+    a%j = [101, 102, 103]
+    b%i = 3
+    b%j = 4
+
+    p => b
+    l = .true.
+
+    where (l)
+      a = p%i
+    end where
+    if (any (a%j .ne. 99)) call abort
+
+    a = p%i
+    if (any (a%j .ne. 99)) call abort
+  end subroutine
+end
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_25.f90 b/gcc/testsuite/gfortran.dg/dependency_25.f90
new file mode 100644
index 000000000..25769857d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_25.f90
@@ -0,0 +1,95 @@
+! { dg-do run }
+! Test the fix for PR42736, in which an excessively rigorous dependency
+! checking for the assignment generated an unnecessary temporary, whose
+! rank was wrong.  When accessed by the scalarizer, a segfault ensued.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+! Reported by Armelius Cameron <armeliusc@gmail.com>
+!
+module UnitValue_Module
+
+  implicit none
+  private
+
+  public :: &
+    operator(*), &
+    assignment(=)
+
+  type, public :: UnitValue
+    real :: &
+      Value = 1.0
+    character(31) :: &
+      Label
+  end type UnitValue
+
+  interface operator(*)
+    module procedure ProductReal_LV
+  end interface operator(*)
+
+  interface assignment(=)
+    module procedure Assign_LV_Real
+  end interface assignment(=)
+
+contains
+
+  elemental function ProductReal_LV(Multiplier, Multiplicand) result(P_R_LV)
+
+    real, intent(in) :: &
+      Multiplier
+    type(UnitValue), intent(in) :: &
+      Multiplicand
+    type(UnitValue) :: &
+      P_R_LV
+
+    P_R_LV%Value = Multiplier * Multiplicand%Value
+    P_R_LV%Label = Multiplicand%Label
+
+  end function ProductReal_LV
+
+
+  elemental subroutine Assign_LV_Real(LeftHandSide, RightHandSide)
+
+    real, intent(inout) :: &
+      LeftHandSide
+    type(UnitValue), intent(in) :: &
+      RightHandSide
+
+    LeftHandSide = RightHandSide%Value
+
+  end subroutine Assign_LV_Real
+
+end module UnitValue_Module
+
+program TestProgram
+
+  use UnitValue_Module
+
+  implicit none
+
+  type :: TableForm
+    real, dimension(:,:), allocatable :: &
+      RealData
+  end type TableForm
+
+  type(UnitValue) :: &
+    CENTIMETER
+
+  type(TableForm), pointer :: &
+    Table
+
+  allocate(Table)
+  allocate(Table%RealData(10,5))
+
+  CENTIMETER%value = 42
+  Table%RealData = 1
+  Table%RealData(:,1) = Table%RealData(:,1) * CENTIMETER
+  Table%RealData(:,2) = Table%RealData(:,2) * CENTIMETER
+  Table%RealData(:,3) = Table%RealData(:,3) * CENTIMETER
+  Table%RealData(:,5) = Table%RealData(:,5) * CENTIMETER
+
+!  print *, Table%RealData
+  if (any (abs(Table%RealData(:,4) - 1) > epsilon(1.0))) call abort ()
+  if (any (abs(Table%RealData(:,[1,2,3,5]) - 42) > epsilon(1.0))) call abort ()
+end program TestProgram
+
+! { dg-final { cleanup-modules "UnitValue_Module" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_26.f90 b/gcc/testsuite/gfortran.dg/dependency_26.f90
new file mode 100644
index 000000000..df909b484
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_26.f90
@@ -0,0 +1,53 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for PR36932 and PR36933, in which unnecessary
+! temporaries were being generated.  The module m2 tests the
+! additional testcase in comment #3 of PR36932.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+MODULE M2
+  IMPLICIT NONE
+  TYPE particle
+   REAL :: r(3)
+  END TYPE
+CONTAINS
+  SUBROUTINE S1(p)
+     TYPE(particle), POINTER, DIMENSION(:) :: p
+     REAL :: b(3)
+     INTEGER :: i
+     b=pbc(p(i)%r)
+  END SUBROUTINE S1
+  FUNCTION pbc(b)
+     REAL :: b(3)
+     REAL :: pbc(3)
+     pbc=b
+  END FUNCTION
+END MODULE M2
+
+MODULE M1
+  IMPLICIT NONE
+  TYPE cell_type
+     REAL :: h(3,3)
+  END TYPE
+CONTAINS
+  SUBROUTINE S1(cell)
+     TYPE(cell_type), POINTER :: cell
+     REAL :: a(3)
+     REAL :: b(3) = [1, 2, 3]
+     a=MATMUL(cell%h,b)
+     if (ANY (INT (a) .ne. [30, 36, 42])) call abort
+  END SUBROUTINE S1
+END MODULE M1
+
+  use M1
+  TYPE(cell_type), POINTER :: cell
+  allocate (cell)
+  cell%h = reshape ([(real(i), i = 1, 9)], [3, 3])
+  call s1 (cell)
+end
+! { dg-final { cleanup-modules "M1" } }
+! { dg-final { scan-tree-dump-times "&a" 1 "original" } }
+! { dg-final { scan-tree-dump-times "pack" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_27.f90 b/gcc/testsuite/gfortran.dg/dependency_27.f90
new file mode 100644
index 000000000..ee7c4fa42
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_27.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-Warray-temporaries" }
+! PR 36928 - optimize array interleaving array temporaries
+program main
+  real, dimension(20) :: a
+  read (10) a
+  a(2:10:2) = a (1:9:2)
+  write (11) a
+  read (10) a
+  a(2:10:4) = a(1:5:2)
+  write (11) a
+  read (10) a
+  a(2:10:4) = a(5:1:-2)
+  write (11) a
+end program main
diff --git a/gcc/testsuite/gfortran.dg/dependency_28.f90 b/gcc/testsuite/gfortran.dg/dependency_28.f90
new file mode 100644
index 000000000..5d70abe39
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_28.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-Warray-temporaries" }
+module foobar
+  type baz
+     integer :: i
+     integer :: j
+     integer :: k
+     integer :: m
+  end type baz
+contains
+  subroutine foo(a,b,c,i)
+    real, dimension(10) :: a,b
+    type(baz) :: c
+    integer, dimension(10) :: i
+    a(i(1):i(2)) = a(i(1):i(2)) + b(i(1):i(2))
+    a(i(1):i(2)) = a(i(3):i(5)) ! { dg-warning "Creating array temporary" }
+    a(c%i:c%j) = a(c%i:c%j) + b(c%k:c%m)
+    a(c%k:c%m) = a(c%i:c%j) + b(c%k:c%m) ! { dg-warning "Creating array temporary" }
+  end subroutine foo
+end module foobar
+! { dg-final { cleanup-modules "foobar" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_29.f90 b/gcc/testsuite/gfortran.dg/dependency_29.f90
new file mode 100644
index 000000000..398bf2c7b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_29.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-Warray-temporaries" }
+
+subroutine t1(n1,n2, gfft, ufft)
+  implicit none
+  integer :: n1, n2, i
+  real :: gfft(n1,n2), ufft(n2)
+  DO i=1, n1
+     gfft(i,:)=gfft(i,:)*ufft(i)
+  END DO
+end subroutine t1
diff --git a/gcc/testsuite/gfortran.dg/dependency_3.f90 b/gcc/testsuite/gfortran.dg/dependency_3.f90
new file mode 100644
index 000000000..a9dfe935e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_3.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! Tests the fix for PR24519, in which assignments with the same
+! range of an assumed shape array, on the lhs and rhs, would be
+! treated as causing a dependency.
+!
+! Contributed by Paul.Thomas  <pault@gcc.gnu.org>
+!
+  integer, parameter :: n = 100
+  real :: x(n, n), v
+  x = 1
+  v = 0.1
+  call foo (x, v)
+  if (abs(sum (x) -  91.10847) > 1e-3) print *, sum (x)
+contains
+  subroutine foo (b, d)
+    real :: b(:, :)
+    real :: temp(n), c, d
+    integer :: j, k
+    do k = 1, n
+      temp = b(:,k)
+      do j = 1, n
+        c = b(k,j)*d
+        b(:,j) = b(:,j)-temp*c  ! This was the offending assignment.
+        b(k,j) = c
+      end do
+    end do
+  end subroutine foo
+end
diff --git a/gcc/testsuite/gfortran.dg/dependency_30.f90 b/gcc/testsuite/gfortran.dg/dependency_30.f90
new file mode 100644
index 000000000..6deda715b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_30.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-Warray-temporaries" }
+! PR 45159 - make sure no temporary is created for this.
+subroutine foo(a,b,i,j,k,n)
+  implicit none
+  integer, intent(in) :: i, j, k, n
+  real, dimension(n) :: a,b
+  a(k:i-1) = a(i:j)
+end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/dependency_31.f90 b/gcc/testsuite/gfortran.dg/dependency_31.f90
new file mode 100644
index 000000000..afab24984
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_31.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-Warray-temporaries" }
+! PR 45159 - make sure no temporary is created for this.
+subroutine foo(a,n,i,j)
+  implicit none
+  integer, intent(in) :: i,j,n
+  real, dimension(20) :: a
+  a(1:10) = a(i:j)
+  a(20:n:-3) = a(n:i:-3)
+end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/dependency_32.f90 b/gcc/testsuite/gfortran.dg/dependency_32.f90
new file mode 100644
index 000000000..c0a3118ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_32.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-Warray-temporaries" }
+! PR 44235
+! No temporary should be created for this, as the upper bounds
+! are effectively identical.
+program main
+  real a(10)
+  a = 0.
+  a(1:10:4) = a(1:9:4)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/dependency_33.f90 b/gcc/testsuite/gfortran.dg/dependency_33.f90
new file mode 100644
index 000000000..cf6f175d4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_33.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-Warray-temporaries" }
+! No temporary should be created for this, as a missing stride and
+! a stride equal to one should be equal.
+program main
+  integer a(100)
+  a(10:16) = a(11:17)
+  a(10:16) = a(11:17:1)
+  a(10:16:1) = a(11:17)
+  a(10:16:1) = a(11:17:1)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/dependency_34.f90 b/gcc/testsuite/gfortran.dg/dependency_34.f90
new file mode 100644
index 000000000..82d286ebb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_34.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-Warray-temporaries" }
+module foo
+  implicit none
+contains
+  integer pure  function bar(i,j)
+    integer, intent(in) :: i,j
+    bar = 3 - i + 1 * abs(i) + j
+  end function bar
+end module foo
+
+program main
+  use foo
+  implicit none
+  real a(10)
+  integer :: i
+  read (*,*) a, i
+  a(i:abs(i)) = a(i:abs(i))
+  a(bar(i,i+2):2) = a(bar(i,i+2):2)
+  a(int(i,kind=2):5) = a(int(i,kind=2)+1:6)
+end program main
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_35.f90 b/gcc/testsuite/gfortran.dg/dependency_35.f90
new file mode 100644
index 000000000..11b9e8b94
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_35.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-Warray-temporaries -O" }
+module foo
+  implicit none
+contains
+  pure function bar(i,j)
+    integer, intent(in) :: i,j
+    integer, dimension(2,2) :: bar
+    bar = 33
+  end function bar
+end module foo
+
+program main
+  use foo
+  implicit none
+  integer a(2,2), b(2,2),c(2,2), d(2,2), e(2)
+
+  read (*,*) b, c, d
+  a = matmul(b,c) + d
+  a = b + bar(3,4)
+  a = bar(3,4)*5 + b
+  e = sum(b,1) + 3
+end program main
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_36.f90 b/gcc/testsuite/gfortran.dg/dependency_36.f90
new file mode 100644
index 000000000..f3c0ef760
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_36.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-options "-O -Warray-temporaries" }
+! PR 45744 - this used to ICE because of type mismatch
+!            in the generated temporary.
+MODULE m
+CONTAINS
+  FUNCTION rnd(n)
+    INTEGER, INTENT(in) :: n
+    REAL(8), DIMENSION(n) :: rnd
+    CALL RANDOM_NUMBER(rnd)
+  END FUNCTION rnd
+
+  SUBROUTINE GeneticOptimize(n)
+    INTEGER :: n
+    LOGICAL :: mask(n)
+    REAL(8) :: popcross=0
+    REAL(4) :: foo(n)
+    real(4) :: a(n,n), b(n,n)
+    real(8) :: c(n,n)
+    integer(4) :: x(n,n)
+    integer(8) :: bar(n)
+    mask = (rnd(n) < popcross)  ! { dg-warning "Creating array temporary" }
+    foo = rnd(n)                ! { dg-warning "Creating array temporary" }
+    bar = rnd(n)                ! { dg-warning "Creating array temporary" }
+    c = matmul(a,b)             ! { dg-warning "Creating array temporary" }
+    x = matmul(a,b)             ! { dg-warning "Creating array temporary" }
+  END SUBROUTINE GeneticOptimize
+END MODULE m
diff --git a/gcc/testsuite/gfortran.dg/dependency_37.f90 b/gcc/testsuite/gfortran.dg/dependency_37.f90
new file mode 100644
index 000000000..73721c92f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_37.f90
@@ -0,0 +1,49 @@
+! { dg-do compile }
+! { dg-options "-Warray-temporaries" }
+! PR 48231 - this used to create an unnecessary temporary.
+module UnitValue_Module
+  type :: UnitValue
+    real          :: Value = 1.0
+  end type
+
+  interface operator(*)
+    module procedure ProductReal_LV
+  end interface operator(*)
+
+  interface assignment(=)
+    module procedure Assign_LV_Real
+  end interface assignment(=)
+contains
+
+  elemental function ProductReal_LV(Multiplier, Multiplicand) result(P_R_LV)
+    real, intent(in)            :: Multiplier
+    type(UnitValue), intent(in) :: Multiplicand
+    type(UnitValue)             :: P_R_LV
+    P_R_LV%Value = Multiplier * Multiplicand%Value
+  end function ProductReal_LV
+
+  elemental subroutine Assign_LV_Real(LeftHandSide, RightHandSide)
+    real, intent(inout)         :: LeftHandSide
+    type(UnitValue), intent(in) :: RightHandSide
+    LeftHandSide = RightHandSide%Value
+  end subroutine Assign_LV_Real
+end module UnitValue_Module
+
+program TestProgram
+  use UnitValue_Module
+
+  type :: TableForm
+    real, dimension(:,:), allocatable :: RealData
+  end type TableForm
+
+  REAL :: CENTIMETER
+  type(TableForm), pointer :: Table
+
+  allocate(Table)
+  allocate(Table%RealData(10,5))
+
+  CENTIMETER = 42
+  Table%RealData = 1
+  Table%RealData(:,1) = Table%RealData(:,1) * CENTIMETER
+end program TestProgram
+! { dg-final { cleanup-modules "UnitValue_Module" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_38.f90 b/gcc/testsuite/gfortran.dg/dependency_38.f90
new file mode 100644
index 000000000..60cb2ad1b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_38.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-Warray-temporaries" }
+! PR 45159 - No temporary should be created for this.
+program main
+  integer a(100)
+  a(10:16:2) = a(10:16:2)
+  a(10:16:2) = a(10:19:3)
+  a(10:18:2) = a(12:20:2)
+  a(1:10) = a(2:20:2)
+  a(16:10:-2) = a(16:10:-2)
+  a(19:10:-1) = a(19:1:-2)
+  a(19:10:-1) = a(18:9:-1)
+  a(19:11:-1) = a(18:2:-2)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/dependency_39.f90 b/gcc/testsuite/gfortran.dg/dependency_39.f90
new file mode 100644
index 000000000..68c48a4dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_39.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+! PR 45777 - component ref aliases when both are pointers
+module m1
+  type t1
+     integer, dimension(:), allocatable :: data
+  end type t1
+contains
+  subroutine s1(t,d)
+    integer, dimension(:), pointer :: d
+    type(t1), pointer :: t
+    d(1:5)=t%data(3:7)
+  end subroutine s1
+  subroutine s2(d,t)
+    integer, dimension(:), pointer :: d
+    type(t1), pointer :: t
+    t%data(3:7) = d(1:5)
+  end subroutine s2
+end module m1
+
+program main
+  use m1
+  type(t1), pointer :: t
+  integer, dimension(:), pointer :: d
+  allocate(t)
+  allocate(t%data(10))
+  t%data=(/(i,i=1,10)/)
+  d=>t%data(5:9)
+  call s1(t,d)
+  if (any(d.ne.(/3,4,5,6,7/))) call abort()
+  t%data=(/(i,i=1,10)/)
+  d=>t%data(1:5)
+  call s2(d,t)
+  if (any(t%data.ne.(/1,2,1,2,3,4,5,8,9,10/))) call abort
+  deallocate(t%data)
+  deallocate(t)
+end program main
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_4.f90 b/gcc/testsuite/gfortran.dg/dependency_4.f90
new file mode 100644
index 000000000..9eabaf1e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_4.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a)
+  integer, dimension (4) :: a
+
+  where (a .ne. 0)
+    a = 1
+  endwhere
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_40.f90 b/gcc/testsuite/gfortran.dg/dependency_40.f90
new file mode 100644
index 000000000..b7bd4f911
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_40.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! PR 48955 - missing array temporary when there was both a forward
+! and a backward dependency.
+! Test case slightly modified from the original one by Kacper Kowalik.
+program ala
+   implicit none
+
+   integer, parameter  :: n = 6
+   real, dimension(n), parameter :: result = [1.,10.,30.,90.,270., 243.];
+   real, dimension(n) :: v0, v1
+   character(len=80) :: line1, line2
+
+   v0 = [1.0, 3.0, 9.0, 27.0, 81.0, 243.0]
+   v1 = v0
+
+   v1(2:n-1) = v1(1:n-2) + v1(3:n)
+   if (any(v1 /= result)) call abort
+   v1 = v0
+   v1(2:n-1) = v0(1:n-2) + v0(3:n)
+   if (any(v1 /= result)) call abort
+
+   v1 = v0
+   v1(2:n-1) = v1(3:n) + v1(1:n-2)
+   if (any(v1 /= result)) call abort
+   v1 = v0
+   v1(2:n-1) = v0(3:n) + v0(1:n-2)
+   if (any(v1 /= result)) call abort
+
+end program ala
diff --git a/gcc/testsuite/gfortran.dg/dependency_5.f90 b/gcc/testsuite/gfortran.dg/dependency_5.f90
new file mode 100644
index 000000000..307fbd748
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_5.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a)
+  integer, dimension (4) :: a
+
+  where (a(:) .ne. 0)
+    a(:) = 1
+  endwhere
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_6.f90 b/gcc/testsuite/gfortran.dg/dependency_6.f90
new file mode 100644
index 000000000..e90571ea9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_6.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a)
+  integer, dimension (4) :: a
+
+  where (a(:4) .ne. 0)
+    a(:4) = 1
+  endwhere
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_7.f90 b/gcc/testsuite/gfortran.dg/dependency_7.f90
new file mode 100644
index 000000000..52bac8f9f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_7.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a)
+  integer, dimension (4) :: a
+
+  where (a(1:4) .ne. 0)
+    a(1:4) = 1
+  endwhere
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_8.f90 b/gcc/testsuite/gfortran.dg/dependency_8.f90
new file mode 100644
index 000000000..9f7837d60
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_8.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a,i,j)
+  integer, dimension (4,4) :: a
+  integer :: i
+  integer :: j
+
+  where (a(i,1:3) .ne. 0)
+    a(j,2:4) = 1
+  endwhere
+end subroutine
+! { dg-final { scan-tree-dump-times "temp" 3 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependency_9.f90 b/gcc/testsuite/gfortran.dg/dependency_9.f90
new file mode 100644
index 000000000..d1f6f5e3f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_9.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a,i,j)
+  integer, dimension (4,4) :: a
+  integer :: i
+  integer :: j
+
+  where (a(i,:) .ne. 0)
+    a(j,:) = 1
+  endwhere
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/dependent_decls_1.f90 b/gcc/testsuite/gfortran.dg/dependent_decls_1.f90
new file mode 100644
index 000000000..cca0eae51
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependent_decls_1.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! Tests the fix for pr28660 in which the order of dependent declarations
+! would get scrambled in the compiled code.
+!
+! Contributed by Erik Edelmann  <erik.edelmann@iki.fi>
+!
+program bar
+    implicit none
+    real :: x(10)
+    call foo1 (x)
+    call foo2 (x)
+    call foo3 (x)
+contains
+    subroutine foo1 (xmin)
+        real, intent(inout) :: xmin(:)
+        real :: x(size(xmin)+1)           ! The declaration for r would be added
+        real :: r(size(x)-1)              ! to the function before that of x
+        xmin = r
+        if (size(r) .ne. 10) call abort ()
+        if (size(x) .ne. 11) call abort ()
+    end subroutine foo1
+    subroutine foo2 (xmin)                ! This version was OK because of the
+        real, intent(inout) :: xmin(:)    ! renaming of r which pushed it up
+        real :: x(size(xmin)+3)           ! the symtree.
+        real :: zr(size(x)-3)
+        xmin = zr
+        if (size(zr) .ne. 10) call abort ()
+        if (size(x) .ne. 13) call abort ()
+    end subroutine foo2
+    subroutine foo3 (xmin)
+        real, intent(inout) :: xmin(:)
+        character(size(x)+2) :: y         ! host associated x
+        character(len(y)+3) :: z          ! This did not work for any combination
+        real :: r(len(z)-5)              ! of names.
+        xmin = r
+        if (size(r) .ne. 10) call abort ()
+        if (len(z) .ne. 15) call abort ()
+    end subroutine foo3
+end program bar
diff --git a/gcc/testsuite/gfortran.dg/der_array_1.f90 b/gcc/testsuite/gfortran.dg/der_array_1.f90
new file mode 100644
index 000000000..00dc7a5c2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/der_array_1.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! Test derived type constructors for derived types containing arrays.
+! PR16919
+program der_array_1
+  implicit none
+  integer n
+  integer m
+  ! The 4 components here test known shape array, unknown shape array,
+  ! multi-dimensional arrays and array pointers
+  type t
+    integer :: a(2)
+    integer :: b(2)
+    integer, dimension(2, 3) :: c
+    integer, pointer, dimension(:) :: p
+  end type
+  type(t) :: v
+  integer, dimension(2, 3) :: d
+  integer, dimension(:), pointer :: e
+  integer, dimension(2) :: f
+
+  m = 2
+  f = (/3, 4/)
+  d = reshape ((/5, 6, 7, 8, 9, 10/), (/2, 3/));
+  allocate (e(2))
+
+  v = t((/1, 2/), reshape (f, (/m/)), d, e);
+  if (any (v%a .ne. (/1, 2/)) .or. any (v%b .ne. (/3, 4/)) &
+      .or. any (v%c .ne. d) .or. .not. associated (v%p, e)) &
+    call abort ()
+
+  deallocate(e)
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/der_array_io_1.f90 b/gcc/testsuite/gfortran.dg/der_array_io_1.f90
new file mode 100644
index 000000000..244b60074
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/der_array_io_1.f90
@@ -0,0 +1,26 @@
+! Test IO of arrays of integers in derived types
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+program main
+
+  character* 10000 :: buf1, buf2
+  type xyz
+     integer :: x, y(3), z
+  end type xyz
+
+  type (xyz) :: foo(4)
+
+  do i=1,ubound(foo,1)
+     foo(i)%x = 100*i
+     do j=1,3
+        foo(i)%y(j) = 100*i + 10*j 
+     enddo
+     foo(i)%z = 100*i+40
+  enddo
+
+  write (buf1, '(20i4)')  foo
+  write (buf2, '(20i4)')  (foo(i)%x, (foo(i)%y(j), j=1,3), foo(i)%z, i=1,4)
+
+  if (buf1.ne.buf2) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/der_array_io_2.f90 b/gcc/testsuite/gfortran.dg/der_array_io_2.f90
new file mode 100644
index 000000000..21e10d213
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/der_array_io_2.f90
@@ -0,0 +1,31 @@
+! Test IO of arrays in derived type arrays
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+program main
+
+  character *1000 buf1, buf2
+
+  type :: foo_type                                             
+     integer x(3)
+     integer y(4)
+     integer z(5)
+     character*11 a(3)
+  end type foo_type
+                                                                        
+  type (foo_type) :: foo(2)
+  
+  foo(1)%x = 3
+  foo(1)%y = 4
+  foo(1)%z = 5
+  foo(1)%a = "hello world"
+
+  foo(2)%x = 30
+  foo(2)%y = 40
+  foo(2)%z = 50
+  foo(2)%a = "HELLO WORLD"
+
+  write (buf1,*)  foo
+  write (buf2,*) ((foo(i)%x(j),j=1,3), (foo(i)%y(j),j=1,4), (foo(i)%z(j),j=1,5), (foo(i)%a(j),j=1,3), i=1,2)
+  if (buf1.ne.buf2) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/der_array_io_3.f90 b/gcc/testsuite/gfortran.dg/der_array_io_3.f90
new file mode 100644
index 000000000..de562152c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/der_array_io_3.f90
@@ -0,0 +1,15 @@
+! Test IO of character arrays in derived types.
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+program main
+ character*1000 buf1, buf2
+ type :: foo_type
+     character(12), dimension(13) :: name = "hello world "
+  end type foo_type
+  type (foo_type) :: foo
+!  foo = foo_type("hello world ")
+  write (buf1,*)  foo
+  write (buf2,*)  (foo%name(i), i=1,13)
+  if (buf1.ne.buf2) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/der_charlen_1.f90 b/gcc/testsuite/gfortran.dg/der_charlen_1.f90
new file mode 100644
index 000000000..4bdace228
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/der_charlen_1.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! PR 18990
+! we used to ICE on these examples
+module core
+  type, public  :: T
+     character(len=I)  :: str ! { dg-error "needs to be a constant specification expression" }
+  end type T
+  private
+CONTAINS
+  subroutine FOO(X)
+    type(T), intent(in)          :: X
+  end subroutine
+end module core
+
+module another_core
+  type :: T
+     character(len=*)  :: s ! { dg-error "needs to be a constant specification expr" }
+  end type T
+  private
+CONTAINS
+  subroutine FOO(X)
+    type(T), intent(in)          :: X
+  end subroutine
+end module another_core
+
+! { dg-final { cleanup-modules "core another_core" } }
diff --git a/gcc/testsuite/gfortran.dg/der_io_1.f90 b/gcc/testsuite/gfortran.dg/der_io_1.f90
new file mode 100644
index 000000000..4cbbf772c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/der_io_1.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! PR 16404 Nr. 8
+! IO of derived types containing pointers is not allowed
+program der_io_1
+  type t
+    integer, pointer :: p
+  end type
+  integer, target :: i
+  type (t) v
+  character(4) :: s
+
+  v%p => i
+  i = 42
+  write (unit=s, fmt='(I2)') v ! { dg-error "POINTER components" "" }
+  if (s .ne. '42') call abort ()
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/der_io_2.f90 b/gcc/testsuite/gfortran.dg/der_io_2.f90
new file mode 100644
index 000000000..09878b690
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/der_io_2.f90
@@ -0,0 +1,55 @@
+! { dg-do compile }
+! PR 23843
+! IO of derived types with private components is allowed in the module itself,
+! but not elsewhere
+module gfortran2
+    type :: tp1
+        private
+        integer :: i
+    end type tp1
+
+    type :: tp1b
+        integer :: i
+    end type tp1b
+
+    type :: tp2
+        real :: a
+        type(tp1) :: t
+    end type tp2
+    
+contains
+    
+    subroutine test()
+        type(tp1) :: x
+        type(tp2) :: y
+
+        write (*, *) x
+        write (*, *) y
+    end subroutine test
+
+end module gfortran2
+
+program prog
+
+    use gfortran2
+
+    implicit none
+    type :: tp3
+        type(tp2) :: t
+    end type tp3
+    type :: tp3b
+        type(tp1b) :: t
+    end type tp3b
+
+    type(tp1) :: x
+    type(tp2) :: y
+    type(tp3) :: z
+    type(tp3b) :: zb
+
+    write (*, *) x   ! { dg-error "PRIVATE components" }
+    write (*, *) y   ! { dg-error "PRIVATE components" }
+    write (*, *) z   ! { dg-error "PRIVATE components" }
+    write (*, *) zb
+end program prog
+
+! { dg-final { cleanup-modules "gfortran2" } }
diff --git a/gcc/testsuite/gfortran.dg/der_io_3.f90 b/gcc/testsuite/gfortran.dg/der_io_3.f90
new file mode 100644
index 000000000..1cb370ce1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/der_io_3.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! PR23843
+! Make sure derived type I/O with PRIVATE components works where it's allowed
+module m1
+  type t1
+     integer i
+  end type t1
+end module m1
+
+module m2
+  use m1
+
+  type t2
+     private
+     type (t1) t
+  end type t2
+
+  type t3
+     private
+     integer i
+  end type t3
+
+contains
+  subroutine test
+    character*20 c
+    type(t2) :: a
+    type(t3) :: b
+
+    a % t % i = 31337
+    b % i = 255
+    
+    write(c,*) a
+    if (trim(adjustl(c)) /= "31337") call abort
+    write(c,*) b
+    if (trim(adjustl(c)) /= "255") call abort
+  end subroutine test
+end module m2
+
+use m2
+call test
+end
+
+! { dg-final { cleanup-modules "m1 m2" } }
diff --git a/gcc/testsuite/gfortran.dg/der_io_4.f90 b/gcc/testsuite/gfortran.dg/der_io_4.f90
new file mode 100644
index 000000000..cfa1bca66
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/der_io_4.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR41859 ICE on invalid expression involving DT with pointer components in I/O.
+! The parens around p below are significant.
+  TYPE :: ptype
+    character, pointer, dimension(:) :: x => null()
+  END TYPE
+  TYPE(ptype) :: p
+  print *, ((((p))))       ! { dg-error "Data transfer element" }
+end
diff --git a/gcc/testsuite/gfortran.dg/der_pointer_1.f90 b/gcc/testsuite/gfortran.dg/der_pointer_1.f90
new file mode 100644
index 000000000..b9f98f518
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/der_pointer_1.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! PR13010
+! Arrays of self-referential pointers
+module test
+   type list_t
+      type(list_t), pointer :: next
+   end type list_t
+
+   type listptr_t
+      type(list_t), pointer :: this
+   end type listptr_t
+
+   type x_t
+      type(listptr_t), pointer :: arr(:)
+   end type x_t
+
+   type(x_t), pointer :: x
+end module test
+
+! { dg-final { cleanup-modules "test" } }
diff --git a/gcc/testsuite/gfortran.dg/der_pointer_2.f90 b/gcc/testsuite/gfortran.dg/der_pointer_2.f90
new file mode 100644
index 000000000..3749fc24f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/der_pointer_2.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! PR 15975, PR 16606
+! Pointers to derived types with initialized components
+!
+! Contributed by Erik Edelmann <erik.edelmann@iki.fi>
+!
+SUBROUTINE N
+  TYPE T
+    INTEGER :: I = 99
+  END TYPE T
+  TYPE(T), POINTER :: P
+  TYPE(T), TARGET  :: Q
+  P => Q
+  if (P%I.ne.99) call abort ()
+END SUBROUTINE N
+
+program test_pr15975
+  call n ()
+end program test_pr15975
+
diff --git a/gcc/testsuite/gfortran.dg/der_pointer_3.f90 b/gcc/testsuite/gfortran.dg/der_pointer_3.f90
new file mode 100644
index 000000000..ad9f7a7f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/der_pointer_3.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! PR 18568
+! Find pointer-to-array components
+module ints
+   type :: bar
+      integer, pointer :: th(:)
+   end type bar
+contains
+   function foo(b)
+      type(bar), intent(in) :: b
+      integer :: foo(size(b%th))
+      foo = 0
+   end function foo
+end module ints
+
+program size_test
+  use ints
+end program size_test
+
+! { dg-final { cleanup-modules "ints" } }
diff --git a/gcc/testsuite/gfortran.dg/der_pointer_4.f90 b/gcc/testsuite/gfortran.dg/der_pointer_4.f90
new file mode 100644
index 000000000..260afa493
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/der_pointer_4.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! PR 24426
+! Pointer-components of derived type with initialized components
+module crash
+  implicit none
+  type foo
+    integer :: i = 0
+    type (foo), pointer :: next
+  end type foo
+  type (foo), save :: bar
+end module crash
+
+! { dg-final { cleanup-modules "crash" } }
diff --git a/gcc/testsuite/gfortran.dg/der_ptr_component_1.f90 b/gcc/testsuite/gfortran.dg/der_ptr_component_1.f90
new file mode 100644
index 000000000..0f76cc158
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/der_ptr_component_1.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! PR 19929
+! Deallocation of pointer components of derived type arrays
+program der_ptr_component
+    type :: t
+        integer, pointer :: p
+    end type t
+    type(t) :: a(1)
+
+    allocate(a(1)%p)
+    deallocate(a(1)%p)
+
+end program der_ptr_component
diff --git a/gcc/testsuite/gfortran.dg/derived_array_intrinisics_1.f90 b/gcc/testsuite/gfortran.dg/derived_array_intrinisics_1.f90
new file mode 100644
index 000000000..274aada6a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_array_intrinisics_1.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+! Test the fix for PR45081 in which derived type array valued intrinsics failed
+! to simplify, which caused an ICE in trans-array.c
+!
+! Contributed by Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
+! 
+  module m
+    implicit none
+    integer :: i
+    type t
+      integer :: i
+    end type t
+    type(t), dimension(4), parameter :: t1  = [( t(i), i = 1, 4)]
+    type(t), dimension(4), parameter :: t2  = [( t(i), i = 8, 11)]
+    type(t), dimension(2,2), parameter :: a = reshape ( t1, [ 2, 2 ] )
+    type(t), dimension(2,2), parameter :: b = transpose (a)
+    type(t), dimension(4), parameter :: c = reshape ( b, [ 4 ] )
+    type(t), dimension(2), parameter :: d = pack ( c, [.false.,.true.,.false.,.true.])
+    type(t), dimension(4), parameter :: e = unpack (d, [.false.,.true.,.false.,.true.], t2)
+    type(t), dimension(4,2), parameter :: f = spread (e, 2, 2)
+    type(t), dimension(8), parameter :: g = reshape ( f, [ 8 ] )
+    integer, parameter :: total = sum(g%i)
+  end module m
+
+    use m
+    integer :: j
+    j = total
+  end
+! { dg-final { scan-tree-dump-times "j = 50" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/derived_comp_array_ref_1.f90 b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_1.f90
new file mode 100644
index 000000000..1a868f391
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_1.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+! Tests the fix for PR27411, in which the array reference on line
+! 18 caused an ICE because the derived type, rather than its integer
+! component, was appearing in the index expression.
+!
+! Contributed by Richard Maine  <1fhcwee02@sneakemail.com>
+!
+module gd_calc
+  type calc_signal_type
+    integer :: dummy
+    logical :: used
+    integer :: signal_number
+  end type
+contains
+  subroutine activate_gd_calcs (used, outputs)
+    logical, intent(inout) :: used(:)
+    type(calc_signal_type), pointer :: outputs(:)
+      outputs%used = used(outputs%signal_number)
+    return
+  end subroutine activate_gd_calcs
+end module gd_calc
+
+  use gd_calc
+  integer, parameter :: ndim = 4
+  integer :: i
+  logical :: used_(ndim)
+  type(calc_signal_type), pointer :: outputs_(:)
+  allocate (outputs_(ndim))
+  forall (i = 1:ndim) outputs_(i)%signal_number = ndim + 1 - i
+  used_ = (/.true., .false., .true., .true./)
+  call activate_gd_calcs (used_, outputs_)
+  if (any (outputs_(ndim:1:-1)%used .neqv. used_)) call abort ()
+end
+
+! { dg-final { cleanup-modules "gd_calc" } }
diff --git a/gcc/testsuite/gfortran.dg/derived_comp_array_ref_2.f90 b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_2.f90
new file mode 100644
index 000000000..0530b0e6e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_2.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! Tests the fix for PR31564, in which the actual argument to
+! the call for set_bound was simplified when it should not be.
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+!
+MODULE cdf_aux_mod

+  TYPE :: the_distribution

+    INTEGER :: parameters(2)

+  END TYPE the_distribution

+  TYPE (the_distribution), PARAMETER :: the_beta = the_distribution((/99,999/))
+CONTAINS

+  SUBROUTINE set_bound(arg_name, test)

+    INTEGER, INTENT (IN) :: arg_name, test
+    if (arg_name .ne. test) call abort ()

+  END SUBROUTINE set_bound

+END MODULE cdf_aux_mod
+

+MODULE cdf_beta_mod

+CONTAINS

+  SUBROUTINE cdf_beta(which, test)

+    USE cdf_aux_mod

+    INTEGER :: which, test

+    CALL set_bound(the_beta%parameters(which), test)

+  END SUBROUTINE cdf_beta

+END MODULE cdf_beta_mod
+

+  use cdf_beta_mod
+  call cdf_beta (1, 99)
+  call cdf_beta (2, 999)
+end
+! { dg-final { cleanup-modules "cdf_aux_mod cdf_beta_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/derived_comp_array_ref_3.f90 b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_3.f90
new file mode 100644
index 000000000..7a0b77ea8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_3.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! Tests the fix for PR33337, which was partly associated with
+! the problem in PR31564 and, in addition, the parentheses in
+! the initialization expression for the_chi_square.
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+!
+MODULE cdf_nc_chisq_mod
+  PUBLIC
+  TYPE :: one_parameter
+    INTEGER :: high_bound
+  END TYPE one_parameter
+  TYPE :: the_distribution
+    TYPE (one_parameter) :: parameters(1)
+  END TYPE the_distribution
+  TYPE (the_distribution), PARAMETER :: the_chi_square = &
+    the_distribution((/(one_parameter(99))/))
+CONTAINS
+  SUBROUTINE local_cum_nc_chisq()
+    integer :: df0
+    df0 = the_chi_square%parameters(1)%high_bound
+    print *, df0
+  END SUBROUTINE local_cum_nc_chisq
+END MODULE cdf_nc_chisq_mod
+
+  use cdf_nc_chisq_mod
+  call local_cum_nc_chisq
+end
+! { dg-final { cleanup-modules "cdf_nc_chisq_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/derived_comp_array_ref_4.f90 b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_4.f90
new file mode 100644
index 000000000..0c7853989
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_4.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! Tests the fix for PR33376, which was a regression caused by the
+! fix for PR31564.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+!
+module foo
+  implicit none
+  public chk
+
+  type mytype
+    character(len=4) :: str
+  end type mytype
+  type (mytype) ,parameter :: chk (2) &
+                      = (/ mytype ("abcd") , mytype ("efgh") /)
+end module foo
+
+module gfcbug70
+  use foo, only: chk_ => chk
+  implicit none
+contains
+
+  subroutine chk (i)
+    integer, intent(in) :: i
+    if (i .eq. 1) then
+      if (chk_(i)% str .ne. "abcd") call abort ()
+    else
+      if (chk_(i)% str .ne. "efgh") call abort ()
+    end if
+
+  end subroutine chk
+end module gfcbug70
+
+  use gfcbug70
+  call chk (2)
+  call chk (1)
+end
+! { dg-final { cleanup-modules "foo gfcbug70" } }
diff --git a/gcc/testsuite/gfortran.dg/derived_comp_array_ref_5.f90 b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_5.f90
new file mode 100644
index 000000000..3b0c27944
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_5.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! Tests the fix for PR33566, in which the first variable array ref
+! to v1 would cause an incompatible ranks error and the second an ICE.
+!
+! Contributed by Mikael Morin <mikael.morin@tele2.fr>
+!
+      program test_vec
+
+      implicit none
+
+
+      integer :: i
+      real    :: x
+
+      type vec3
+        real, dimension(3) :: coords
+      end type vec3
+
+      type(vec3),parameter :: v1 = vec3((/ 1.0, 2.0, 3.0 /))
+      type(vec3)           :: v2
+
+      v2 = vec3((/ 1.0, 2.0, 3.0 /))
+
+
+      x = v1%coords(1)
+
+      do i=1,3
+        x = v1%coords(i)  ! used to fail
+        x = v2%coords(i)
+      end do
+
+      i = 2
+
+      v2 = vec3 (v1%coords ((/i+1, i, i-1/))) ! also broken
+
+      end program test_vec
diff --git a/gcc/testsuite/gfortran.dg/derived_comp_array_ref_6.f90 b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_6.f90
new file mode 100644
index 000000000..36a30672e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_6.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! Check the fix for PR32129 in which the argument 'vec(vy(i, :))' was
+! incorrectly simplified, resulting in an ICE and a missed error.
+!
+! Reported by Tobias Burnus <burnus@gcc.gnu.org>
+!
+    MODULE cdf_aux_mod
+      TYPE :: the_distribution
+        INTEGER :: parameters(1)
+      END TYPE the_distribution
+      TYPE (the_distribution), PARAMETER :: the_beta = the_distribution((/0/))
+    CONTAINS
+      SUBROUTINE set_bound(arg_name)
+        INTEGER, INTENT (IN) :: arg_name
+      END SUBROUTINE set_bound
+    END MODULE cdf_aux_mod
+    MODULE cdf_beta_mod
+    CONTAINS
+      SUBROUTINE cdf_beta()
+        USE cdf_aux_mod
+        INTEGER :: which
+          which = 1
+          CALL set_bound(the_beta%parameters(1:which)) ! { dg-error "Rank mismatch" }
+      END SUBROUTINE cdf_beta
+    END MODULE cdf_beta_mod
+
+! { dg-final { cleanup-modules "cdf_aux_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/derived_comp_array_ref_7.f90 b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_7.f90
new file mode 100644
index 000000000..890056589
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_7.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! Check the fix for PR32129 #4 in which the argument 'vec(vy(i, :))' was
+! incorrectly simplified, resulting in an ICE.
+!
+! Reported by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!
+program testCode
+  implicit none
+  type vec
+    real, dimension(2) :: coords
+  end type
+  integer :: i
+  real, dimension(2,2), parameter :: vy = reshape ((/1,2,3,4/),(/2,2/))
+  i = 1
+  if (any (foo(vec(vy(i, :))) /= vy(i, :))) call abort ()
+
+contains
+
+  function foo (xin)
+    type(vec) :: xin
+    real, dimension (2) :: foo
+    intent(in)  xin
+    foo = xin%coords
+  end function
+end program
diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_char_1.f90 b/gcc/testsuite/gfortran.dg/derived_constructor_char_1.f90
new file mode 100644
index 000000000..20f3cf93e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_constructor_char_1.f90
@@ -0,0 +1,50 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/44857
+!
+!
+  Type :: t5
+    character (len=5) :: txt(4)
+  End Type t5
+
+  character (len=3), parameter :: str3(2) = [ "ABC", "ZYX" ]
+  character (len=5), parameter :: str5(2) = [ "AbCdE", "ZyXwV" ]
+  character (len=5), parameter :: str7(2) = [ "aBcDeFg", "zYxWvUt" ]
+
+  Type (t5) :: one   = t5((/ "12345", "67890" /))
+  Type (t5) :: two   = t5((/ "123", "678" /))
+  Type (t5) :: three = t5((/ "1234567", "abcdefg" /))
+  Type (t5) :: four  = t5(str3)
+  Type (t5) :: five  = t5(str5)
+  Type (t5) :: six  = t5(str7)
+  print '(2a)', one, two, three, four, five, six
+End
+
+subroutine wasICEing()
+  implicit none
+
+  Type :: Err_Text_Type
+    integer :: nlines
+    character (len=132), dimension(5) :: txt
+  End Type Err_Text_Type
+
+  Type (Err_Text_Type)  :: Mess_FindFMT =  &
+                                Err_Text_Type(0, (/" "," "," "," "," "/))
+end subroutine wasICEing
+
+subroutine anotherCheck()
+  Type :: t
+    character (len=3) :: txt(2)
+  End Type
+  Type (t) :: tt = t((/ character(len=5) :: "12345", "67890" /))
+  print *, tt
+end subroutine
+
+! { dg-final { scan-tree-dump-times "one = ..txt=..12345., .67890...;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "two = ..txt=..123  ., .678  ...;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "three = ..txt=..12345., .abcde...;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "four = ..txt=..ABC  ., .ZYX  ...;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "five = ..txt=..AbCdE., .ZyXwV...;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "six = ..txt=..aBcDe., .zYxWv...;" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_char_2.f90 b/gcc/testsuite/gfortran.dg/derived_constructor_char_2.f90
new file mode 100644
index 000000000..c812bceeb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_constructor_char_2.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/44857
+!
+!
+
+  Type :: t
+    character (len=5) :: txt(2)
+  End Type
+  character (len=5) :: str(2) = [ "12345", "67890" ]
+  Type (t) :: tt = t( [str] ) ! { dg-error "does not reduce to a constant" }
+End
diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_char_3.f90 b/gcc/testsuite/gfortran.dg/derived_constructor_char_3.f90
new file mode 100644
index 000000000..e23878541
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_constructor_char_3.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+!
+! PR fortran/51966
+!
+! Contributed by Peter Wind
+!
+
+  type :: Deriv
+    character(len=10) :: name
+  end type
+  character(len=8), dimension(2), parameter :: &
+       DEF_ECOSYSTEMS = (/ "Gridxxxx", "StringYY" /)
+
+  type(Deriv), save :: DepEcoSystem = Deriv(DEF_ECOSYSTEMS(1))
+
+  if (DepEcoSystem%name /= "Gridxxxx" &
+      .or. DepEcoSystem%name(9:9) /= ' ' &
+      .or. DepEcoSystem%name(10:10) /= ' ') call abort()
+  DepEcoSystem%name = 'ABCDEFGHIJ'
+  call Init_EcoSystems()
+  if (DepEcoSystem%name /= "StringYY" &
+      .or. DepEcoSystem%name(9:9) /= ' ' &
+      .or. DepEcoSystem%name(10:10) /= ' ') call abort()
+
+contains
+  subroutine Init_EcoSystems()
+    integer :: i =2
+    DepEcoSystem = Deriv(DEF_ECOSYSTEMS(i))
+  end subroutine Init_EcoSystems
+end
diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_comps_1.f90 b/gcc/testsuite/gfortran.dg/derived_constructor_comps_1.f90
new file mode 100644
index 000000000..83d127931
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_constructor_comps_1.f90
@@ -0,0 +1,57 @@
+! { dg-do run }
+!
+! Tests fix for PR28425 in which anything other than a constructor would
+! not work for derived type components in a structure constructor.
+!
+! Original version sent by Vivek Rao on 18 Jan 06
+! Modified by Steve Kargl to remove IO
+!
+module foo_mod
+
+  implicit none
+
+  type :: date_m
+     integer :: month
+  end type date_m
+
+  type :: file_info
+     type(date_m) :: date
+  end type file_info
+
+end module foo_mod
+
+program prog
+
+  use foo_mod
+
+  implicit none
+  type(date_m)  :: dat
+  type(file_info) :: xx
+
+  type(date_m), parameter :: christmas = date_m (12)
+
+  dat = date_m(1)
+
+  xx = file_info(date_m(-1))  ! This always worked - a constructor
+  if (xx%date%month /= -1) call abort
+
+  xx = file_info(dat)         ! This was the original PR - a variable
+  if (xx%date%month /= 1) call abort
+
+  xx = file_info(foo(2))      ! ...functions were also broken
+  if (xx%date%month /= 2) call abort
+
+  xx = file_info(christmas)   ! ...and parameters
+  if (xx%date%month /= 12) call abort
+
+
+contains
+
+  function foo (i) result (ans)
+     integer :: i
+     type(date_m) :: ans
+     ans = date_m(i)
+  end function foo
+
+end program prog
+! { dg-final { cleanup-modules "foo_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_comps_2.f90 b/gcc/testsuite/gfortran.dg/derived_constructor_comps_2.f90
new file mode 100644
index 000000000..ef3005da2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_constructor_comps_2.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! Tests fix for PR29115, in which an ICE would be produced by 
+! non-pointer elements being supplied to the pointer components
+! in a derived type constructor.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+  type :: homer
+    integer, pointer :: bart(:)
+  end type homer
+  type(homer) :: marge
+  integer :: duff_beer
+  marge = homer (duff_beer) ! { dg-error "should be a POINTER or a TARGET" }
+end
+
+!
+! The following yield an ICE, see PR 34083
+!
+subroutine foo
+  type ByteType
+    character(len=1) :: singleByte
+  end type
+  type (ByteType) :: bytes(4)
+
+  print *, size(bytes)
+  bytes = ByteType((/'H', 'i', '!', ' '/)) ! { dg-error "rank of the element in the derived type constructor" }
+end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_comps_3.f90 b/gcc/testsuite/gfortran.dg/derived_constructor_comps_3.f90
new file mode 100644
index 000000000..0aa2e4e1c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_constructor_comps_3.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! 
+! gfortran was ICEing for the constructor of
+! componentfree types.
+!
+! Contributed by James Van Buskirk
+! http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/c8dd08d6da052499/
+!
+ module bug4_mod
+   implicit none
+   type bug4 ! no components
+   end type bug4
+end module bug4_mod
+
+program bug4_structure
+   use bug4_mod
+   implicit none
+   type(bug4) t
+   t = bug4()
+   write(*,*) t
+end program bug4_structure
+! { dg-final { cleanup-modules "bug4_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_comps_4.f90 b/gcc/testsuite/gfortran.dg/derived_constructor_comps_4.f90
new file mode 100644
index 000000000..e70551838
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_constructor_comps_4.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+!
+! PR 47789: [F03] Structure constructor of type extending DT with no components
+!
+! Contributed by eddyg_61-bugzilla@yahoo.it
+
+type:: one
+end type
+
+type, extends(one) :: two
+  integer :: a
+end type
+
+type(two) :: wo = two(6)
+
+if (wo%a /= 6) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/derived_function_interface_1.f90 b/gcc/testsuite/gfortran.dg/derived_function_interface_1.f90
new file mode 100644
index 000000000..b7ee4df89
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_function_interface_1.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! Tests the fix for PR29634, in which an ICE would occur in the
+! interface declaration of a function with an 'old-style' type
+! declaration.  When fixed, it was found that the error message
+! was not very helpful - this was fixed.
+!
+! Contributed by Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+!
+module kinds
+  type foo
+    integer :: i
+  end type foo
+end module
+
+type(foo) function ext_fun()
+  use kinds
+  ext_fun%i = 1
+end function ext_fun
+
+  use kinds
+
+  interface fun_interface
+    type(foo) function fun()
+      use kinds
+    end function fun
+  end interface
+
+  interface ext_fun_interface
+    type(foo) function ext_fun()
+      use kinds
+    end function ext_fun
+  end interface
+
+  type(foo) :: x
+
+  x = ext_fun ()
+  print *, x%i
+
+contains
+
+  type(foo) function fun() ! { dg-error "already has an explicit interface" }
+  end function fun  ! { dg-error "Expecting END PROGRAM" }
+
+end
+! { dg-final { cleanup-modules "kinds" } }
diff --git a/gcc/testsuite/gfortran.dg/derived_init_1.f90 b/gcc/testsuite/gfortran.dg/derived_init_1.f90
new file mode 100644
index 000000000..bdd7d3773
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_init_1.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! Check that allocatable/pointer variables of derived types with initialized
+! components are are initialized when allocated
+! PR 21625
+program test
+
+    implicit none
+    type :: t
+        integer :: a = 3
+    end type t
+    type :: s
+        type(t), pointer :: p(:)
+        type(t), pointer :: p2
+    end type s
+    type(t), pointer :: p
+    type(t), allocatable :: q(:,:)
+    type(s) :: z
+    type(s) :: x(2)
+
+    allocate(p, q(2,2))
+    if (p%a /= 3) call abort()
+    if (any(q(:,:)%a /= 3)) call abort()
+
+    allocate(z%p2, z%p(2:3))
+    if (z%p2%a /= 3) call abort()
+    if (any(z%p(:)%a /= 3)) call abort()
+
+    allocate(x(1)%p2, x(1)%p(2))
+    if (x(1)%p2%a /= 3) call abort()
+    if (any(x(1)%p(:)%a /= 3)) call abort()
+end program test
+
diff --git a/gcc/testsuite/gfortran.dg/derived_init_2.f90 b/gcc/testsuite/gfortran.dg/derived_init_2.f90
new file mode 100644
index 000000000..18d7544ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_init_2.f90
@@ -0,0 +1,48 @@
+! { dg-do run }

+! PR 25217: INTENT(OUT) dummies of derived type with default initializers shall

+! be (re)initialized upon procedure entry, unless they are ALLOCATABLE.
+! Modified to take account of the regression, identified by Martin Tees
+! http://gcc.gnu.org/ml/fortran/2006-08/msg00276.html and fixed with
+! PR 28788.

+module dt
+    type :: drv

+        integer :: a(3) = [ 1, 2, 3 ]

+        character(3) :: s = "abc"

+        real, pointer :: p => null()

+    end type drv

+end module dt
+
+module subs
+contains
+    subroutine foo(fb)
+        use dt

+        type(drv), intent(out) :: fb
+        call sub (fb)
+    end subroutine foo
+

+    subroutine sub(fa)
+        use dt

+        type(drv), intent(out) :: fa

+

+        if (any(fa%a /= [ 1, 2, 3 ])) call abort()

+        if (fa%s /= "abc") call abort()

+        if (associated(fa%p)) call abort()

+    end subroutine sub
+end module subs
+
+program main

+    use dt
+    use subs

+    implicit none

+    type(drv) :: aa

+    type(drv), allocatable :: ab(:)

+    real, target :: x = 99, y = 999

+

+    aa = drv ([ 4, 5, 6], "def", x)

+    call sub(aa)

+

+    aa = drv ([ 7, 8, 9], "ghi", y)

+    call foo(aa)

+end program main

+

+! { dg-final { cleanup-modules "dt subs" } }
diff --git a/gcc/testsuite/gfortran.dg/derived_init_3.f90 b/gcc/testsuite/gfortran.dg/derived_init_3.f90
new file mode 100644
index 000000000..a1c4a0c7e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_init_3.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+!
+! PR fortran/40851
+!
+! Make sure the an INTENT(OUT) dummy is not initialized
+! when it is a pointer.
+!
+! Contributed by Juergen Reuter <juergen.reuter@desy.de>.
+!
+program main
+
+  type :: string
+     character,dimension(:),allocatable :: chars
+  end type string
+
+  type :: string_container
+     type(string) :: string
+  end type string_container
+
+  type(string_container), target :: tgt
+  type(string_container), pointer :: ptr
+
+  ptr => tgt
+  call set_ptr (ptr)
+  if (associated(ptr)) call abort()
+
+contains
+
+  subroutine set_ptr (ptr)
+    type(string_container), pointer, intent(out) :: ptr
+    ptr => null ()
+  end subroutine set_ptr
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/derived_name_1.f90 b/gcc/testsuite/gfortran.dg/derived_name_1.f90
new file mode 100644
index 000000000..9c6b1775d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_name_1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! PR 20897
+! Make sure intrinsic type names do not appear as names of derived types
+type integer ! { dg-error "cannot be the same as an intrinsic type" }
+type real    ! { dg-error "cannot be the same as an intrinsic type" }
+type complex ! { dg-error "cannot be the same as an intrinsic type" }
+type character ! { dg-error "cannot be the same as an intrinsic type" }
+type logical ! { dg-error "cannot be the same as an intrinsic type" }
+type complex ! { dg-error "cannot be the same as an intrinsic type" }
+type double precision ! { dg-error "Unclassifiable statement" }
+type doubleprecision ! { dg-error "cannot be the same as an intrinsic type" }
+type double complex ! { dg-error "Unclassifiable statement" }
+type doublecomplex ! { dg-error "cannot be the same as an intrinsic type" }
+
+type x
+   integer y
+end type x
+end
+
diff --git a/gcc/testsuite/gfortran.dg/derived_name_2.f b/gcc/testsuite/gfortran.dg/derived_name_2.f
new file mode 100644
index 000000000..a89dcdfbd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_name_2.f
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! PR 20897
+! Make sure intrinsic type names do not appear as names of derived types
+      type integer     ! { dg-error "cannot be the same as an intrinsic type" }
+      type real        ! { dg-error "cannot be the same as an intrinsic type" }
+      type complex     ! { dg-error "cannot be the same as an intrinsic type" }
+      type character   ! { dg-error "cannot be the same as an intrinsic type" }
+      type logical     ! { dg-error "cannot be the same as an intrinsic type" }
+      type complex     ! { dg-error "cannot be the same as an intrinsic type" }
+      type double precision     ! { dg-error "cannot be the same as an intrinsic type" }
+      type doubleprecision      ! { dg-error "cannot be the same as an intrinsic type" }
+      type double complex       ! { dg-error "cannot be the same as an intrinsic type" }
+      type doublecomplex        ! { dg-error "cannot be the same as an intrinsic type" }
+
+      type x
+      integer y
+      end type x
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/derived_pointer_null_1.f90 b/gcc/testsuite/gfortran.dg/derived_pointer_null_1.f90
new file mode 100644
index 000000000..3e7673f3b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_pointer_null_1.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! { dg-options "-std=gnu" }
+!
+! Test of fix (patch unknown) for pr19181 and pr21300. This test is based
+! on the example given in 21300.  Note that this can be executed.
+!
+! Contributed by Paul Thomas  <pault@gnu.org>
+!
+  TYPE ast_obs
+    real, DIMENSION(:), POINTER :: geopos
+  END TYPE ast_obs
+
+  TYPE(ast_obs), PARAMETER    :: undefined_ast_obs = AST_OBS(NULL())
+  type(ast_obs)               :: my_ast_obs
+  real, target, dimension(10) :: rt
+
+  my_ast_obs%geopos => rt
+  if (.not.associated (my_ast_obs%geopos)) call abort ()
+
+  call get_null_ast_obs (my_ast_obs)
+  if (associated (my_ast_obs%geopos)) call abort ()
+
+CONTAINS
+
+  SUBROUTINE get_null_ast_obs (obs1)
+    TYPE(ast_obs)  :: obs1
+    obs1 = undefined_ast_obs
+    RETURN
+  END SUBROUTINE get_null_ast_obs
+
+END
+
diff --git a/gcc/testsuite/gfortran.dg/derived_pointer_recursion.f90 b/gcc/testsuite/gfortran.dg/derived_pointer_recursion.f90
new file mode 100644
index 000000000..4af2ceefe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_pointer_recursion.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-O0" }
+!  Tests patch for PR24092 - This would ICE because of the loop in the
+!  derived type definitions.
+!
+   module llo
+      type :: it
+         character*10  :: k
+         integer :: c(2)
+      end type it
+      type :: bt
+         type (nt), pointer :: p
+      end type bt
+      type :: nt
+         type (it) :: i
+         type (bt) :: b
+      end type nt
+      type (bt), pointer :: ptr
+   end module llo
+!  copyright 1996 Loren P. Meissner -- May be distributed if this line is included.
+!  Linked List operations with Pointer to Pointer
+
+! { dg-final { cleanup-modules "llo" } }
diff --git a/gcc/testsuite/gfortran.dg/derived_pointer_recursion_2.f90 b/gcc/testsuite/gfortran.dg/derived_pointer_recursion_2.f90
new file mode 100644
index 000000000..f6bda4d05
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_pointer_recursion_2.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+!
+! PR 40594: [4.5 Regression] wrong-code
+!
+! Original test case by Daniel Franke <dfranke@gcc.gnu.org>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+MODULE atom_types
+
+TYPE :: atom_list
+  TYPE(atom_private), DIMENSION(:), pointer :: table
+END TYPE
+
+TYPE :: atom_private
+  TYPE(atom_list) :: neighbours
+  LOGICAL         :: initialized = .true.
+END TYPE
+
+TYPE :: atom_model
+  TYPE(atom_list) :: atoms
+  integer         :: dummy
+END TYPE
+
+contains
+
+  SUBROUTINE init(this)
+    TYPE(atom_private) :: this
+    this%initialized = .FALSE.
+  END SUBROUTINE
+
+END MODULE
+
+
+program pr40594
+
+  USE atom_types
+  TYPE(atom_model) :: am
+  type(atom_private) :: ap
+
+  am%dummy = 0
+
+  call init(ap)
+  if (ap%initialized .neqv. .false.) call abort()
+
+END
+
+! { dg-final { cleanup-modules "atom_types" } }
+
diff --git a/gcc/testsuite/gfortran.dg/derived_recursion.f90 b/gcc/testsuite/gfortran.dg/derived_recursion.f90
new file mode 100644
index 000000000..d0c0ea8d4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_recursion.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-O0" }
+! Tests patch for PR24158 - The module would compile, in spite
+! of the recursion between the derived types. This would cause
+! an ICE in the commented out main program. The standard demands
+! that derived type components be already defined, to break
+! recursive derived type definitions.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+module snafu
+  type       ::   a
+    integer    :: v
+    type(b)    :: i ! { dg-error "not been previously defined" }
+  end type a
+  type       ::   b
+    type(a)    :: i
+  end type b
+  type (a)   :: foo
+end module snafu
+
+!  use snafu
+!  foo%v = 1
+!  end
+
+! { dg-final { cleanup-modules "snafu" } }
diff --git a/gcc/testsuite/gfortran.dg/derived_sub.f90 b/gcc/testsuite/gfortran.dg/derived_sub.f90
new file mode 100644
index 000000000..9b6624579
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_sub.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! PR35475  gfortran fails to compile valid code with ICE error in fold-const.c
+! Test case from PR report added to avoid future regression
+module modone
+  type mytype
+    real :: myvar
+  end type
+end module
+
+module modtwo
+  interface
+    subroutine subone(mytype_cur)
+      use modone
+      type (mytype) mytype_cur
+    end subroutine
+  end interface
+
+contains
+
+  subroutine subtwo(mytype_cur)
+    use modone
+    type (mytype) mytype_cur,mytype_fin
+    mytype_fin=mytype_cur
+    return
+  end subroutine
+
+  subroutine subthree(mytype_cur)
+    use modone
+    type (mytype) mytype_cur
+    call subone(mytype_cur)
+  end subroutine 
+
+end module
+! { dg-final { cleanup-modules "modone modtwo" } }
diff --git a/gcc/testsuite/gfortran.dg/dev_null.F90 b/gcc/testsuite/gfortran.dg/dev_null.F90
new file mode 100644
index 000000000..b8ba57485
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dev_null.F90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! pr19478 read from /dev/null
+! Thomas.Koenig@online.de
+#if defined  _WIN32
+#define DEV_NULL "nul"
+#else
+#define DEV_NULL "/dev/null"
+#endif
+      character*20 foo
+      open(10,file=DEV_NULL)
+      write(10,'(A)') "Hello"
+      rewind(10)
+      read(10,'(A)',end=100) foo
+      call abort
+ 100  continue
+      end
diff --git a/gcc/testsuite/gfortran.dg/dfloat_1.f90 b/gcc/testsuite/gfortran.dg/dfloat_1.f90
new file mode 100644
index 000000000..6971c6a13
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dfloat_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! Progam to test the dfloat intrinsic.
+program dfloat_1
+   implicit none
+   integer(2) i2
+   integer(4) i4
+   integer(8) i8
+   i2 = -4_2
+   i4 = 4_4
+   i8 = 10_8
+   if (dfloat(i2) /= -4.d0) call abort()       ! { dg-warning "non-default INTEGER" }
+   if (dfloat(i4) /= 4.d0) call abort()
+   if (dfloat(i8) /= 10.d0) call abort()       ! { dg-warning "non-default INTEGER" }
+   if (dfloat(i4*i2) /= -16.d0) call abort()
+
+   if (kind(dfloat(i4)) /= kind(1.0_8)) call abort
+   if (kind(dfloat(i8)) /= kind(1.0_8)) call abort   ! { dg-warning "non-default INTEGER" }
+end program dfloat_1
diff --git a/gcc/testsuite/gfortran.dg/dg.exp b/gcc/testsuite/gfortran.dg/dg.exp
new file mode 100644
index 000000000..ea0428315
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dg.exp
@@ -0,0 +1,40 @@
+#   Copyright (C) 2004, 2007, 2008 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# GCC testsuite that uses the `dg.exp' driver.
+
+# Load support procs.
+load_lib gfortran-dg.exp
+
+# If a testcase doesn't have special options, use these.
+global DEFAULT_FFLAGS
+if ![info exists DEFAULT_FFLAGS] then {
+    set DEFAULT_FFLAGS " -pedantic-errors"
+}
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+gfortran-dg-runtest [lsort \
+       [glob -nocomplain $srcdir/$subdir/*.\[fF\]{,90,95,03,08} ] ] $DEFAULT_FFLAGS
+
+gfortran-dg-runtest [lsort \
+       [glob -nocomplain $srcdir/$subdir/g77/*.\[fF\] ] ] $DEFAULT_FFLAGS
+
+
+# All done.
+dg-finish
diff --git a/gcc/testsuite/gfortran.dg/dim_range_1.f90 b/gcc/testsuite/gfortran.dg/dim_range_1.f90
new file mode 100644
index 000000000..59f3f4311
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dim_range_1.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! PR 44693 - check for invalid dim even in functions.
+! Based on a test case by Dominique d'Humieres.
+subroutine test1(esss,Ix,Iyz, n)
+  real(kind=kind(1.0d0)), dimension(n), intent(out) :: esss
+  real(kind=kind(1.0d0)), dimension(n,n,n) :: sp
+  real(kind=kind(1.0d0)), dimension(n,n) :: Ix,Iyz
+  esss = sum(Ix * Iyz, 0) ! { dg-error "is not a valid dimension index" }
+  esss = sum(Ix * Iyz, 1)
+  esss = sum(Ix * Iyz, 2)
+  esss = sum(Ix * Iyz, 3) ! { dg-error "is not a valid dimension index" }
+  sp = spread (ix * iyz, 0, n) ! { dg-error "is not a valid dimension index" }
+  sp = spread (ix * iyz, 1, n)
+  sp = spread (ix * iyz, 2, n)
+  sp = spread (ix * iyz, 3, n)
+  sp = spread (ix * iyz, 4, n) ! { dg-error "is not a valid dimension index" }
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/direct_io_1.f90 b/gcc/testsuite/gfortran.dg/direct_io_1.f90
new file mode 100644
index 000000000..96ae49035
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/direct_io_1.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! PR 16908
+! Segfaulted on second set of writes.  We weren't handling partial records
+! properly when calculating the file position.
+program direct_io_1
+  implicit none
+
+  integer n, nt, mt, m
+  real dt, tm, w
+  real, allocatable :: p(:)
+
+  nt =  2049 ! if nt < 2049, then everything works.
+
+  allocate(p(nt))
+  p  = 0.e0
+
+  inquire(iolength=mt) (p(m), m=1, nt)
+
+  open(unit=12, file='syn.sax', access='direct', recl=mt)
+  n = 1
+  write(12, rec=n) mt, nt
+  write(12, rec=n+1) (p(m), m=1, nt)
+  close(12)
+
+  inquire(iolength=mt) (p(m), m=1, nt)
+
+  open(unit=12, file='syn.sax', access='direct', recl=mt)
+  n = 1
+  write(12, rec=n) mt, nt
+  write(12, rec=n+1) (p(m), m=1, nt)
+  close(12, status='delete')
+end program
diff --git a/gcc/testsuite/gfortran.dg/direct_io_10.f b/gcc/testsuite/gfortran.dg/direct_io_10.f
new file mode 100644
index 000000000..c47027208
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/direct_io_10.f
@@ -0,0 +1,46 @@
+! { dg-do run }
+! pr35699 run-time abort writing zero sized section to direct access file
+      program directio
+      call       qi0010 (  10,   1,   2,   3,   4,  9,   2)
+      end
+
+      subroutine qi0010 (nf10, nf1, nf2, nf3, nf4,nf9, np2)
+      character(10) bda(nf10)
+      character(10) bda1(nf10), bval
+
+      integer  j_len
+      bda1(1) = 'x'
+      do i = 2,10
+        bda1(i) = 'x'//bda1(i-1)
+      enddo
+      bda = 'unread'
+
+      inquire(iolength = j_len) bda1(nf1:nf10:nf2), bda1(nf4:nf3),
+     $                               bda1(nf2:nf10:nf2)
+
+      open (unit=48,
+     $      access='direct',
+     $      status='scratch',
+     $      recl = j_len,
+     $      iostat = istat,
+     $      form='unformatted',
+     $      action='readwrite')
+
+      write (48,iostat = istat, rec = 3) bda1(nf1:nf10:nf2),
+     $                    bda1(nf4:nf3), bda1(nf2:nf10:nf2)
+      if ( istat .ne. 0) then
+        call abort
+      endif
+      istat = -314
+
+      read (48,iostat = istat, rec = np2+1) bda(nf1:nf9:nf2),
+     $                       bda(nf4:nf3), bda(nf2:nf10:nf2)
+      if ( istat .ne. 0) then
+        call abort
+      endif
+
+      do j1 = 1,10
+        bval = bda1(j1)
+        if (bda(j1) .ne. bval) call abort
+      enddo
+      end subroutine
diff --git a/gcc/testsuite/gfortran.dg/direct_io_11.f90 b/gcc/testsuite/gfortran.dg/direct_io_11.f90
new file mode 100644
index 000000000..a2b8afc35
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/direct_io_11.f90
@@ -0,0 +1,55 @@
+! { dg-do run }
+! PR42090 Problems reading partial records in formatted direct access files
+! Test case from PR, prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+program da_good_now
+  implicit none
+  real :: a, b
+
+  a = 1.111111111
+  b = 2.222222222
+
+  open( 10, file = 't.dat', form = 'formatted', access = 'direct', recl = 12 )
+  write( 10, rec = 1, fmt = '( f6.4, /, f6.4 )' ) a, b
+  close( 10 )
+
+  a = -1.0
+  b = -1.0
+
+  open( 10, file = 't.dat', form = 'formatted', access = 'direct', recl = 12 )
+
+  read( 10, rec = 1, fmt = '( f6.4, /, f6.4 )' ) a, b
+  !write( *, '( "partial record 1", t25, 2( f6.4, 1x ) )' ) a, b
+  a = -1.0
+  b = -1.0
+
+  read( 10, rec = 1, fmt = '( f6.4 )' ) a, b
+  !write( *, '( "partial record 2", t25, 2( f6.4, 1x ) )' ) a, b
+  if (a /= 1.1111 .and. b /= 2.2222) call abort()
+  a = -1.0
+  b = -1.0
+
+  read( 10, rec = 1, fmt = '( f12.4, /, f12.4 )' ) a, b
+  !write( *, '( "full record 1", t25, 2( f6.4, 1x ) )' ) a, b
+  if (a /= 1.1111 .and. b /= 2.2222) call abort()
+  a = -1.0
+  b = -1.0
+
+  read( 10, rec = 1, fmt = '( f12.4 )' ) a, b
+  !write( *, '( "full record 2", t25, 2( f6.4, 1x ) )' ) a, b
+  if (a /= 1.1111 .and. b /= 2.2222) call abort()
+  a = -1.0
+  b = -1.0
+
+  read( 10, rec = 1, fmt = '( f6.4, 6x, /, f6.4, 6x )' ) a, b
+  !write( *, '( "full record with 6x", t25, 2( f6.4, 1x ) )' ) a, b
+  if (a /= 1.1111 .and. b /= 2.2222) call abort()
+  a = -1.0
+  b = -1.0
+
+  read( 10, rec = 1, fmt = '( f6.4 )' ) a
+  read( 10, rec = 2, fmt = '( f6.4 )' ) b
+  !write( *, '( "record at a time", t25, 2( f6.4, 1x ) )' ) a, b
+  if (a /= 1.1111 .and. b /= 2.2222) call abort()
+
+  close( 10, status="delete")
+end program da_good_now
diff --git a/gcc/testsuite/gfortran.dg/direct_io_12.f90 b/gcc/testsuite/gfortran.dg/direct_io_12.f90
new file mode 100644
index 000000000..533670272
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/direct_io_12.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! 
+! PR fortran/43551
+!
+! Writes a 672000 byte file with buffering. The writing failed because
+! of a missing lseek.
+
+implicit none
+integer, parameter :: size = 2800 ! << needs to be large enough
+real(8) :: vec1(size,30), dummy(size)
+integer i
+
+CALL RANDOM_NUMBER(vec1)
+
+open(99, file='test.dat', form='unformatted', access='direct', recl=size*8)
+do i = 1, 10
+  write(99,rec=i) vec1(:,i)
+  write(99,rec=i+10) vec1(:,i+10)
+  write(99,rec=i+20) vec1(:,i+20) ! << rec = 30 was written to rec = 21
+end do
+
+do i = 1, 10
+  read(99,rec=i) dummy
+  if (any (dummy /= vec1(:,i))) call abort()
+  read(99,rec=i+10) dummy
+  if (any (dummy /= vec1(:,i+10))) call abort()
+  read(99,rec=i+20) dummy
+  if (any (dummy /= vec1(:,i+20))) call abort() ! << aborted here for rec = 21
+end do
+
+close(99, status='delete')
+end
+
diff --git a/gcc/testsuite/gfortran.dg/direct_io_2.f90 b/gcc/testsuite/gfortran.dg/direct_io_2.f90
new file mode 100644
index 000000000..8e18052ff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/direct_io_2.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! this testcase derived from NIST test FM413.FOR
+! tests writing direct access files in ascending and descending
+! REC's.
+      PROGRAM FM413
+      IMPLICIT LOGICAL (L)
+      IMPLICIT CHARACTER*14 (C)
+      IMPLICIT INTEGER(4) (I)
+      DATA IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 /14*0/
+      OPEN (7, ACCESS = 'DIRECT', RECL = 80, STATUS='REPLACE', FILE="FOO" )
+      IRECN = 13
+      IREC = 13
+      DO 4132 I = 1,100
+      IREC = IREC + 2
+      IRECN = IRECN + 2
+      WRITE(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
+ 4132 CONTINUE
+      IRECN = 216
+      IREC = 216
+      DO 4133 I=1,100
+      IREC = IREC - 2
+      IRECN = IRECN - 2
+      WRITE(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
+ 4133 CONTINUE
+      IRECCK = 13
+      IRECN = 0
+      IREC = 13
+      IVCOMP = 0
+      DO 4134 I = 1,100
+      IREC = IREC + 2
+      IRECCK = IRECCK + 2
+      READ(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56
+      IF (IRECN .NE. IRECCK) CALL ABORT
+ 4134 CONTINUE
+      IRECCK = 216
+      IRECN = 0
+      IREC = 216
+      DO 4135 I = 1,100
+      IREC = IREC - 2
+      IRECCK = IRECCK - 2
+      READ(7, REC = IREC)  IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56
+      IF (IRECN .NE. IRECCK) CALL ABORT
+ 4135 CONTINUE
+      CLOSE(7, STATUS='DELETE')
+      STOP
+      END
diff --git a/gcc/testsuite/gfortran.dg/direct_io_3.f90 b/gcc/testsuite/gfortran.dg/direct_io_3.f90
new file mode 100644
index 000000000..03cbf39b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/direct_io_3.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! PR 18710 : We used to not read and write the imaginary part of 
+! complex numbers
+       COMPLEX C, D
+       COMPLEX(KIND=8) E, F
+
+       OPEN(UNIT=9,FILE='PR18710',ACCESS='DIRECT',RECL=132)
+
+       C = (120.0,240.0)
+       WRITE(9,REC=1)C
+       READ(9,REC=1)D
+       if (c /= d) call abort()
+
+       E = (120.0,240.0)
+       WRITE(9,REC=1)E
+       READ(9,REC=1)F
+       if (E /= F) call abort()
+
+       CLOSE(UNIT=9,STATUS='DELETE')
+       END
diff --git a/gcc/testsuite/gfortran.dg/direct_io_4.f90 b/gcc/testsuite/gfortran.dg/direct_io_4.f90
new file mode 100644
index 000000000..050796735
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/direct_io_4.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! PR 23321 : Running off the end of a file was not detected with direct I/O.
+program main
+  implicit none
+  integer(kind=1) :: a, b
+  integer :: ios, i
+
+  a = 42
+  open (unit=10,status="scratch",recl=1,access="direct")
+  write(10,rec=1) a
+
+  read (10,rec=2, iostat=ios) b
+  if (ios == 0) call abort
+
+  read (10, rec=82641, iostat=ios) b      ! This used to cause a segfault
+  if (ios == 0) call abort
+
+  read(10, rec=1, iostat=ios) b
+  if (ios /= 0) call abort 
+  if (a /= b) call abort
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/direct_io_5.f90 b/gcc/testsuite/gfortran.dg/direct_io_5.f90
new file mode 100644
index 000000000..621399844
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/direct_io_5.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! PR27757 Problems with direct access I/O
+! This test checks a series of random writes followed by random reads.
+! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+program testdirect
+  implicit none
+  integer, dimension(100) :: a
+  integer :: i,j,k,ier
+  real    :: x
+  data a / 13, 9, 34, 41, 25, 98, 6, 12, 11, 44, 79, 3,&
+  &    64, 61, 77, 57, 59, 2, 92, 38, 71, 64, 31, 60, 28, 90, 26,&
+  &    97, 47, 26, 48, 96, 95, 82, 100, 90, 45, 71, 71, 67, 72,&
+  &    76, 94, 49, 85, 45, 100, 22, 96, 48, 13, 23, 40, 14, 76, 99,&
+  &    96, 90, 65,  2, 8, 60, 96, 19, 45, 1, 100, 48, 91, 20, 92,&
+  &    72, 81, 59, 24, 37, 43, 21, 54, 68, 31, 19, 79, 63, 41,&
+  &    42, 12, 10, 62, 43, 9, 30, 9, 54, 35, 4, 5, 55, 3, 94 /
+
+  open(unit=15,file="testdirectio",access="direct",form="unformatted",recl=89)
+  do i=1,100
+    k = a(i)
+    write(unit=15, rec=k) k
+  enddo
+  do j=1,100
+    read(unit=15, rec=a(j), iostat=ier) k
+    if (ier.ne.0) then
+      call abort()
+    else
+      if (a(j) /= k) call abort()
+    endif
+  enddo
+  close(unit=15, status="delete")
+end program testdirect  
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/direct_io_6.f90 b/gcc/testsuite/gfortran.dg/direct_io_6.f90
new file mode 100644
index 000000000..d090704ed
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/direct_io_6.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! pr31366 last record truncated for read after short write, direct access file.
+! test case derived from pr, submitted by jerry delisle  <jvdelisle@gcc.gnu.org
+      program test
+      character(len=8) :: as_written, as_read
+      character(1) :: byte
+      as_written = "12345678"
+      open (76, access="direct", recl=12, status="scratch")
+      write(76, rec=1) as_written
+      write(76, rec=2) as_written
+      read(76, rec=1) as_read, byte, byte, byte, byte
+      read(76, rec=2, err=3) as_read, byte, byte, byte, byte
+      stop
+  3   call abort()
+      end program test
+
diff --git a/gcc/testsuite/gfortran.dg/direct_io_7.f90 b/gcc/testsuite/gfortran.dg/direct_io_7.f90
new file mode 100644
index 000000000..ff116b0a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/direct_io_7.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! PR 34405 - direct access prohibits ENDFILE, BACKSPACE and REWIND
+program test
+  implicit none
+  integer :: ios
+  character(len=80) :: msg
+  open (95, access="direct", recl=4, status="scratch")
+  write (95,rec=1) 'abcd'
+
+  ios = 0
+  msg = " "
+  backspace (95,iostat=ios,iomsg=msg)
+  if (ios == 0 .or. &
+       msg /= "Cannot BACKSPACE a file opened for DIRECT access") call abort
+
+  ios = 0
+  msg = " "
+  endfile (95,iostat=ios,iomsg=msg)
+  if (ios == 0 .or. &
+       msg /= "Cannot perform ENDFILE on a file opened for DIRECT access") &
+       call abort
+
+  ios = 0
+  msg = " "
+  rewind (95,iostat=ios,iomsg=msg)
+  if (ios == 0 .or. &
+       msg /= "Cannot REWIND a file opened for DIRECT access ") call abort
+
+  close (95)
+end program test
+
diff --git a/gcc/testsuite/gfortran.dg/direct_io_8.f90 b/gcc/testsuite/gfortran.dg/direct_io_8.f90
new file mode 100644
index 000000000..5e384a1cf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/direct_io_8.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! PR 34594 - this used to give runtime errors due to an
+! end condition.
+program main
+  implicit none
+  integer :: iou, i, ir, TEMP_CHANGES
+  i=44
+  ir = -42
+
+  open(11,file="foo.dat")
+  ! Try a direct access read on a formatted sequential rile
+  READ (11, REC = I, ERR = 99) TEMP_CHANGES
+  call abort
+99 continue
+  ! Variant 2: ir is ok, but does not jump to 99
+  READ (11, REC = I, IOSTAT = IR, ERR = 98) TEMP_CHANGES
+  call abort
+
+98 continue
+  if(ir == 0) then
+     call abort
+  end if
+  close(11,status="delete")
+end program main
+
diff --git a/gcc/testsuite/gfortran.dg/direct_io_9.f b/gcc/testsuite/gfortran.dg/direct_io_9.f
new file mode 100644
index 000000000..bdb40453a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/direct_io_9.f
@@ -0,0 +1,39 @@
+! { dg-do run }
+! PR34876 can't read/write zero length array sections
+! Test case from PR by Dick Hendrikson
+      program qi0011
+      character(9) bda(10)
+      character(9) bda1(10)
+      integer  j_len
+      istat = -314
+
+      inquire(iolength = j_len) bda1
+
+      istat = -314
+      open (unit=48,
+     $      status='scratch',
+     $      access='direct',
+     $      recl = j_len,
+     $      iostat = istat,
+     $      form='unformatted',
+     $      action='readwrite')
+
+
+      if (istat /= 0) call abort
+
+      bda  = 'xxxxxxxxx'
+      bda1 = 'yyyyyyyyy'
+      write (48,iostat = istat, rec = 10) bda1(4:3)
+      if ( istat .ne. 0) then
+        call abort
+      endif
+
+      istat = -314
+      read (48,iostat = istat, rec=10) bda(4:3)
+      if ( istat .ne. 0) then
+        call abort
+      endif
+      if (any(bda1.ne.'yyyyyyyyy')) call abort
+      if (any(bda.ne.'xxxxxxxxx')) call abort
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/do_1.f90 b/gcc/testsuite/gfortran.dg/do_1.f90
new file mode 100644
index 000000000..171275af3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_1.f90
@@ -0,0 +1,80 @@
+! { dg-do run }
+! Program to check corner cases for DO statements.
+program do_1
+  implicit none
+  integer i, j
+
+  ! limit=HUGE(i), step 1
+  j = 0
+  do i = HUGE(i) - 10, HUGE(i), 1
+    j = j + 1
+  end do
+  if (j .ne. 11) call abort
+  ! limit=HUGE(i), step > 1
+  j = 0
+  do i = HUGE(i) - 10, HUGE(i), 2
+    j = j + 1
+  end do
+  if (j .ne. 6) call abort
+  j = 0
+  do i = HUGE(i) - 9, HUGE(i), 2
+    j = j + 1
+  end do
+  if (j .ne. 5) call abort
+
+  ! Same again, but unknown loop step
+  if (test1(10, 1) .ne. 11) call abort
+  if (test1(10, 2) .ne. 6) call abort
+  if (test1(9, 2) .ne. 5) call abort
+
+  ! Zero iterations
+  j = 0
+  do i = 1, 0, 1 ! { dg-warning "executed zero times" }
+    j = j + 1
+  end do
+  if (j .ne. 0) call abort
+  j = 0
+  do i = 1, 0, 2 ! { dg-warning "executed zero times" }
+    j = j + 1
+  end do
+  if (j .ne. 0) call abort
+  j = 0
+  do i = 1, 2, -1 ! { dg-warning "executed zero times" }
+    j = j + 1
+  end do
+  if (j .ne. 0) call abort
+  call test2 (0, 1)
+  call test2 (0, 2)
+  call test2 (2, -1)
+  call test2 (2, -2)
+
+  ! Bound near smallest value
+  j = 0;
+  do i = -HUGE(i), -HUGE(i), 10
+    j = j + 1
+  end do
+  if (j .ne. 1) call abort
+contains
+! Returns the number of iterations performed.
+function test1(r, step)
+  implicit none
+  integer test1, r, step
+  integer k, n
+  k = 0
+  do n = HUGE(n) - r, HUGE(n), step
+    k = k + 1
+  end do
+  test1 = k
+end function
+
+subroutine test2 (lim, step)
+  implicit none
+  integer lim, step
+  integer k, n
+  k = 0
+  do n = 1, lim, step
+    k = k + 1
+  end do
+  if (k .ne. 0) call abort
+end subroutine
+end program
diff --git a/gcc/testsuite/gfortran.dg/do_2.f90 b/gcc/testsuite/gfortran.dg/do_2.f90
new file mode 100644
index 000000000..207b06a54
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_2.f90
@@ -0,0 +1,54 @@
+! { dg-do compile }
+! Check the fix for PR20839, which concerned non-compliance with one of the
+! constraints for block-do-constructs (8.1.4.1.1):
+! Constraint: If the do-stmt of a block-do-construct is identified by a 
+! do-construct-name, the corresponding end-do shall be an end-do-stmt
+! specifying the same do-construct-name. (Tests a & b)
+! If the do-stmt of a block-do-construct is not identified by a
+! do-construct-name, the corresponding end-do shall not specify a
+! do-construct-name. (Tests c & d)
+! Constraint: If the do-stmt is a nonlabel-do-stmt, the corresponding end-do
+! shall be an end-do-stmt.
+! Constraint: If the do-stmt is a label-do-stmt, the corresponding end-do shall
+! be identified with the same label.
+!
+! Test a - this was the PR
+  doi: DO 111 i=1,3 ! { dg-error "requires matching ENDDO name" }
+111 continue 
+! Test b
+  doii: DO 112 ij=1,3
+112 enddo doij      ! { dg-error "Expected label" }
+! Test c
+  DO 113 ik=1,3
+113 enddo doik      ! { dg-error "Syntax error" }
+! Test d
+  DO il=1,3
+  enddo doil        ! { dg-error "Syntax error" }
+! Test e
+  doj: DO 114 j=1,3
+  enddo doj         ! { dg-error "doesn't match DO label" }
+
+! Correct block do constructs
+dok: DO 115 k=1,3
+    dokk: do kk=1,3
+        dokkk: DO
+                   do kkkk=1,3
+                       do
+                       enddo
+                   enddo
+               enddo dokkk
+          enddo dokk
+115  enddo dok 
+! Correct non-block do constructs
+  do 117 l=1,3
+      do ll=1,3
+          do 116 lll=1,3
+116       continue
+      enddo
+117 enddo
+! These prevent an EOF error, arising from the previous errors.
+end do
+113 end do
+112 end do doii
+END
+
diff --git a/gcc/testsuite/gfortran.dg/do_3.F90 b/gcc/testsuite/gfortran.dg/do_3.F90
new file mode 100644
index 000000000..67723a508
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_3.F90
@@ -0,0 +1,113 @@
+! { dg-do run }
+! { dg-options "-std=legacy -ffree-line-length-none -fno-range-check -fwrapv" }
+program test
+  integer :: count
+  integer :: i
+  integer(kind=1) :: i1
+  real :: r
+
+#define TEST_LOOP(var,from,to,step,total,test,final) \
+  count = 0 ; do var = from, to, step ; count = count + 1 ; end do ; \
+  if (count /= total) call abort ; \
+  if (test (from, to, step, final) /= total) call abort
+
+  ! Integer loops
+  TEST_LOOP(i, 0, 0, 1, 1, test_i, 1)
+  TEST_LOOP(i, 0, 0, 2, 1, test_i, 2)
+  TEST_LOOP(i, 0, 0, -1, 1, test_i, -1)
+  TEST_LOOP(i, 0, 0, -2, 1, test_i, -2)
+
+  TEST_LOOP(i, 0, 1, 1, 2, test_i, 2)
+  TEST_LOOP(i, 0, 1, 2, 1, test_i, 2)
+  TEST_LOOP(i, 0, 1, 3, 1, test_i, 3)
+  TEST_LOOP(i, 0, 1, huge(0), 1, test_i, huge(0))
+  TEST_LOOP(i, 0, 1, -1, 0, test_i, 0) ! { dg-warning "executed zero times" }
+  TEST_LOOP(i, 0, 1, -2, 0, test_i, 0) ! { dg-warning "executed zero times" }
+  TEST_LOOP(i, 0, 1, -3, 0, test_i, 0) ! { dg-warning "executed zero times" }
+  TEST_LOOP(i, 0, 1, -huge(0), 0, test_i, 0) ! { dg-warning "executed zero times" }
+  TEST_LOOP(i, 0, 1, -huge(0)-1, 0, test_i, 0) ! { dg-warning "executed zero times" }
+
+  TEST_LOOP(i, 1, 0, 1, 0, test_i, 1) ! { dg-warning "executed zero times" }
+  TEST_LOOP(i, 1, 0, 2, 0, test_i, 1) ! { dg-warning "executed zero times" }
+  TEST_LOOP(i, 1, 0, 3, 0, test_i, 1) ! { dg-warning "executed zero times" }
+  TEST_LOOP(i, 1, 0, huge(0), 0, test_i, 1) ! { dg-warning "executed zero times" }
+  TEST_LOOP(i, 1, 0, -1, 2, test_i, -1)
+  TEST_LOOP(i, 1, 0, -2, 1, test_i, -1)
+  TEST_LOOP(i, 1, 0, -3, 1, test_i, -2)
+  TEST_LOOP(i, 1, 0, -huge(0), 1, test_i, 1-huge(0))
+  TEST_LOOP(i, 1, 0, -huge(0)-1, 1, test_i, -huge(0))
+
+  TEST_LOOP(i, 0, 17, 1, 18, test_i, 18)
+  TEST_LOOP(i, 0, 17, 2, 9, test_i, 18)
+  TEST_LOOP(i, 0, 17, 3, 6, test_i, 18)
+  TEST_LOOP(i, 0, 17, 4, 5, test_i, 20)
+  TEST_LOOP(i, 0, 17, 5, 4, test_i, 20)
+  TEST_LOOP(i, 17, 0, -1, 18, test_i, -1)
+  TEST_LOOP(i, 17, 0, -2, 9, test_i, -1)
+  TEST_LOOP(i, 17, 0, -3, 6, test_i, -1)
+  TEST_LOOP(i, 17, 0, -4, 5, test_i, -3)
+  TEST_LOOP(i, 17, 0, -5, 4, test_i, -3)
+
+  TEST_LOOP(i1, -huge(i1)-1_1, huge(i1), 1_1, int(huge(i1))*2+2, test_i1, huge(i1)+1_1)
+  TEST_LOOP(i1, -huge(i1)-1_1, huge(i1), 2_1, int(huge(i1))+1, test_i1, huge(i1)+1_1)
+  TEST_LOOP(i1, -huge(i1)-1_1, huge(i1), huge(i1), 3, test_i1, 2_1*huge(i1)-1_1)
+
+  TEST_LOOP(i1, huge(i1), -huge(i1)-1_1, -1_1, int(huge(i1))*2+2, test_i1, -huge(i1)-2_1)
+  TEST_LOOP(i1, huge(i1), -huge(i1)-1_1, -2_1, int(huge(i1))+1, test_i1, -huge(i1)-2_1)
+  TEST_LOOP(i1, huge(i1), -huge(i1)-1_1, -huge(i1), 3, test_i1, -2_1*huge(i1))
+  TEST_LOOP(i1, huge(i1), -huge(i1)-1_1, -huge(i1)-1_1, 2, test_i1, -huge(i1)-2_1)
+
+  TEST_LOOP(i1, -2_1, 3_1, huge(i1), 1, test_i1, huge(i1)-2_1)
+  TEST_LOOP(i1, -2_1, 3_1, -huge(i1), 0, test_i1, -2_1) ! { dg-warning "executed zero times" }
+  TEST_LOOP(i1, 2_1, -3_1, -huge(i1), 1, test_i1, 2_1-huge(i1))
+  TEST_LOOP(i1, 2_1, -3_1, huge(i1), 0, test_i1, 2_1) ! { dg-warning "executed zero times" }
+
+  ! Real loops
+  TEST_LOOP(r, 0.0, 1.0, 0.11, 1 + int(1.0/0.11), test_r, 0.0)
+  TEST_LOOP(r, 0.0, 1.0, -0.11, 0, test_r, 0.0) ! { dg-warning "executed zero times" }
+  TEST_LOOP(r, 0.0, -1.0, 0.11, 0, test_r, 0.0) ! { dg-warning "executed zero times" }
+  TEST_LOOP(r, 0.0, -1.0, -0.11, 1 + int(1.0/0.11), test_r, 0.0)
+  TEST_LOOP(r, 0.0, 0.0, 0.11, 1, test_r, 0.0)
+  TEST_LOOP(r, 0.0, 0.0, -0.11, 1, test_r, 0.0)
+
+#undef TEST_LOOP
+
+contains
+
+  function test_i1 (from, to, step, final) result(res)
+    integer(kind=1), intent(in) :: from, to, step, final
+    integer(kind=1) :: i
+    integer :: res
+
+    res = 0
+    do i = from, to, step
+      res = res + 1
+    end do
+    if (i /= final) call abort
+  end function test_i1
+
+  function test_i (from, to, step, final) result(res)
+    integer, intent(in) :: from, to, step, final
+    integer :: i
+    integer :: res
+
+    res = 0
+    do i = from, to, step
+      res = res + 1
+    end do
+    if (i /= final) call abort
+  end function test_i
+
+  function test_r (from, to, step, final) result(res)
+    real, intent(in) :: from, to, step, final
+    real :: i
+    integer :: res
+
+    res = 0
+    do i = from, to, step
+      res = res + 1
+    end do
+    ! final is ignored
+  end function test_r
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/do_4.f b/gcc/testsuite/gfortran.dg/do_4.f
new file mode 100644
index 000000000..6d688a0a3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_4.f
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! Verify that the loop not terminated on an action-stmt is correctly rejected
+       do10i=1,20
+       if(i.eq.5)then
+          goto 10
+ 10    endif           ! { dg-error "is within another block" }
+       end
+! { dg-excess-errors "" }
+
diff --git a/gcc/testsuite/gfortran.dg/do_check_1.f90 b/gcc/testsuite/gfortran.dg/do_check_1.f90
new file mode 100644
index 000000000..94d8a8488
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_check_1.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fcheck=do" }
+! { dg-shouldfail "DO check" }
+!
+! PR fortran/34656
+! Run-time check for zero STEP
+!
+program test
+  implicit none
+  integer :: i,j
+  j = 0
+  do i = 1, 40, j
+    print *, i
+  end do
+end program test
+! { dg-output "Fortran runtime error: DO step value is zero" }
diff --git a/gcc/testsuite/gfortran.dg/do_check_2.f90 b/gcc/testsuite/gfortran.dg/do_check_2.f90
new file mode 100644
index 000000000..c40760d25
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_check_2.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-options "-fcheck=do" }
+! { dg-shouldfail "DO check" }
+!
+! PR fortran/34656
+! Run-time check for modifing loop variables
+!
+program test
+  implicit none
+  integer :: i,j
+  do i = 1, 10
+    call modLoopVar(i)
+  end do
+contains
+  subroutine modLoopVar(i)
+    integer :: i
+    i = i + 1
+  end subroutine modLoopVar
+end program test
+! { dg-output "Fortran runtime error: Loop variable has been modified" }
diff --git a/gcc/testsuite/gfortran.dg/do_check_3.f90 b/gcc/testsuite/gfortran.dg/do_check_3.f90
new file mode 100644
index 000000000..15086c20a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_check_3.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options "-fcheck=do" }
+! { dg-shouldfail "DO check" }
+!
+! PR fortran/34656
+! Run-time check for modifing loop variables
+!
+program test
+  implicit none
+  real :: i, j, k
+  j = 10.0
+  k = 1.0
+  do i = 1.0, j, k ! { dg-warning "must be integer" }
+    call modLoopVar(i)
+  end do
+contains
+  subroutine modLoopVar(x)
+    real :: x
+    x = x + 1
+  end subroutine modLoopVar
+end program test
+! { dg-output "Fortran runtime error: Loop variable has been modified" }
diff --git a/gcc/testsuite/gfortran.dg/do_check_4.f90 b/gcc/testsuite/gfortran.dg/do_check_4.f90
new file mode 100644
index 000000000..65bc92c7e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_check_4.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-fcheck=do" }
+! { dg-shouldfail "DO check" }
+!
+! PR fortran/34656
+! Run-time check for modifing loop variables
+!
+PROGRAM test
+  IMPLICIT NONE
+  INTEGER :: i
+  DO i=1,100
+    CALL do_something()
+  ENDDO
+CONTAINS
+ SUBROUTINE do_something()
+ IMPLICIT NONE
+   DO i=1,10
+   ENDDO
+ END SUBROUTINE do_something
+END PROGRAM test
+! { dg-output "Fortran runtime error: Loop variable has been modified" }
diff --git a/gcc/testsuite/gfortran.dg/do_check_5.f90 b/gcc/testsuite/gfortran.dg/do_check_5.f90
new file mode 100644
index 000000000..3df7b14f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_check_5.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! 
+! PR/fortran 38432
+! DO-loop compile-time checks
+!
+implicit none
+integer :: i
+real :: r
+do i = 1, 0 ! { dg-warning "executed zero times" }
+end do
+
+do i = 1, -1, 1 ! { dg-warning "executed zero times" }
+end do
+
+do i = 1, 2, -1 ! { dg-warning "executed zero times" }
+end do
+
+do i = 1, 2, 0 ! { dg-error "cannot be zero" }
+end do
+
+do r = 1, 0 ! { dg-warning "must be integer|executed zero times" }
+end do
+
+do r = 1, -1, 1 ! { dg-warning "must be integer|executed zero times" }
+end do
+
+do r = 1, 2, -1 ! { dg-warning "must be integer|executed zero times" }
+end do
+
+do r = 1, 2, 0
+end do
+! { dg-warning "must be integer" "loop var" { target *-*-* } 30 }
+! { dg-error "cannot be zero" "loop step" { target *-*-* } 30 }
+end
diff --git a/gcc/testsuite/gfortran.dg/do_iterator.f90 b/gcc/testsuite/gfortran.dg/do_iterator.f90
new file mode 100644
index 000000000..cb3e50d59
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_iterator.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! various checks which verify that we don't change do-iterators
+DO I=1,5       ! { dg-error "cannot be redefined" "changing do-iterator 1" }
+   I=1         ! { dg-error "cannot be redefined" "changing do-iterator 1" }
+END DO
+DO I=1,5       ! { dg-error "cannot be redefined" "changing do-iterator 2" }
+   READ(5,*) I ! { dg-error "cannot be redefined" "changing do-iterator 2" }
+END DO
+DO I=1,5       ! { dg-error "cannot be redefined" "changing do-iterator 3" }
+   READ(5,*,iostat=i) j ! { dg-error "cannot be redefined" "changing do-iterator 3" }
+ENDDO
+END
+! { dg-error "Invalid character" "character" { target *-*-* } 7 }
diff --git a/gcc/testsuite/gfortran.dg/do_iterator_2.f90 b/gcc/testsuite/gfortran.dg/do_iterator_2.f90
new file mode 100644
index 000000000..7422b9eb5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_iterator_2.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! Tests the fix for pr32613 - see:
+! http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/495c154ee188d7f1/ea292134fe68b1d0#ea292134fe68b1d0
+!
+! Contributed by Al Greynolds <awgreynolds@earthlink.net>
+!
+program main
+  call something
+end
+
+subroutine something
+!  integer i !correct results from gfortran depend on this statement (before fix)
+  integer :: m = 0
+  character lit*1, line*100
+  lit(i) = line(i:i)
+  i = 1
+  n = 5
+  line = 'PZ0R1'
+  if (internal (1)) call abort ()
+  if (m .ne. 4) call abort ()
+contains
+  logical function internal (j)
+    intent(in) j
+    do i = j, n
+      k = index ('RE', lit (i))
+      m = m + 1
+      if (k == 0) cycle
+      if (i + 1 == n) exit
+    enddo
+    internal = (k == 0)
+  end function
+end
diff --git a/gcc/testsuite/gfortran.dg/do_pointer_1.f90 b/gcc/testsuite/gfortran.dg/do_pointer_1.f90
new file mode 100644
index 000000000..548177acc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_pointer_1.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR 30869 - pointer loop variables were wrongly rejected.
+program main
+  integer, pointer :: i
+  allocate (i)
+  do i=1,10
+  end do
+  deallocate (i)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/dollar_edit_descriptor_1.f b/gcc/testsuite/gfortran.dg/dollar_edit_descriptor_1.f
new file mode 100644
index 000000000..af22c4536
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dollar_edit_descriptor_1.f
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-options "-w" }
+! PR libfortran/20006
+      character*5 c
+      open (42,status='scratch')
+      write (42,'(A,$)') 'abc'
+      write (42,'(A)') 'de'
+      rewind (42)
+      read (42,'(A)') c
+      close (42)
+
+      if (c /= 'abcde') call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/dollar_edit_descriptor_2.f b/gcc/testsuite/gfortran.dg/dollar_edit_descriptor_2.f
new file mode 100644
index 000000000..4973d87ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dollar_edit_descriptor_2.f
@@ -0,0 +1,9 @@
+! { dg-do run }
+! { dg-options "-w" }
+! PR25545 internal file and dollar edit descriptor.
+      program main
+      character*20 line
+      line = '1234567890ABCDEFGHIJ'
+      write (line, '(A$)') 'asdf'
+      if (line.ne.'asdf') call abort()
+      end
diff --git a/gcc/testsuite/gfortran.dg/dollar_edit_descriptor_3.f b/gcc/testsuite/gfortran.dg/dollar_edit_descriptor_3.f
new file mode 100644
index 000000000..6e5bf6890
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dollar_edit_descriptor_3.f
@@ -0,0 +1,8 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+! Test for dollar descriptor in the middle of a format
+300   format(1000(a,$)) ! { dg-warning "should be the last specifier" }
+      write(*,300) "gee", "gee"
+      write(*,"(1000(a,$))") "foo", "bar" ! { dg-warning "should be the last specifier" }
+      end
+! { dg-output "^geegeefoobar$" }
diff --git a/gcc/testsuite/gfortran.dg/dollar_sym_1.f90 b/gcc/testsuite/gfortran.dg/dollar_sym_1.f90
new file mode 100644
index 000000000..37f0f888d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dollar_sym_1.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR fortran/34997
+! Variable names containing $ signs
+! 
+      REAL*4 PLT$C_HOUSTPIX   ! { dg-error "Invalid character '\\$'" }
+      INTEGER PLT$C_COMMAND   ! { dg-error "Invalid character '\\$'" }
+      PARAMETER (PLT$B_OPC=0) ! { dg-error "Invalid character '\\$'" }
+      common /abc$def/ PLT$C_HOUSTPIX, PLT$C_COMMAND ! { dg-error "Invalid character '\\$'" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/dollar_sym_2.f90 b/gcc/testsuite/gfortran.dg/dollar_sym_2.f90
new file mode 100644
index 000000000..800a72874
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dollar_sym_2.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-fdollar-ok" }
+!
+! PR fortran/34997
+! Variable names containing $ signs
+! 
+      REAL*4 PLT$C_HOUSTPIX
+      INTEGER PLT$C_COMMAND
+      PARAMETER (PLT$B_OPC=0)
+      common /abc$def/ PLT$C_HOUSTPIX, PLT$C_COMMAND
+      end
diff --git a/gcc/testsuite/gfortran.dg/dos_eol.f b/gcc/testsuite/gfortran.dg/dos_eol.f
new file mode 100644
index 000000000..3a22a14b1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dos_eol.f
@@ -0,0 +1,19 @@
+! PR libfortran/19678 and PR libfortran/19679
+! { dg-do run }
+      integer i, j
+      
+      open (10,status='scratch')
+      write (10,'(2A)') '1', achar(13)
+      rewind (10)
+      read (10,*) i
+      if (i .ne. 1) call abort
+      close (10)
+
+      open (10,status='scratch')
+      write (10,'(2A)') '   1', achar(13)
+      write (10,'(2A)') '   2', achar(13)
+      rewind (10)
+      read (10,'(I4)') i
+      read (10,'(I5)') j
+      if ((i .ne. 1) .or. (j .ne. 2)) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/dot_product_1.f03 b/gcc/testsuite/gfortran.dg/dot_product_1.f03
new file mode 100644
index 000000000..45d658526
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dot_product_1.f03
@@ -0,0 +1,11 @@
+! { dg-do run }
+! Transformational intrinsic DOT_PRODUCT as initialization expression.
+
+  INTEGER, PARAMETER :: n = 10
+  INTEGER, PARAMETER :: a(n) = 1
+  INTEGER, PARAMETER :: p = DOT_PRODUCT(a, a)
+  INTEGER, PARAMETER :: e = DOT_PRODUCT(SHAPE(1), SHAPE(1))
+
+  IF (p /= n) CALL abort()
+  IF (e /= 0) CALL abort()
+END
diff --git a/gcc/testsuite/gfortran.dg/double_complex_1.f90 b/gcc/testsuite/gfortran.dg/double_complex_1.f90
new file mode 100644
index 000000000..fc925a4f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/double_complex_1.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "--std=f95" }
+! PR18565
+! As we provide "double complex" versions of certain intrinsics an extension.
+! However --std=f95 was also breaking the generic versions, which should work
+! on any type kind.
+program prog
+  complex(kind=kind(0d0)) :: c
+  print *, abs(c)
+  print *, aimag(c)
+  print *, conjg(c)
+  print *, cos(c)
+  print *, exp(c)
+  print *, log(c)
+  print *, sin(c)
+  print *, sqrt(c)
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/dshift_1.F90 b/gcc/testsuite/gfortran.dg/dshift_1.F90
new file mode 100644
index 000000000..ce2a5f432
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dshift_1.F90
@@ -0,0 +1,177 @@
+! Test the DSHIFTL and DSHIFTR intrinsics.
+!
+! { dg-do run }
+! { dg-options "-ffree-line-length-none" }
+
+  implicit none
+
+  interface run_dshiftl
+    procedure dshiftl_1
+    procedure dshiftl_2
+    procedure dshiftl_4
+    procedure dshiftl_8
+  end interface
+  interface run_dshiftr
+    procedure dshiftr_1
+    procedure dshiftr_2
+    procedure dshiftr_4
+    procedure dshiftr_8
+  end interface
+
+#define RESL(I,J,SHIFT) \
+  IOR(SHIFTL(I,SHIFT),SHIFTR(J,BIT_SIZE(J)-SHIFT))
+#define RESR(I,J,SHIFT) \
+  IOR(SHIFTL(I,BIT_SIZE(I)-SHIFT),SHIFTR(J,SHIFT))
+
+#define CHECK(I,J,SHIFT) \
+  if (dshiftl(I,J,SHIFT) /= RESL(I,J,SHIFT)) call abort ; \
+  if (dshiftr(I,J,SHIFT) /= RESR(I,J,SHIFT)) call abort ; \
+  if (run_dshiftl(I,J,SHIFT) /= RESL(I,J,SHIFT)) call abort ; \
+  if (run_dshiftr(I,J,SHIFT) /= RESR(I,J,SHIFT)) call abort
+
+  CHECK(0_1,0_1,0)
+  CHECK(0_1,0_1,1)
+  CHECK(0_1,0_1,7)
+  CHECK(0_1,0_1,8)
+  CHECK(28_1,79_1,0)
+  CHECK(28_1,79_1,1)
+  CHECK(28_1,79_1,5)
+  CHECK(28_1,79_1,7)
+  CHECK(28_1,79_1,8)
+  CHECK(-28_1,79_1,0)
+  CHECK(-28_1,79_1,1)
+  CHECK(-28_1,79_1,5)
+  CHECK(-28_1,79_1,7)
+  CHECK(-28_1,79_1,8)
+  CHECK(28_1,-79_1,0)
+  CHECK(28_1,-79_1,1)
+  CHECK(28_1,-79_1,5)
+  CHECK(28_1,-79_1,7)
+  CHECK(28_1,-79_1,8)
+  CHECK(-28_1,-79_1,0)
+  CHECK(-28_1,-79_1,1)
+  CHECK(-28_1,-79_1,5)
+  CHECK(-28_1,-79_1,7)
+  CHECK(-28_1,-79_1,8)
+
+  CHECK(0_2,0_2,0)
+  CHECK(0_2,0_2,1)
+  CHECK(0_2,0_2,7)
+  CHECK(0_2,0_2,8)
+  CHECK(28_2,79_2,0)
+  CHECK(28_2,79_2,1)
+  CHECK(28_2,79_2,5)
+  CHECK(28_2,79_2,7)
+  CHECK(28_2,79_2,8)
+  CHECK(-28_2,79_2,0)
+  CHECK(-28_2,79_2,1)
+  CHECK(-28_2,79_2,5)
+  CHECK(-28_2,79_2,7)
+  CHECK(-28_2,79_2,8)
+  CHECK(28_2,-79_2,0)
+  CHECK(28_2,-79_2,1)
+  CHECK(28_2,-79_2,5)
+  CHECK(28_2,-79_2,7)
+  CHECK(28_2,-79_2,8)
+  CHECK(-28_2,-79_2,0)
+  CHECK(-28_2,-79_2,1)
+  CHECK(-28_2,-79_2,5)
+  CHECK(-28_2,-79_2,7)
+  CHECK(-28_2,-79_2,8)
+
+  CHECK(0_4,0_4,0)
+  CHECK(0_4,0_4,1)
+  CHECK(0_4,0_4,7)
+  CHECK(0_4,0_4,8)
+  CHECK(28_4,79_4,0)
+  CHECK(28_4,79_4,1)
+  CHECK(28_4,79_4,5)
+  CHECK(28_4,79_4,7)
+  CHECK(28_4,79_4,8)
+  CHECK(-28_4,79_4,0)
+  CHECK(-28_4,79_4,1)
+  CHECK(-28_4,79_4,5)
+  CHECK(-28_4,79_4,7)
+  CHECK(-28_4,79_4,8)
+  CHECK(28_4,-79_4,0)
+  CHECK(28_4,-79_4,1)
+  CHECK(28_4,-79_4,5)
+  CHECK(28_4,-79_4,7)
+  CHECK(28_4,-79_4,8)
+  CHECK(-28_4,-79_4,0)
+  CHECK(-28_4,-79_4,1)
+  CHECK(-28_4,-79_4,5)
+  CHECK(-28_4,-79_4,7)
+  CHECK(-28_4,-79_4,8)
+
+  CHECK(0_8,0_8,0)
+  CHECK(0_8,0_8,1)
+  CHECK(0_8,0_8,7)
+  CHECK(0_8,0_8,8)
+  CHECK(28_8,79_8,0)
+  CHECK(28_8,79_8,1)
+  CHECK(28_8,79_8,5)
+  CHECK(28_8,79_8,7)
+  CHECK(28_8,79_8,8)
+  CHECK(-28_8,79_8,0)
+  CHECK(-28_8,79_8,1)
+  CHECK(-28_8,79_8,5)
+  CHECK(-28_8,79_8,7)
+  CHECK(-28_8,79_8,8)
+  CHECK(28_8,-79_8,0)
+  CHECK(28_8,-79_8,1)
+  CHECK(28_8,-79_8,5)
+  CHECK(28_8,-79_8,7)
+  CHECK(28_8,-79_8,8)
+  CHECK(-28_8,-79_8,0)
+  CHECK(-28_8,-79_8,1)
+  CHECK(-28_8,-79_8,5)
+  CHECK(-28_8,-79_8,7)
+  CHECK(-28_8,-79_8,8)
+
+
+contains
+
+  function dshiftl_1 (i, j, shift) result(res)
+    integer(kind=1) :: i, j, res
+    integer :: shift
+    res = dshiftl(i,j,shift)
+  end function
+  function dshiftl_2 (i, j, shift) result(res)
+    integer(kind=2) :: i, j, res
+    integer :: shift
+    res = dshiftl(i,j,shift)
+  end function
+  function dshiftl_4 (i, j, shift) result(res)
+    integer(kind=4) :: i, j, res
+    integer :: shift
+    res = dshiftl(i,j,shift)
+  end function
+  function dshiftl_8 (i, j, shift) result(res)
+    integer(kind=8) :: i, j, res
+    integer :: shift
+    res = dshiftl(i,j,shift)
+  end function
+
+  function dshiftr_1 (i, j, shift) result(res)
+    integer(kind=1) :: i, j, res
+    integer :: shift
+    res = dshiftr(i,j,shift)
+  end function
+  function dshiftr_2 (i, j, shift) result(res)
+    integer(kind=2) :: i, j, res
+    integer :: shift
+    res = dshiftr(i,j,shift)
+  end function
+  function dshiftr_4 (i, j, shift) result(res)
+    integer(kind=4) :: i, j, res
+    integer :: shift
+    res = dshiftr(i,j,shift)
+  end function
+  function dshiftr_8 (i, j, shift) result(res)
+    integer(kind=8) :: i, j, res
+    integer :: shift
+    res = dshiftr(i,j,shift)
+  end function
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dshift_2.F90 b/gcc/testsuite/gfortran.dg/dshift_2.F90
new file mode 100644
index 000000000..f0cfff680
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dshift_2.F90
@@ -0,0 +1,59 @@
+! Test the DSHIFTL and DSHIFTR intrinsics.
+!
+! { dg-do run }
+! { dg-options "-ffree-line-length-none" }
+! { dg-require-effective-target fortran_integer_16 }
+
+  implicit none
+
+#define RESL(I,J,SHIFT) \
+  IOR(SHIFTL(I,SHIFT),SHIFTR(J,BIT_SIZE(J)-SHIFT))
+#define RESR(I,J,SHIFT) \
+  IOR(SHIFTL(I,BIT_SIZE(I)-SHIFT),SHIFTR(J,SHIFT))
+
+#define CHECK(I,J,SHIFT) \
+  if (dshiftl(I,J,SHIFT) /= RESL(I,J,SHIFT)) call abort ; \
+  if (dshiftr(I,J,SHIFT) /= RESR(I,J,SHIFT)) call abort ; \
+  if (run_dshiftl(I,J,SHIFT) /= RESL(I,J,SHIFT)) call abort ; \
+  if (run_dshiftr(I,J,SHIFT) /= RESR(I,J,SHIFT)) call abort
+
+  CHECK(0_16,0_16,0)
+  CHECK(0_16,0_16,1)
+  CHECK(0_16,0_16,7)
+  CHECK(0_16,0_16,8)
+  CHECK(28_16,79_16,0)
+  CHECK(28_16,79_16,1)
+  CHECK(28_16,79_16,5)
+  CHECK(28_16,79_16,7)
+  CHECK(28_16,79_16,8)
+  CHECK(-28_16,79_16,0)
+  CHECK(-28_16,79_16,1)
+  CHECK(-28_16,79_16,5)
+  CHECK(-28_16,79_16,7)
+  CHECK(-28_16,79_16,8)
+  CHECK(28_16,-79_16,0)
+  CHECK(28_16,-79_16,1)
+  CHECK(28_16,-79_16,5)
+  CHECK(28_16,-79_16,7)
+  CHECK(28_16,-79_16,8)
+  CHECK(-28_16,-79_16,0)
+  CHECK(-28_16,-79_16,1)
+  CHECK(-28_16,-79_16,5)
+  CHECK(-28_16,-79_16,7)
+  CHECK(-28_16,-79_16,8)
+
+contains
+
+  function run_dshiftl (i, j, shift) result(res)
+    integer(kind=16) :: i, j, res
+    integer :: shift
+    res = dshiftl(i,j,shift)
+  end function
+
+  function run_dshiftr (i, j, shift) result(res)
+    integer(kind=16) :: i, j, res
+    integer :: shift
+    res = dshiftr(i,j,shift)
+  end function
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dummy_functions_1.f90 b/gcc/testsuite/gfortran.dg/dummy_functions_1.f90
new file mode 100644
index 000000000..8076cf911
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dummy_functions_1.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! PR 18197: Check that dummy functions with RESULT variable and dimension works.
+module innerfun
+contains
+  function f(n,x) result(y)
+    integer, intent(in) :: n
+    real, dimension(:), intent(in) :: x
+    real, dimension(n) :: y
+    y = 1
+  end function f
+end module innerfun
+
+module outerfun
+contains
+   subroutine foo(n,funname)
+     integer, intent(in) :: n
+     real, dimension(n) :: y
+     real, dimension(2) :: x
+     interface
+       function funname(n,x) result(y)
+         integer, intent(in) :: n
+         real, dimension(:), intent(in) :: x
+         real, dimension(n)  :: y
+       end function funname
+     end interface
+
+     y = funname(n, (/ 0.2, 0.3 /) )
+
+   end subroutine foo
+end module outerfun
+
+program test
+   use outerfun
+   use innerfun
+   call foo(3,f)
+end program test
+
+! { dg-final { cleanup-modules "innerfun outerfun" } }
diff --git a/gcc/testsuite/gfortran.dg/dummy_optional_arg.f90 b/gcc/testsuite/gfortran.dg/dummy_optional_arg.f90
new file mode 100644
index 000000000..4c0417bff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dummy_optional_arg.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! PR fortran/45495
+!
+! Code originally submitted by Philip Mason <pmason at ricardo dot com>
+!
+function jack(aa)
+   character(len=*), intent(in) :: aa
+   optional :: aa
+   character(len=len(aa)+1) :: jack ! { dg-error "cannot be OPTIONAL" }
+   jack = ''
+end function jack
+
+function diane(aa)
+   character(len=*), intent(out) :: aa
+   character(len=len(aa)+1) :: diane
+   diane = '012345678901'
+   aa = 'abcdefghijklmn'
+end function diane
diff --git a/gcc/testsuite/gfortran.dg/dummy_procedure_1.f90 b/gcc/testsuite/gfortran.dg/dummy_procedure_1.f90
new file mode 100644
index 000000000..55107b69a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dummy_procedure_1.f90
@@ -0,0 +1,52 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! Test the patch for PR25098, where passing a variable as an
+! actual argument to a formal argument that is a procedure
+! went undiagnosed.
+!
+! Based on contribution by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+integer function y()
+  y = 1
+end
+integer function z()
+  z = 1
+end
+
+module m1
+contains
+  subroutine s1(f)
+    interface
+      function f()
+        integer f
+      end function f
+    end interface
+  end subroutine s1
+  subroutine s2(x)
+    integer :: x
+  end subroutine
+end module m1
+
+  use m1
+  external y
+  interface
+   function x()
+     integer x
+   end function x
+  end interface
+
+  integer :: i, y, z
+  i=1
+  call s1(i) ! { dg-error "Expected a procedure for argument" }
+  call s1(w) ! { dg-error "used as actual argument" }
+  call s1(x) ! explicit interface
+  call s1(y) ! declared external
+  call s1(z) ! { dg-error "Expected a procedure for argument" }
+  call s2(x) ! { dg-error "Invalid procedure argument" }
+contains
+  integer function w()
+    w = 1
+  end function w
+end
+
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/dummy_procedure_2.f90 b/gcc/testsuite/gfortran.dg/dummy_procedure_2.f90
new file mode 100644
index 000000000..b58980863
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dummy_procedure_2.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! Checks the fix for the bug exposed in fixing PR25147
+!
+! Contributed by Tobias Schlueter  <tobi@gcc.gnu.org>
+!
+module integrator
+  interface
+     function integrate(f,xmin,xmax)
+       implicit none
+       interface
+          function f(x)
+            real(8) :: f,x
+            intent(in) :: x
+          end function f
+       end interface
+       real(8) :: xmin, xmax, integrate
+     end function integrate
+  end interface
+end module integrator
+
+  use integrator
+  call foo1 ()
+  call foo2 ()
+contains
+  subroutine foo1 ()
+    real(8) :: f                   ! This was not trapped: PR25147/25098
+    print *,integrate (f,0d0,3d0) ! { dg-error "Expected a procedure" }
+  end subroutine foo1
+  subroutine foo2 ()
+    real(8), external :: g ! This would give an error, incorrectly.
+    print *,integrate (g,0d0,3d0)
+  end subroutine foo2
+end
+! { dg-final { cleanup-modules "integrator" } }
diff --git a/gcc/testsuite/gfortran.dg/dummy_procedure_3.f90 b/gcc/testsuite/gfortran.dg/dummy_procedure_3.f90
new file mode 100644
index 000000000..cde2f0166
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dummy_procedure_3.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! PR37926 - the interface did not transfer the formal
+! argument list for the call to 'asz' in the specification of 'p'.
+!
+! Contributed by Janus Weil  <janus@gcc.gnu.org>
+!
+module m
+contains
+  pure integer function mysize(a)
+    integer,intent(in) :: a(:)
+    mysize = size(a)
+  end function
+end module
+
+program prog
+  use m
+  implicit none
+  character(3) :: str
+  integer :: i(3) = (/1,2,3/)
+  str = p(i,mysize)
+  if (len(str) .ne. 3) call abort
+  if (str .ne. "BCD") call abort
+contains
+  function p(y,asz)
+    implicit none
+    integer :: y(:)
+    interface
+      pure integer function asz(c)
+        integer,intent(in) :: c(:)
+      end function
+    end interface
+    character(asz(y)) p
+    integer i
+    do i=1,asz(y)
+      p(i:i) = achar(iachar('A')+y(i))
+    end do
+  end function
+end
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/dummy_procedure_4.f90 b/gcc/testsuite/gfortran.dg/dummy_procedure_4.f90
new file mode 100644
index 000000000..498685bde
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dummy_procedure_4.f90
@@ -0,0 +1,48 @@
+! { dg-do compile }
+!
+! PR 46067: [F03] invalid procedure pointer assignment not detected
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m
+
+  type test_type
+    integer :: id = 1
+  end type
+
+contains
+
+  real function fun1 (t,x)
+    real, intent(in) :: x
+    type(test_type) :: t
+    print *," id = ", t%id
+    fun1 = cos(x)
+  end function
+
+end module
+
+
+  use m
+  implicit none
+
+  call test (fun1)  ! { dg-error "Interface mismatch in dummy procedure" }
+
+contains
+
+  subroutine test(proc)
+    interface
+      real function proc(t,x)
+        import :: test_type
+        real, intent(in) :: x
+        class(test_type) :: t
+      end function
+    end interface
+    type(test_type) :: funs
+    real :: r
+    r = proc(funs,0.)
+    print *, " proc(0) ",r
+  end subroutine
+
+end
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/dummy_procedure_7.f90 b/gcc/testsuite/gfortran.dg/dummy_procedure_7.f90
new file mode 100644
index 000000000..32cd65ae8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dummy_procedure_7.f90
@@ -0,0 +1,65 @@
+! { dg-do run }
+!
+! PR fortran/52022
+!
+
+module check
+  integer, save :: icheck = 0
+end module check
+
+module t
+implicit none
+      contains
+subroutine  sol(cost)
+   use check
+   interface 
+        function cost(p) result(y) 
+                double precision,dimension(:) :: p
+                double precision,dimension(:),allocatable :: y
+        end function cost
+   end interface
+
+   if (any (cost([1d0,2d0]) /= [2.d0, 4.d0])) call abort ()
+   icheck = icheck + 1
+end subroutine
+
+end module t
+
+module tt
+   procedure(cost1),pointer :: pcost
+contains
+  subroutine init()
+        pcost=>cost1
+  end subroutine
+
+  function cost1(x) result(y)
+        double precision,dimension(:) :: x
+        double precision,dimension(:),allocatable :: y
+        allocate(y(2))
+        y=2d0*x
+  end function cost1
+
+
+
+  function cost(x) result(y)
+        double precision,dimension(:) :: x
+        double precision,dimension(:),allocatable :: y
+        allocate(y(2))
+        y=pcost(x)
+  end function cost
+end module
+
+program test
+        use tt
+        use t
+        use check
+        implicit none
+
+        call init()
+        if (any (cost([3.d0,7.d0]) /= [6.d0, 14.d0])) call abort ()
+        if (icheck /= 0) call abort ()
+        call sol(cost)
+        if (icheck /= 1) call abort ()
+end program test
+
+! { dg-final { cleanup-modules "t tt check" } }
diff --git a/gcc/testsuite/gfortran.dg/dup_save_1.f90 b/gcc/testsuite/gfortran.dg/dup_save_1.f90
new file mode 100644
index 000000000..7f22b62d1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dup_save_1.f90
@@ -0,0 +1,57 @@
+! { dg-do run }
+program save_1
+  implicit none
+  integer i
+  integer foo1, foo2, foo3, foo4
+  do i=1,10
+     if (foo1().ne.i) then
+        call abort
+     end if
+     if (foo2().ne.i) then
+        call abort
+     end if
+     if (foo3().ne.i) then
+        call abort
+     end if
+     if (foo4().ne.i) then
+        call abort
+     end if
+  end do
+end program save_1
+
+integer function foo1 ()
+  integer j
+  save
+  save ! { dg-warning "Blanket SAVE" }
+  data j /0/
+  j = j + 1
+  foo1 = j
+end function foo1
+
+integer function foo2 ()
+  integer j
+  save j
+  save j ! { dg-warning "Duplicate SAVE" }
+  data j /0/
+  j = j + 1
+  foo2 = j
+end function foo2
+
+integer function foo3 ()
+  integer j ! { dg-warning "Duplicate SAVE" }
+  save
+  save j ! { dg-warning "SAVE statement" }
+  data j /0/
+  j = j + 1
+  foo3 = j
+end function foo3
+
+integer function foo4 ()
+  integer j ! { dg-warning "Duplicate SAVE" }
+  save j
+  save
+  data j /0/
+  j = j + 1
+  foo4 = j
+end function foo4
+
diff --git a/gcc/testsuite/gfortran.dg/dup_save_2.f90 b/gcc/testsuite/gfortran.dg/dup_save_2.f90
new file mode 100644
index 000000000..a0d340ad6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dup_save_2.f90
@@ -0,0 +1,57 @@
+! { dg-do compile }
+! { dg-options "-fall-intrinsics -std=f95" }
+program save_2
+  implicit none
+  integer i
+  integer foo1, foo2, foo3, foo4
+  do i=1,10
+     if (foo1().ne.i) then
+        call abort
+     end if
+     if (foo2().ne.i) then
+        call abort
+     end if
+     if (foo3().ne.i) then
+        call abort
+     end if
+     if (foo4().ne.i) then
+        call abort
+     end if
+  end do
+end program save_2
+
+integer function foo1 ()
+  integer j
+  save
+  save ! { dg-error "Blanket SAVE" }
+  data j /0/
+  j = j + 1
+  foo1 = j
+end function foo1
+
+integer function foo2 ()
+  integer j
+  save j
+  save j ! { dg-error "Duplicate SAVE" }
+  data j /0/
+  j = j + 1
+  foo2 = j
+end function foo2
+
+integer function foo3 ()
+  integer j
+  save
+  save j ! { dg-error "SAVE statement" }
+  data j /0/
+  j = j + 1
+  foo3 = j
+end function foo3
+
+integer function foo4 ()
+  integer j ! { dg-error "Duplicate SAVE" }
+  save j
+  save
+  data j /0/
+  j = j + 1
+  foo4 = j
+end function foo4
diff --git a/gcc/testsuite/gfortran.dg/duplicate_labels.f90 b/gcc/testsuite/gfortran.dg/duplicate_labels.f90
new file mode 100644
index 000000000..7523d0c41
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/duplicate_labels.f90
@@ -0,0 +1,59 @@
+! { dg-do compile }
+! PR 21257
+program dups
+
+  integer i,j,k
+
+  abc: do i = 1, 3
+  abc:    do j = 1, 3    ! { dg-error "Duplicate construct label" }
+              k = i + j
+          end do abc
+       end do abc        ! { dg-error "Expecting END PROGRAM" }
+
+  xyz: do i = 1, 2
+          k = i + 2
+       end do xyz
+  xyz: do j = 1, 5      ! { dg-error "Duplicate construct label" }
+          k = j + 2
+       end do loop      ! { dg-error "Expecting END PROGRAM" }
+
+  her: if (i == 1) then
+  her:    if (j  == 1) then  ! { dg-error "Duplicate construct label" }
+               k = i + j
+          end if her
+       end if her            ! { dg-error "Expecting END PROGRAM" }
+
+  his: if (i == 1) then
+           i = j
+        end if his
+  his: if (j === 1) then    ! { dg-error "Duplicate construct label" }
+           print *, j
+        end if his          ! { dg-error "Expecting END PROGRAM" }
+
+  sgk: select case (i)
+       case (1)
+  sgk:   select case (j)    ! { dg-error "Duplicate construct label" }
+          case (10)
+             i = i + j
+          case (20)
+             j = j + i
+          end select sgk
+        case (2)             ! { dg-error "Unexpected CASE statement" }
+            i = i + 1
+            j = j + 1
+        end select sgk       ! { dg-error "Expecting END PROGRAM" }
+
+  apl: select case (i)
+         case (1)
+            k = 2
+         case (2)
+            j = 1
+         end select apl
+  apl: select case (i)  ! { dg-error "Duplicate construct label" }
+         case (1)       ! { dg-error "Unexpected CASE statement" }
+            j = 2
+         case (2)       ! { dg-error "Unexpected CASE statement" }
+            k = 1
+         end select apl ! { dg-error "Expecting END PROGRAM" }
+
+end program dups
diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_1.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_1.f90
new file mode 100644
index 000000000..c76c45d18
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/duplicate_type_1.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! PR fortran/30239
+! Check for errors when a symbol gets declared a type twice, even if it
+! is the same.
+
+INTEGER FUNCTION foo ()
+  IMPLICIT NONE
+  INTEGER :: foo ! { dg-error "basic type of" }
+  INTEGER :: foo ! { dg-error "basic type of" }
+  foo = 42
+END FUNCTION foo
+
+INTEGER FUNCTION bar () RESULT (x)
+  IMPLICIT NONE
+  INTEGER :: x ! { dg-error "basic type of" }
+
+  INTEGER :: y
+  INTEGER :: y ! { dg-error "basic type of" }
+
+  x = 42
+END FUNCTION bar
diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_2.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_2.f90
new file mode 100644
index 000000000..0fd9258fe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/duplicate_type_2.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-std=gnu -Wsurprising" }
+
+! PR fortran/30239
+! Check for errors when a symbol gets declared a type twice, even if it
+! is the same.
+
+INTEGER FUNCTION foo ()
+  IMPLICIT NONE
+  INTEGER :: foo ! { dg-error "basic type of" }
+  INTEGER :: foo ! { dg-error "basic type of" }
+  foo = 42
+END FUNCTION foo
+
+INTEGER FUNCTION bar () RESULT (x)
+  IMPLICIT NONE
+  INTEGER :: x ! { dg-error "basic type of" }
+
+  INTEGER :: y
+  INTEGER :: y ! { dg-error "basic type of" }
+
+  x = 42
+END FUNCTION bar
diff --git a/gcc/testsuite/gfortran.dg/duplicate_type_3.f90 b/gcc/testsuite/gfortran.dg/duplicate_type_3.f90
new file mode 100644
index 000000000..802029db0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/duplicate_type_3.f90
@@ -0,0 +1,48 @@
+! { dg-do compile }
+!
+! PR 39996: Double typing of function results not detected
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+  interface
+    real function A ()
+    end function
+  end interface
+  real :: A  ! { dg-error "already has basic type of" }
+
+  real :: B
+  interface
+    real function B ()  ! { dg-error "already has basic type of" }
+    end function  ! { dg-error "Expecting END INTERFACE statement" }
+  end interface
+
+  interface
+    function C ()
+      real :: C
+    end function
+  end interface
+  real :: C  ! { dg-error "already has basic type of" }
+
+  real :: D
+  interface
+    function D ()
+      real :: D  ! { dg-error "already has basic type of" }
+    end function
+  end interface
+
+  interface
+    function E () result (s)
+      real ::s
+    end function
+  end interface
+  real :: E  ! { dg-error "already has basic type of" }
+
+  real :: F
+  interface
+    function F () result (s)
+      real ::s  ! { dg-error "already has basic type of" }
+    end function F
+  end interface
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_1.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_1.f03
new file mode 100644
index 000000000..2182dce3e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_1.f03
@@ -0,0 +1,79 @@
+! { dg-do run }
+! Tests dynamic dispatch of class functions.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+module m
+  type :: t1
+    integer :: i = 42
+    procedure(make_real), pointer :: ptr
+  contains
+    procedure, pass :: real => make_real
+    procedure, pass :: make_integer
+    procedure, pass :: prod => i_m_j
+    generic, public :: extract => real, make_integer
+  end type t1
+
+  type, extends(t1) :: t2
+    integer :: j = 99
+  contains
+    procedure, pass :: real => make_real2
+    procedure, pass :: make_integer => make_integer_2
+    procedure, pass :: prod => i_m_j_2
+  end type t2
+contains
+  real function make_real (arg)
+    class(t1), intent(in) :: arg
+    make_real = real (arg%i)
+  end function make_real
+
+  real function make_real2 (arg)
+    class(t2), intent(in) :: arg
+    make_real2 = real (arg%j)
+  end function make_real2
+
+  integer function make_integer (arg, arg2)
+    class(t1), intent(in) :: arg
+    integer :: arg2
+    make_integer = arg%i * arg2
+  end function make_integer
+
+  integer function make_integer_2 (arg, arg2)
+    class(t2), intent(in) :: arg
+    integer :: arg2
+    make_integer_2 = arg%j * arg2
+  end function make_integer_2
+
+  integer function i_m_j (arg)
+    class(t1), intent(in) :: arg
+        i_m_j = arg%i
+  end function i_m_j
+
+  integer function i_m_j_2 (arg)
+    class(t2), intent(in) :: arg
+        i_m_j_2 = arg%j
+  end function i_m_j_2
+end module m
+
+  use m
+  type, extends(t1) :: l1
+    character(16) :: chr
+  end type l1
+  class(t1), pointer :: a !=> NULL()
+  type(t1), target :: b
+  type(t2), target :: c
+  type(l1), target :: d
+  a => b                                   ! declared type
+  if (a%real() .ne. real (42)) call abort
+  if (a%prod() .ne. 42) call abort
+  if (a%extract (2) .ne. 84) call abort
+  a => c                                   ! extension in module
+  if (a%real() .ne. real (99)) call abort
+  if (a%prod() .ne. 99) call abort
+  if (a%extract (3) .ne. 297) call abort
+  a => d                                   ! extension in main
+  if (a%real() .ne. real (42)) call abort
+  if (a%prod() .ne. 42) call abort
+  if (a%extract (4) .ne. 168) call abort
+end
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_10.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_10.f03
new file mode 100644
index 000000000..2b8e0fbc5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_10.f03
@@ -0,0 +1,171 @@
+! { dg-do run }
+!
+! [OOP] Fortran runtime error: internal error: bad hash value in dynamic dispatch
+!
+! Contributed by David Car <david.car7@gmail.com>
+
+module BaseStrategy
+
+  type, public, abstract :: Strategy
+   contains
+     procedure(strategy_update), pass( this ), deferred :: update
+     procedure(strategy_pre_update), pass( this ), deferred :: preUpdate
+     procedure(strategy_post_update), pass( this ), deferred :: postUpdate
+  end type Strategy
+
+  abstract interface
+     subroutine strategy_update( this )
+       import Strategy
+       class (Strategy), target, intent(in) :: this
+     end subroutine strategy_update
+  end interface
+
+  abstract interface
+     subroutine strategy_pre_update( this )
+       import Strategy
+       class (Strategy), target, intent(in) :: this
+     end subroutine strategy_pre_update
+  end interface
+
+  abstract interface
+     subroutine strategy_post_update( this )
+       import Strategy
+       class (Strategy), target, intent(in) :: this
+     end subroutine strategy_post_update
+  end interface
+     
+end module BaseStrategy
+
+!==============================================================================
+
+module LaxWendroffStrategy
+
+  use BaseStrategy
+
+  private :: update, preUpdate, postUpdate
+
+  type, public, extends( Strategy ) :: LaxWendroff
+     class (Strategy), pointer :: child => null()
+     contains
+       procedure, pass( this ) :: update
+       procedure, pass( this ) :: preUpdate
+       procedure, pass( this ) :: postUpdate
+  end type LaxWendroff
+
+contains
+
+  subroutine update( this )
+    class (LaxWendroff), target, intent(in) :: this
+
+    print *, 'Calling LaxWendroff update'
+  end subroutine update
+
+  subroutine preUpdate( this )
+    class (LaxWendroff), target, intent(in) :: this
+    
+    print *, 'Calling LaxWendroff preUpdate'
+  end subroutine preUpdate
+
+  subroutine postUpdate( this )
+    class (LaxWendroff), target, intent(in) :: this
+    
+    print *, 'Calling LaxWendroff postUpdate'
+  end subroutine postUpdate
+  
+end module LaxWendroffStrategy
+
+!==============================================================================
+
+module KEStrategy
+
+  use BaseStrategy
+  ! Uncomment the line below and it runs fine
+  ! use LaxWendroffStrategy
+
+  private :: update, preUpdate, postUpdate
+
+  type, public, extends( Strategy ) :: KE
+     class (Strategy), pointer :: child => null()
+     contains
+       procedure, pass( this ) :: update
+       procedure, pass( this ) :: preUpdate
+       procedure, pass( this ) :: postUpdate
+  end type KE
+  
+contains
+
+  subroutine init( this, other )
+    class (KE), intent(inout) :: this
+    class (Strategy), target, intent(in) :: other
+
+    this % child => other
+  end subroutine init
+
+  subroutine update( this )
+    class (KE), target, intent(in) :: this
+
+    if ( associated( this % child ) ) then
+       call this % child % update()
+    end if
+
+    print *, 'Calling KE update'
+  end subroutine update
+
+ subroutine preUpdate( this )
+    class (KE), target, intent(in) :: this
+    
+    if ( associated( this % child ) ) then
+       call this % child % preUpdate()
+    end if
+
+    print *, 'Calling KE preUpdate'
+  end subroutine preUpdate
+
+  subroutine postUpdate( this )
+    class (KE), target, intent(in) :: this
+
+    if ( associated( this % child ) ) then
+       call this % child % postUpdate()
+    end if
+    
+    print *, 'Calling KE postUpdate'
+  end subroutine postUpdate
+  
+end module KEStrategy
+
+!==============================================================================
+
+program main
+
+  use LaxWendroffStrategy
+  use KEStrategy
+
+  type :: StratSeq
+     class (Strategy), pointer :: strat => null()
+  end type StratSeq
+
+  type (LaxWendroff), target :: lw_strat
+  type (KE), target :: ke_strat
+
+  type (StratSeq), allocatable, dimension( : ) :: seq
+  
+  allocate( seq(10) )
+
+  call init( ke_strat, lw_strat )
+  call ke_strat % preUpdate()
+  call ke_strat % update()
+  call ke_strat % postUpdate()
+  ! call lw_strat % update()
+
+  seq( 1 ) % strat => ke_strat
+  seq( 2 ) % strat => lw_strat
+
+  call seq( 1 ) % strat % update()
+
+  do i = 1, 2
+     call seq( i ) % strat % update()
+  end do
+
+end
+
+! { dg-final { cleanup-modules "BaseStrategy LaxWendroffStrategy KEStrategy" } }
diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_11.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_11.f03
new file mode 100644
index 000000000..e4abcb284
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_11.f03
@@ -0,0 +1,35 @@
+! { dg-do run }
+!
+! PR 42769: [OOP] ICE in resolve_typebound_procedure
+! comment #27
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+
+module mod1
+  type :: t1
+  contains
+    procedure, nopass :: get => my_get
+  end type
+contains 
+  integer function my_get()
+    my_get = 1
+  end function
+end module
+
+module mod2
+contains 
+  integer function my_get()   ! must have the same name as the function in mod1
+    my_get = 2
+  end function
+end module
+
+  use mod2
+  use mod1              ! order of use statements is important
+  class(t1),allocatable :: a
+  allocate(a)
+  if (a%get()/=1) call abort()
+end
+
+
+! { dg-final { cleanup-modules "mod1 mod2" } }
diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_2.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_2.f03
new file mode 100644
index 000000000..95ce83723
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_2.f03
@@ -0,0 +1,97 @@
+! { dg-do run }
+! Tests dynamic dispatch of class subroutines.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+module m
+  type :: t1
+    integer :: i = 42
+    procedure(make_real), pointer :: ptr
+  contains
+    procedure, pass :: real => make_real
+    procedure, pass :: make_integer
+    procedure, pass :: prod => i_m_j
+    generic, public :: extract => real, make_integer
+  end type t1
+
+  type, extends(t1) :: t2
+    integer :: j = 99
+  contains
+    procedure, pass :: real => make_real2
+    procedure, pass :: make_integer => make_integer_2
+    procedure, pass :: prod => i_m_j_2
+  end type t2
+contains
+  subroutine make_real (arg, arg2)
+    class(t1), intent(in) :: arg
+    real :: arg2
+    arg2 = real (arg%i)
+  end subroutine make_real
+
+  subroutine make_real2 (arg, arg2)
+    class(t2), intent(in) :: arg
+    real :: arg2
+    arg2 = real (arg%j)
+  end subroutine make_real2
+
+  subroutine make_integer (arg, arg2, arg3)
+    class(t1), intent(in) :: arg
+    integer :: arg2, arg3
+    arg3 = arg%i * arg2
+  end subroutine make_integer
+
+  subroutine make_integer_2 (arg, arg2, arg3)
+    class(t2), intent(in) :: arg
+    integer :: arg2, arg3
+    arg3 = arg%j * arg2
+  end subroutine make_integer_2
+
+  subroutine i_m_j (arg, arg2)
+    class(t1), intent(in) :: arg
+    integer :: arg2
+        arg2 = arg%i
+  end subroutine i_m_j
+
+  subroutine i_m_j_2 (arg, arg2)
+    class(t2), intent(in) :: arg
+    integer :: arg2
+        arg2 = arg%j
+  end subroutine i_m_j_2
+end module m
+
+  use m
+  type, extends(t1) :: l1
+    character(16) :: chr
+  end type l1
+  class(t1), pointer :: a !=> NULL()
+  type(t1), target :: b
+  type(t2), target :: c
+  type(l1), target :: d
+  real :: r
+  integer :: i
+
+  a => b                                   ! declared type
+  call a%real(r)
+  if (r .ne. real (42)) call abort
+  call a%prod(i)
+  if (i .ne. 42) call abort
+  call a%extract (2, i)
+  if (i .ne. 84) call abort
+
+  a => c                                   ! extension in module
+  call a%real(r)
+  if (r .ne. real (99)) call abort
+  call a%prod(i)
+  if (i .ne. 99) call abort
+  call a%extract (3, i)
+  if (i .ne. 297) call abort
+
+  a => d                                   ! extension in main
+  call a%real(r)
+  if (r .ne. real (42)) call abort
+  call a%prod(i)
+  if (i .ne. 42) call abort
+  call a%extract (4, i)
+  if (i .ne. 168) call abort
+end
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_3.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_3.f03
new file mode 100644
index 000000000..884d34260
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_3.f03
@@ -0,0 +1,86 @@
+! { dg-do run }
+! Tests dynamic dispatch of class functions, spread over
+! different modules. Apart from the location of the derived
+! type declarations, this test is the same as
+! dynamic_dispatch_1.f03
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+module m1
+  type :: t1
+    integer :: i = 42
+    procedure(make_real), pointer :: ptr
+  contains
+    procedure, pass :: real => make_real
+    procedure, pass :: make_integer
+    procedure, pass :: prod => i_m_j
+    generic, public :: extract => real, make_integer
+  end type t1
+contains
+  real function make_real (arg)
+    class(t1), intent(in) :: arg
+    make_real = real (arg%i)
+  end function make_real
+
+  integer function make_integer (arg, arg2)
+    class(t1), intent(in) :: arg
+    integer :: arg2
+    make_integer = arg%i * arg2
+  end function make_integer
+
+  integer function i_m_j (arg)
+    class(t1), intent(in) :: arg
+        i_m_j = arg%i
+  end function i_m_j
+end module m1
+
+module m2
+  use m1
+  type, extends(t1) :: t2
+    integer :: j = 99
+  contains
+    procedure, pass :: real => make_real2
+    procedure, pass :: make_integer => make_integer_2
+    procedure, pass :: prod => i_m_j_2
+  end type t2
+contains
+  real function make_real2 (arg)
+    class(t2), intent(in) :: arg
+    make_real2 = real (arg%j)
+  end function make_real2
+
+  integer function make_integer_2 (arg, arg2)
+    class(t2), intent(in) :: arg
+    integer :: arg2
+    make_integer_2 = arg%j * arg2
+  end function make_integer_2
+
+  integer function i_m_j_2 (arg)
+    class(t2), intent(in) :: arg
+        i_m_j_2 = arg%j
+  end function i_m_j_2
+end module m2
+
+  use m1
+  use m2
+  type, extends(t1) :: l1
+    character(16) :: chr
+  end type l1
+  class(t1), pointer :: a !=> NULL()
+  type(t1), target :: b
+  type(t2), target :: c
+  type(l1), target :: d
+  a => b                                   ! declared type in module m1
+  if (a%real() .ne. real (42)) call abort
+  if (a%prod() .ne. 42) call abort
+  if (a%extract (2) .ne. 84) call abort
+  a => c                                   ! extension in module m2
+  if (a%real() .ne. real (99)) call abort
+  if (a%prod() .ne. 99) call abort
+  if (a%extract (3) .ne. 297) call abort
+  a => d                                   ! extension in main
+  if (a%real() .ne. real (42)) call abort
+  if (a%prod() .ne. 42) call abort
+  if (a%extract (4) .ne. 168) call abort
+end
+! { dg-final { cleanup-modules "m1, m2" } }
diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_4.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_4.f03
new file mode 100644
index 000000000..b72819acc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_4.f03
@@ -0,0 +1,96 @@
+! { dg-do run }
+! Tests the fix for PR41648 in which the reference a%a%getit () was wrongly
+! identified as a recursive call to getit.
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+!
+module foo_mod
+  type foo
+    integer :: i 
+  contains
+    procedure, pass(a) :: doit
+    procedure, pass(a) :: getit
+  end type foo
+  
+  private doit,getit
+contains
+  subroutine  doit(a) 
+    class(foo) :: a
+    
+    a%i = 1
+  end subroutine doit
+  function getit(a) result(res)
+    class(foo) :: a
+    integer :: res
+
+    res = a%i
+  end function getit
+    
+end module foo_mod
+
+module s_bar_mod 
+  use foo_mod
+  type, extends(foo) :: s_bar 
+    type(foo), allocatable :: a
+  contains 
+    procedure, pass(a) :: doit
+    procedure, pass(a) :: getit
+  end type s_bar
+  private doit,getit
+  
+contains
+  subroutine doit(a)
+    class(s_bar) :: a
+    allocate (a%a)   
+    call a%a%doit()
+  end subroutine doit
+  function getit(a) result(res)
+    class(s_bar) :: a
+    integer :: res
+
+    res = a%a%getit () * 2
+  end function getit
+end module s_bar_mod
+
+module a_bar_mod 
+  use foo_mod
+  type, extends(foo) :: a_bar 
+    type(foo), allocatable :: a(:)
+  contains 
+    procedure, pass(a) :: doit
+    procedure, pass(a) :: getit
+  end type a_bar
+  private doit,getit
+  
+contains
+  subroutine doit(a)
+    class(a_bar) :: a
+    allocate (a%a(1))   
+    call a%a(1)%doit ()
+  end subroutine doit
+  function getit(a) result(res)
+    class(a_bar) :: a
+    integer :: res
+
+    res = a%a(1)%getit () * 3
+  end function getit
+end module a_bar_mod
+
+  use s_bar_mod
+  use a_bar_mod
+  type(foo), target :: b
+  type(s_bar), target :: c
+  type(a_bar), target :: d
+  class(foo), pointer :: a
+  a => b
+  call a%doit
+  if (a%getit () .ne. 1) call abort
+  a => c
+  call a%doit
+  if (a%getit () .ne. 2) call abort
+  a => d
+  call a%doit
+  if (a%getit () .ne. 3) call abort
+end
+! { dg-final { cleanup-modules "foo_mod s_bar_mod a_bar_mod" } }
+
diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_5.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_5.f03
new file mode 100644
index 000000000..036c20092
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_5.f03
@@ -0,0 +1,187 @@
+! { dg-do run }
+! Tests the fix for PR4164656 in which the call to a%a%scal failed to compile.
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+!
+module const_mod
+  integer, parameter  :: longndig=12
+  integer, parameter  :: long_int_k_ = selected_int_kind(longndig)
+  integer, parameter  :: dpk_ = kind(1.d0)
+  integer, parameter  :: spk_ = kind(1.e0)
+end module const_mod
+
+module base_mat_mod  
+  use const_mod 
+  type  :: base_sparse_mat
+    integer, private     :: m, n
+    integer, private     :: state, duplicate 
+    logical, private     :: triangle, unitd, upper, sorted
+  contains 
+    procedure, pass(a) :: get_nzeros
+  end type base_sparse_mat
+  private ::  get_nzeros
+contains
+  function get_nzeros(a) result(res)
+    implicit none 
+    class(base_sparse_mat), intent(in) :: a
+    integer :: res
+    integer :: err_act
+    character(len=20)  :: name='base_get_nzeros'
+    logical, parameter :: debug=.false.
+    res = -1
+  end function get_nzeros
+end module base_mat_mod
+
+module s_base_mat_mod
+  use base_mat_mod
+  type, extends(base_sparse_mat) :: s_base_sparse_mat
+  contains
+    procedure, pass(a) :: s_scals
+    procedure, pass(a) :: s_scal
+    generic, public    :: scal => s_scals, s_scal 
+  end type s_base_sparse_mat
+  private :: s_scals, s_scal
+
+  type, extends(s_base_sparse_mat) :: s_coo_sparse_mat
+    
+    integer              :: nnz
+    integer, allocatable :: ia(:), ja(:)
+    real(spk_), allocatable :: val(:)
+  contains
+    procedure, pass(a) :: get_nzeros => s_coo_get_nzeros
+    procedure, pass(a) :: s_scals => s_coo_scals
+    procedure, pass(a) :: s_scal => s_coo_scal
+  end type s_coo_sparse_mat
+  private :: s_coo_scals, s_coo_scal, s_coo_get_nzeros
+contains 
+  subroutine s_scals(d,a,info) 
+    implicit none 
+    class(s_base_sparse_mat), intent(in) :: a
+    real(spk_), intent(in)      :: d
+    integer, intent(out)            :: info
+
+    Integer :: err_act
+    character(len=20)  :: name='s_scals'
+    logical, parameter :: debug=.false.
+
+    ! This is the base version. If we get here
+    ! it means the derived class is incomplete,
+    ! so we throw an error.
+    info = 700
+  end subroutine s_scals
+
+
+  subroutine s_scal(d,a,info) 
+    implicit none 
+    class(s_base_sparse_mat), intent(in) :: a
+    real(spk_), intent(in)      :: d(:)
+    integer, intent(out)            :: info
+
+    Integer :: err_act
+    character(len=20)  :: name='s_scal'
+    logical, parameter :: debug=.false.
+
+    ! This is the base version. If we get here
+    ! it means the derived class is incomplete,
+    ! so we throw an error.
+    info = 700
+  end subroutine s_scal
+
+  function s_coo_get_nzeros(a) result(res)
+    implicit none 
+    class(s_coo_sparse_mat), intent(in) :: a
+    integer :: res
+    res  = a%nnz
+  end function s_coo_get_nzeros
+
+
+  subroutine s_coo_scal(d,a,info) 
+    use const_mod
+    implicit none 
+    class(s_coo_sparse_mat), intent(inout) :: a
+    real(spk_), intent(in)      :: d(:)
+    integer, intent(out)            :: info
+
+    Integer :: err_act,mnm, i, j, m
+    character(len=20)  :: name='scal'
+    logical, parameter :: debug=.false.
+    info  = 0
+    do i=1,a%get_nzeros()
+      j        = a%ia(i)
+      a%val(i) = a%val(i) * d(j)
+    enddo
+  end subroutine s_coo_scal
+
+  subroutine s_coo_scals(d,a,info) 
+    use const_mod
+    implicit none 
+    class(s_coo_sparse_mat), intent(inout) :: a
+    real(spk_), intent(in)      :: d
+    integer, intent(out)            :: info
+
+    Integer :: err_act,mnm, i, j, m
+    character(len=20)  :: name='scal'
+    logical, parameter :: debug=.false.
+
+    info  = 0
+    do i=1,a%get_nzeros()
+      a%val(i) = a%val(i) * d
+    enddo
+  end subroutine s_coo_scals
+end module s_base_mat_mod
+
+module s_mat_mod
+  use s_base_mat_mod
+  type :: s_sparse_mat
+    class(s_base_sparse_mat), pointer  :: a
+  contains
+    procedure, pass(a) :: s_scals
+    procedure, pass(a) :: s_scal
+    generic, public    :: scal => s_scals, s_scal 
+  end type s_sparse_mat
+  interface scal
+    module procedure s_scals, s_scal
+  end interface
+contains 
+  subroutine s_scal(d,a,info)
+    use const_mod
+    implicit none 
+    class(s_sparse_mat), intent(inout) :: a
+    real(spk_), intent(in)              :: d(:)
+    integer, intent(out)                    :: info
+    integer :: err_act
+    character(len=20)  :: name='csnmi'
+    logical, parameter :: debug=.false.
+    print *, "s_scal"
+    call a%a%scal(d,info)
+    return
+  end subroutine s_scal
+
+  subroutine s_scals(d,a,info)
+    use const_mod
+    implicit none 
+    class(s_sparse_mat), intent(inout) :: a
+    real(spk_), intent(in)              :: d
+    integer, intent(out)                    :: info
+    integer :: err_act
+    character(len=20)  :: name='csnmi'
+    logical, parameter :: debug=.false.
+!    print *, "s_scals"
+    info = 0
+    call a%a%scal(d,info)
+    return
+  end subroutine s_scals
+end module s_mat_mod
+
+    use s_mat_mod
+    class (s_sparse_mat), pointer :: a
+    type (s_sparse_mat), target :: b
+    type (s_base_sparse_mat), target :: c
+    integer info
+    b%a => c
+    a => b
+    call a%scal (1.0_spk_, info)
+    if (info .ne. 700) call abort
+end
+! { dg-final { cleanup-modules "const_mod base_mat_mod s_base_mat_mod s_mat_mod" } }
+
diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_6.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_6.f03
new file mode 100644
index 000000000..e2d880e0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_6.f03
@@ -0,0 +1,69 @@
+! { dg-do run }
+!
+! PR 42144: [OOP] deferred TBPs do not work
+!
+! Contributed by Damian Rouson <damian@rouson.net>
+
+module field_module
+  implicit none
+  private
+  public :: field
+  type ,abstract :: field 
+  end type
+end module
+
+module periodic_5th_order_module
+  use field_module ,only : field
+  implicit none
+  type ,extends(field) :: periodic_5th_order
+  end type
+end module
+
+module field_factory_module
+  implicit none
+  private
+  public :: field_factory
+  type, abstract :: field_factory 
+  contains 
+    procedure(create_interface), deferred :: create 
+  end type 
+  abstract interface 
+    function create_interface(this) 
+      use field_module ,only : field
+      import :: field_factory
+      class(field_factory), intent(in) :: this 
+      class(field) ,pointer :: create_interface
+    end function
+  end interface 
+end module
+
+module periodic_5th_factory_module
+  use field_factory_module , only : field_factory
+  implicit none
+  private
+  public :: periodic_5th_factory
+  type, extends(field_factory) :: periodic_5th_factory 
+  contains 
+    procedure :: create=>new_periodic_5th_order
+  end type 
+contains
+  function new_periodic_5th_order(this) 
+    use field_module ,only : field
+    use periodic_5th_order_module ,only : periodic_5th_order
+    class(periodic_5th_factory), intent(in) :: this
+    class(field) ,pointer :: new_periodic_5th_order
+  end function
+end module
+
+program main 
+  use field_module ,only : field 
+  use field_factory_module ,only : field_factory
+  use periodic_5th_factory_module ,only : periodic_5th_factory
+  implicit none 
+  class(field) ,pointer :: u
+  class(field_factory), allocatable :: field_creator 
+  allocate (periodic_5th_factory ::  field_creator) 
+  u => field_creator%create() 
+end program
+
+! { dg-final { cleanup-modules "field_module periodic_5th_order_module field_factory_module periodic_5th_factory_module" } }
diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_7.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_7.f03
new file mode 100644
index 000000000..3cd051047
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_7.f03
@@ -0,0 +1,61 @@
+! { dg-do run }
+! Test the fix for PR43291, which was a regression that caused
+! incorrect type mismatch errors at line 46. In the course of
+! fixing the PR, it was noted that the dynamic dispatch of the
+! final typebound call was not occurring - hence the dg-do run.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+!
+module m1
+  type :: t1
+  contains
+    procedure :: sizeof
+  end type
+contains
+  integer function sizeof(a)
+    class(t1) :: a
+    sizeof = 1
+  end function sizeof
+end module
+	
+module m2
+  use m1
+  type, extends(t1) :: t2
+  contains
+    procedure :: sizeof => sizeof2
+  end type
+contains
+  integer function sizeof2(a)
+    class(t2) :: a
+    sizeof2 = 2
+  end function
+end module
+
+module m3
+  use m2
+  type :: t3
+  class(t1), pointer :: a
+  contains
+    procedure :: sizeof => sizeof3
+  end type
+contains
+  integer function sizeof3(a)
+    class(t3) :: a
+    sizeof3 = a%a%sizeof()
+  end function
+end module
+
+  use m1
+  use m2
+  use m3
+  type(t1), target :: x
+  type(t2), target :: y
+  type(t3) :: z
+  z%a => x
+  if ((z%sizeof() .ne. 1) .or. (z%a%sizeof() .ne. 1)) call abort
+  z%a => y
+  if ((z%sizeof() .ne. 2) .or. (z%a%sizeof() .ne. 2)) call abort
+end
+
+! { dg-final { cleanup-modules "m1 m2 m3" } }
+ 	
diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_8.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_8.f03
new file mode 100644
index 000000000..4f3d8069b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_8.f03
@@ -0,0 +1,108 @@
+! { dg-do run }
+!
+! PR 41829: [OOP] Runtime error with dynamic dispatching.  Tests
+! dynamic dispatch in a case where the caller knows nothing about
+! the dynamic type at compile time.
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+!
+module foo_mod
+  type foo
+    integer :: i 
+  contains
+    procedure, pass(a) :: doit
+    procedure, pass(a) :: getit
+  end type foo
+
+  private doit,getit
+contains
+  subroutine  doit(a) 
+    class(foo) :: a
+    
+    a%i = 1
+!    write(*,*) 'FOO%DOIT base version'
+  end subroutine doit
+  function getit(a) result(res)
+    class(foo) :: a
+    integer :: res
+
+    res = a%i
+  end function getit
+
+end module foo_mod
+module foo2_mod
+  use foo_mod
+
+  type, extends(foo) :: foo2
+    integer :: j
+  contains
+    procedure, pass(a) :: doit  => doit2
+    procedure, pass(a) :: getit => getit2
+  end type foo2
+  
+  private doit2, getit2
+
+contains
+
+  subroutine  doit2(a) 
+    class(foo2) :: a
+    
+    a%i = 2
+    a%j = 3
+!    write(*,*) 'FOO2%DOIT derived version'
+  end subroutine doit2
+  function getit2(a) result(res)
+    class(foo2) :: a
+    integer :: res
+
+    res = a%j
+  end function getit2
+    
+end module foo2_mod
+
+module bar_mod 
+  use foo_mod
+  type bar 
+    class(foo), allocatable :: a
+  contains 
+    procedure, pass(a) :: doit
+    procedure, pass(a) :: getit
+  end type bar
+  private doit,getit
+  
+contains
+  subroutine doit(a)
+    class(bar) :: a
+    
+    call a%a%doit()
+  end subroutine doit
+  function getit(a) result(res)
+    class(bar) :: a
+    integer :: res
+
+    res = a%a%getit()
+  end function getit
+end module bar_mod
+
+
+program testd10
+  use foo_mod
+  use foo2_mod
+  use bar_mod
+  
+  type(bar) :: a
+
+  allocate(foo :: a%a)
+  call a%doit()
+!  write(*,*) 'Getit value : ', a%getit()
+  if (a%getit() .ne. 1) call abort
+  deallocate(a%a)
+  allocate(foo2 :: a%a)
+  call a%doit()
+!  write(*,*) 'Getit value : ', a%getit()
+  if (a%getit() .ne. 3) call abort
+
+end program testd10
+
+! { dg-final { cleanup-modules "foo_mod foo2_mod bar_mod" } }
+
diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_9.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_9.f03
new file mode 100644
index 000000000..bf6a3d558
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_9.f03
@@ -0,0 +1,54 @@
+! { dg-do run }
+!
+! [OOP] Ensure that different specifc interfaces are
+! handled properly by dynamic dispatch.
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+!
+module m
+
+ type :: t
+ contains
+  procedure :: a
+  generic :: gen => a
+ end type
+
+ type,extends(t) :: t2
+ contains
+  procedure :: b
+  generic :: gen => b
+ end type
+
+contains
+
+  real function a(ct,x)
+    class(t) :: ct
+    real :: x
+    a=2*x
+  end function
+
+  integer function b(ct,x)
+    class(t2) :: ct
+    integer :: x
+    b=3*x
+  end function
+
+end
+
+
+ use m
+ class(t), allocatable :: o1
+ type (t) :: t1
+ class(t2), allocatable :: o2
+
+ allocate(o1)
+ allocate(o2)
+
+ if (t1%gen(2.0) .ne. o1%gen(2.0)) call abort
+ if (t1%gen(2.0) .ne. o2%gen(2.0)) call abort
+ if (o2%gen(3) .ne. 9) call abort
+
+end
+
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/e_d_fmt.f90 b/gcc/testsuite/gfortran.dg/e_d_fmt.f90
new file mode 100644
index 000000000..f2a3a5fc5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/e_d_fmt.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! Verify that the D format uses 'D' as the exponent character.
+!   "     "    "  E   "     "   'E' "   "     "         " 
+CHARACTER*10 c1, c2
+REAL(kind=8) r
+r = 1.0
+write(c1,"(e9.2)") r
+write(c2,"(d9.2)") r
+
+if (trim(adjustl(c1)) .ne. "0.10E+01") call abort()
+if (trim(adjustl(c2)) .ne. "0.10D+01") call abort()
+
+END
diff --git a/gcc/testsuite/gfortran.dg/edit_real_1.f90 b/gcc/testsuite/gfortran.dg/edit_real_1.f90
new file mode 100644
index 000000000..3ac7cb477
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/edit_real_1.f90
@@ -0,0 +1,78 @@
+! { dg-do run }
+! Check real value edit descriptors
+! Also checks that rounding is performed correctly
+program edit_real_1
+  character(len=20) s
+  character(len=20) x
+  character(len=200) t
+  parameter (x = "xxxxxxxxxxxxxxxxxxxx")
+
+  ! W append a "z" onto each test to check the field is the correct width
+  s = x
+  ! G -> F format
+  write (s, '(G10.3,A)') 12.36, "z"
+  if (s .ne. "  12.4    z") call abort
+  s = x
+  ! G -> E format
+  write (s, '(G10.3,A)') -0.0012346, "z"
+  if (s .ne. "-0.123E-02z") call abort
+  s = x
+  ! Gw.eEe format
+  write (s, '(G10.3e1,a)') 12.34, "z"
+  if (s .ne. "   12.3   z") call abort
+  ! E format with excessive precision
+  write (t, '(E199.192,A)') 1.5, "z"
+  if ((t(1:7) .ne. " 0.1500") .or. (t(194:200) .ne. "00E+01z")) call abort
+  ! EN format
+  s = x
+  write (s, '(EN15.3,A)') 12873.6, "z"
+  if (s .ne. "     12.874E+03z") call abort
+  ! EN format, negative exponent
+  s = x
+  write (s, '(EN15.3,A)') 12.345e-6, "z"
+  if (s .ne. "     12.345E-06z") call abort
+  ! ES format
+  s = x
+  write (s, '(ES10.3,A)') 16.235, "z"
+  if (s .ne. " 1.624E+01z") call abort
+  ! F format, small number
+  s = x
+  write (s, '(F10.8,A)') 1.0e-20, "z"
+  if (s .ne. "0.00000000z") call abort
+  ! E format, very large number.
+  ! Used to overflow with positive scale factor
+  s = x
+  write (s, '(1PE10.3,A)') huge(0d0), "z"
+  ! The actual value is target specific, so just do a basic check
+  if ((s(1:1) .eq. "*") .or. (s(7:7) .ne. "+") .or. &
+      (s(11:11) .ne. "z")) call abort
+  ! F format, round up with carry to most significant digit.
+  s = x
+  write (s, '(F10.3,A)') 0.9999, "z"
+  if (s .ne. "     1.000z") call abort
+  ! F format, round up with carry to most significant digit < 0.1.
+  s = x
+  write (s, '(F10.3,A)') 0.0099, "z"
+  if (s .ne. "     0.010z") call abort
+  ! E format, round up with carry to most significant digit.
+  s = x
+  write (s, '(E10.3,A)') 0.9999, "z"
+  if (s .ne. " 0.100E+01z") call abort
+  ! EN format, round up with carry to most significant digit.
+  s = x
+  write (s, '(EN15.3,A)') 999.9999, "z"
+  if (s .ne. "      1.000E+03z") call abort
+  ! E format, positive scale factor
+  s = x
+  write (s, '(2PE10.4,A)') 1.2345, "z"
+  if (s .ne. '12.345E-01z') call abort
+  ! E format, negative scale factor
+  s = x
+  write (s, '(-2PE10.4,A)') 1.25, "z"
+  if (s .ne. '0.0013E+03z') call abort
+  ! E format, single digit precision
+  s = x
+  write (s, '(E10.1,A)') 1.1, "z"
+  if (s .ne. '   0.1E+01z') call abort
+end
+
diff --git a/gcc/testsuite/gfortran.dg/elemental_args_check_1.f90 b/gcc/testsuite/gfortran.dg/elemental_args_check_1.f90
new file mode 100644
index 000000000..caf4d177e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_args_check_1.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! PR fortran/33343
+!
+! Check conformance of array actual arguments to
+! elemental function.
+!
+! Contributed by Mikael Morin  <mikael.morin@tele2.fr>
+!
+      module geometry
+      implicit none
+      integer, parameter :: prec = 8
+      integer, parameter :: length = 10
+      contains
+      elemental function Mul(a, b)
+      real(kind=prec) :: a
+      real(kind=prec) :: b, Mul
+      intent(in)      :: a, b
+      Mul = a * b
+      end function Mul
+
+      pure subroutine calcdAcc2(vectors, angles)
+      real(kind=prec),      dimension(:)          :: vectors
+      real(kind=prec), dimension(size(vectors),2) :: angles
+      intent(in) :: vectors, angles
+      real(kind=prec), dimension(size(vectors)) :: ax
+      real(kind=prec), dimension(size(vectors),2) :: tmpAcc
+      tmpAcc(1,:) = Mul(angles(1,1:2),ax(1)) ! Ok
+      tmpAcc(:,1) = Mul(angles(:,1),ax)      ! OK
+      tmpAcc(:,:) = Mul(angles(:,:),ax) ! { dg-error "Incompatible ranks in elemental procedure" }
+      end subroutine calcdAcc2
+      end module geometry
diff --git a/gcc/testsuite/gfortran.dg/elemental_args_check_2.f90 b/gcc/testsuite/gfortran.dg/elemental_args_check_2.f90
new file mode 100644
index 000000000..e8b429305
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_args_check_2.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+!
+! PR fortran/34660
+!
+! Check for elemental constrain C1277 (F2003).
+! Contributed by Joost VandeVondele.
+!
+MODULE M1
+IMPLICIT NONE
+CONTAINS
+ PURE ELEMENTAL SUBROUTINE S1(I,F)
+   INTEGER, INTENT(IN) :: I
+   INTERFACE
+     PURE INTEGER FUNCTION F(I) ! { dg-error "Dummy procedure 'f' not allowed in elemental procedure" }
+      INTEGER, INTENT(IN) :: I
+     END FUNCTION F
+   END INTERFACE
+ END SUBROUTINE S1
+END MODULE M1
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/elemental_args_check_3.f90 b/gcc/testsuite/gfortran.dg/elemental_args_check_3.f90
new file mode 100644
index 000000000..77111f1c5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_args_check_3.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+
+! Check for constraints restricting arguments of ELEMENTAL procedures.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+
+CONTAINS
+
+  IMPURE ELEMENTAL SUBROUTINE foobar &
+    (a, & ! { dg-error "must be scalar" }
+     b, & ! { dg-error "POINTER attribute" }
+     c, & ! { dg-error "ALLOCATABLE attribute" }
+     d) ! { dg-error "INTENT specified" }
+    INTEGER, INTENT(IN) :: a(:)
+    INTEGER, POINTER, INTENT(IN) :: b
+    INTEGER, ALLOCATABLE, INTENT(IN) :: c
+    INTEGER :: d
+  END SUBROUTINE foobar
+
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/elemental_bind_c.f90 b/gcc/testsuite/gfortran.dg/elemental_bind_c.f90
new file mode 100644
index 000000000..f966d2b5f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_bind_c.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+!
+! PR fortran/33412
+!
+elemental subroutine a() bind(c) ! { dg-error "BIND.C. attribute conflicts with ELEMENTAL" }
+end subroutine a ! { dg-error "Expecting END PROGRAM" }
+
+elemental function b() bind(c) ! { dg-error "BIND.C. attribute conflicts with ELEMENTAL" }
+end function b ! { dg-error "Expecting END PROGRAM" }
+end
diff --git a/gcc/testsuite/gfortran.dg/elemental_dependency_1.f90 b/gcc/testsuite/gfortran.dg/elemental_dependency_1.f90
new file mode 100644
index 000000000..d76fad642
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_dependency_1.f90
@@ -0,0 +1,83 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/35681
+! Test the use of temporaries in case of elemental subroutines.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER, PARAMETER :: sz = 5
+  INTEGER :: i
+  INTEGER :: a(sz) = (/ (i, i=1,sz) /)
+  INTEGER :: b(sz)
+
+  b = a
+  CALL double(a(sz-b+1), a) ! { dg-warning "might interfere with actual" }
+  ! Don't check the result, as the above is invalid 
+  ! and might produce unexpected results (overlapping vector subscripts).
+
+
+  b = a
+  CALL double (a, a)               ! same range, no temporary
+  IF (ANY(a /= 2*b)) CALL abort
+
+
+  b = a
+  CALL double (a+1, a)             ! same range, no temporary
+  IF (ANY(a /= 2*b+2)) CALL abort 
+
+
+  b = a
+  CALL double ((a(1:sz)), a(1:sz)) ! same range, no temporary
+  IF (ANY(a /= 2*b)) CALL abort
+
+
+  b = a
+  CALL double(a(1:sz-1), a(2:sz)) ! { dg-warning "might interfere with actual" }
+  ! Don't check the result, as the above is invalid, 
+  ! and might produce unexpected results (arguments overlap). 
+
+
+  b = a
+  CALL double((a(1:sz-1)), a(2:sz))     ! paren expression, temporary created
+! { dg-final { scan-tree-dump-times "A\.16\\\[4\\\]" 1 "original" } }
+
+  IF (ANY(a /= (/ b(1), (2*b(i), i=1,sz-1) /))) CALL abort 
+
+
+  b = a
+  CALL double(a(1:sz-1)+1, a(2:sz))     ! op expression, temporary created
+! { dg-final { scan-tree-dump-times "A\.25\\\[4\\\]" 1 "original" } }
+
+  IF (ANY(a /= (/ b(1), (2*b(i)+2, i=1,sz-1) /))) CALL abort 
+
+
+  b = a
+  CALL double(self(a), a) ! same range, no temporary
+  IF (ANY(a /= 2*b)) CALL abort
+
+
+  b = a
+  CALL double(self(a(1:sz-1)), a(2:sz))  ! function expr, temporary created
+! { dg-final { scan-tree-dump-times "A\.37\\\[4\\\]" 1 "original" } }
+
+  IF (ANY(a /= (/ b(1), (2*b(i), i=1,sz-1) /))) CALL abort 
+
+
+CONTAINS
+  ELEMENTAL SUBROUTINE double(a, b)
+    IMPLICIT NONE
+    INTEGER, INTENT(IN) :: a
+    INTEGER, INTENT(OUT) :: b
+    b = 2 * a
+  END SUBROUTINE double
+  ELEMENTAL FUNCTION self(a)
+    IMPLICIT NONE
+    INTEGER, INTENT(IN) :: a
+    INTEGER :: self
+    self = a
+  END FUNCTION self
+END PROGRAM main
+
+! { dg-final { scan-tree-dump-times "_gfortran_internal_unpack" 3 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/elemental_dependency_2.f90 b/gcc/testsuite/gfortran.dg/elemental_dependency_2.f90
new file mode 100644
index 000000000..2282e8821
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_dependency_2.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+!
+! PR fortran/38487
+! Spurious warning on pointers as elemental subroutine actual arguments
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+
+module gfcbug82
+  implicit none
+  type t
+    real, pointer :: q(:) =>NULL()
+    real, pointer :: r(:) =>NULL()
+  end type t
+  type (t), save :: x, y
+  real, dimension(:), pointer, save :: a => NULL(), b => NULL()
+  real, save :: c(5), d
+contains
+  elemental subroutine add (q, r)
+    real, intent (inout) :: q
+    real, intent (in)    :: r
+    q = q + r
+  end subroutine add
+
+  subroutine foo ()
+      call add (y% q, x% r)
+      call add (y% q, b   )
+      call add (a   , x% r)
+      call add (a   , b   )
+      call add (y% q, d   )
+      call add (a   , d   )
+      call add (c   , x% r)
+      call add (c   , b   )
+  end subroutine foo
+end module gfcbug82
+
+! { dg-final { cleanup-modules "gfcbug82" } }
diff --git a/gcc/testsuite/gfortran.dg/elemental_dependency_3.f90 b/gcc/testsuite/gfortran.dg/elemental_dependency_3.f90
new file mode 100644
index 000000000..98cfd7be4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_dependency_3.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/38669
+! Temporary created for pointer as actual argument of an elemental subroutine
+!
+! Original testcase by Harald Anlauf <anlauf@gmx.de>
+
+program gfcbu84_main
+  implicit none
+  integer           :: jplev, k_lev
+  real :: p(42)
+  real, pointer :: q(:)
+  jplev = 42
+  k_lev = 1
+  allocate (q(jplev))
+  call tq_tvgh (q(k_lev:), p(k_lev:))
+  deallocate (q)
+
+  contains
+  elemental subroutine tq_tvgh (t, p)
+    real ,intent (out)            :: t
+    real ,intent (in)             :: p
+    t=p
+  end subroutine tq_tvgh
+end program gfcbu84_main
+! { dg-final { scan-tree-dump-times "atmp" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/elemental_initializer_1.f90 b/gcc/testsuite/gfortran.dg/elemental_initializer_1.f90
new file mode 100644
index 000000000..0e717c947
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_initializer_1.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! Tests the fix for elemental functions not being allowed in
+! specification expressions in pure procedures.
+!
+! Testcase from iso_varying_string by Rich Townsend <rhdt@star.ucl.ac.uk>
+! The allocatable component has been changed to a pointer for this testcase.
+!
+module iso_varying_string
+
+  type varying_string
+     private
+     character(LEN=1), dimension(:), pointer :: chars
+  end type varying_string
+
+  interface len
+     module procedure len_
+  end interface len
+
+contains
+
+  pure function char_auto (string) result (char_string)
+    type(varying_string), intent(in) :: string
+    character(LEN=len(string))       :: char_string ! Error was here
+    char_string = ""
+  end function char_auto
+
+  elemental function len_ (string) result (length)
+    type(varying_string), intent(in) :: string
+    integer                          :: length
+    length = 1
+  end function len_
+
+end module iso_varying_string
+
+! { dg-final { cleanup-modules "iso_varying_string" } }
diff --git a/gcc/testsuite/gfortran.dg/elemental_intrinsic_1.f03 b/gcc/testsuite/gfortran.dg/elemental_intrinsic_1.f03
new file mode 100644
index 000000000..8fdaa0fe9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_intrinsic_1.f03
@@ -0,0 +1,11 @@
+! { dg-do compile }
+
+! Conformance-checking of arguments was not done for intrinsic elemental
+! subroutines, check this works now.
+
+! This is the test from PR fortran/35681, comment #1 (second program).
+
+  integer, dimension(10) :: ILA1 = (/1,2,3,4,5,6,7,8,9,10/)
+  call mvbits ((ILA1((/9/))), 2, 4, ILA1, 3) ! { dg-error "Different shape" }
+  write (*,'(10(I3))') ila1
+  end 
diff --git a/gcc/testsuite/gfortran.dg/elemental_non_intrinsic_dummy_1.f90 b/gcc/testsuite/gfortran.dg/elemental_non_intrinsic_dummy_1.f90
new file mode 100644
index 000000000..207d76a4b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_non_intrinsic_dummy_1.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! Tests the fix for 20871, in which elemental non-intrinsic procedures were
+! permitted to be dummy arguments.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+MODULE TT
+CONTAINS
+   ELEMENTAL INTEGER FUNCTION two(N)
+     INTEGER, INTENT(IN) :: N
+     two=2**N
+   END FUNCTION
+END MODULE
+USE TT
+ INTEGER, EXTERNAL  :: SUB
+ write(6,*) SUB(two)    ! { dg-error "not allowed as an actual argument " }
+END
+INTEGER FUNCTION SUB(XX)
+  INTEGER :: XX
+  SUB=XX()
+END
+
+! { dg-final { cleanup-modules "TT" } }
diff --git a/gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90 b/gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90
new file mode 100644
index 000000000..ea17b5e34
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90
@@ -0,0 +1,53 @@
+! { dg-do compile }
+! { dg-options "-pedantic" }
+! Check the fix for PR20893, in which actual arguments could violate: 
+! "(5) If it is an array, it shall not be supplied as an actual argument to
+! an elemental procedure unless an array of the same rank is supplied as an
+! actual argument corresponding to a nonoptional dummy argument of that 
+! elemental procedure." (12.4.1.5)
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+  CALL T1(1,2)
+CONTAINS
+  SUBROUTINE T1(A1,A2,A3)
+    INTEGER           :: A1,A2, A4(2), A5(2)
+    INTEGER, OPTIONAL :: A3(2)
+    interface
+      elemental function efoo (B1,B2,B3) result(bar)
+        INTEGER, intent(in)           :: B1, B2
+        integer           :: bar
+        INTEGER, OPTIONAL, intent(in) :: B3
+      end function efoo
+    end interface
+
+! check an intrinsic function
+    write(6,*) MAX(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
+    write(6,*) MAX(A1,A3,A2)
+    write(6,*) MAX(A1,A4,A3)
+! check an internal elemental function
+    write(6,*) foo(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
+    write(6,*) foo(A1,A3,A2)
+    write(6,*) foo(A1,A4,A3)
+! check an external elemental function
+    write(6,*) efoo(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
+    write(6,*) efoo(A1,A3,A2)
+    write(6,*) efoo(A1,A4,A3)
+! check an elemental subroutine
+    call foobar (A5,A2,A4)
+    call foobar (A5,A4,A4)
+  END SUBROUTINE
+  elemental function foo (B1,B2,B3) result(bar)
+    INTEGER, intent(in)           :: B1, B2
+    integer           :: bar
+    INTEGER, OPTIONAL, intent(in) :: B3
+    bar = 1
+  end function foo
+  elemental subroutine foobar (B1,B2,B3)
+    INTEGER, intent(OUT)           :: B1
+    INTEGER, optional, intent(in)  :: B2, B3
+    B1 = 1
+  end subroutine foobar
+
+END
+
diff --git a/gcc/testsuite/gfortran.dg/elemental_pointer_1.f90 b/gcc/testsuite/gfortran.dg/elemental_pointer_1.f90
new file mode 100644
index 000000000..ae1826243
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_pointer_1.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! Tests the fix for pr20875.
+! Note 12.7.1 "For a function, the result shall be scalar and shall not have the POINTER attribute."
+MODULE Test
+CONTAINS
+  ELEMENTAL FUNCTION LL(I)
+    INTEGER, INTENT(IN) :: I
+    INTEGER :: LL
+    POINTER  :: LL ! { dg-error " POINTER attribute conflicts with ELEMENTAL attribute" }
+  END FUNCTION LL
+END MODULE Test
+
+! { dg-final { cleanup-modules "Test" } }
diff --git a/gcc/testsuite/gfortran.dg/elemental_result_1.f90 b/gcc/testsuite/gfortran.dg/elemental_result_1.f90
new file mode 100644
index 000000000..2a6dee00c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_result_1.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! Tests the fix for PR20874 in which array valued elemental
+! functions were permitted.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+MODULE Test
+CONTAINS
+  ELEMENTAL FUNCTION LL(I) ! { dg-error "must have a scalar result" }
+    INTEGER, INTENT(IN) :: I
+    INTEGER  :: LL(2)
+  END FUNCTION LL
+!
+! This was already OK.
+!
+  ELEMENTAL FUNCTION MM(I)
+    INTEGER, INTENT(IN) :: I
+    INTEGER, pointer  :: MM ! { dg-error "conflicts with ELEMENTAL" }
+  END FUNCTION MM
+END MODULE Test
+! { dg-final { cleanup-modules "Test" } }
diff --git a/gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f90 b/gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f90
new file mode 100644
index 000000000..d180bc931
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f90
@@ -0,0 +1,87 @@
+! { dg-do compile }
+! Test the fix for PR43843, in which the temporary for b(1) in
+! test_member was an indirect reference, rather then the value.
+!
+! Contributed by Kyle Horne <horne.kyle@gmail.com>
+! Reported by Tobias Burnus <burnus@gcc.gno.org>
+! Reported by Harald Anlauf <anlauf@gmx.de> (PR43841)
+!
+module polar_mod
+  implicit none
+  complex, parameter :: i = (0.0,1.0)
+  real, parameter :: pi = 3.14159265359
+  real, parameter :: e = exp (1.0)
+  type :: polar_t
+    real :: l, th
+  end type
+  type(polar_t) :: one = polar_t (1.0, 0)
+  interface operator(/)
+    module procedure div_pp
+  end interface
+  interface operator(.ne.)
+    module procedure ne_pp
+  end interface
+contains
+  elemental function div_pp(u,v) result(o)
+    type(polar_t), intent(in) :: u, v
+    type(polar_t) :: o
+    complex :: a, b, c
+    a = u%l*exp (i*u%th*pi)
+    b = v%l*exp (i*v%th*pi)
+    c = a/b
+    o%l = abs (c)
+    o%th = atan2 (imag (c), real (c))/pi
+  end function div_pp
+  elemental function ne_pp(u,v) result(o)
+    type(polar_t), intent(in) :: u, v
+    LOGICAL :: o
+    if (u%l .ne. v%l) then
+      o = .true.
+    else if (u%th .ne. v%th) then
+      o = .true.
+    else
+      o = .false.
+    end if
+  end function ne_pp
+end module polar_mod
+
+program main
+  use polar_mod
+  implicit none
+  call test_member
+  call test_other
+  call test_scalar
+  call test_real
+contains
+  subroutine test_member
+    type(polar_t), dimension(3) :: b
+    b = polar_t (2.0,0.5)
+    b(:) = b(:)/b(1)
+    if (any (b .ne. one)) call abort   
+  end subroutine test_member
+  subroutine test_other
+    type(polar_t), dimension(3) :: b
+    type(polar_t), dimension(3) :: c
+    b = polar_t (3.0,1.0)
+    c = polar_t (3.0,1.0)
+    b(:) = b(:)/c(1)
+    if (any (b .ne. one)) call abort   
+  end subroutine test_other
+  subroutine test_scalar
+    type(polar_t), dimension(3) :: b
+    type(polar_t) :: c
+    b = polar_t (4.0,1.5)
+    c = b(1)
+    b(:) = b(:)/c
+    if (any (b .ne. one)) call abort   
+  end subroutine test_scalar
+  subroutine test_real
+    real,dimension(3) :: b
+    real :: real_one
+    b = 2.0
+    real_one = b(2)/b(1)
+    b(:) = b(:)/b(1)
+    if (any (b .ne. real_one)) call abort   
+  end subroutine test_real
+end program main
+! { dg-final { cleanup-modules "polar_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/elemental_scalar_args_2.f90 b/gcc/testsuite/gfortran.dg/elemental_scalar_args_2.f90
new file mode 100644
index 000000000..c2b5df8d1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_scalar_args_2.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! Test the fix for PR55618, in which character scalar function arguments to
+! elemental functions would gain an extra indirect reference thus causing
+! failures in Vst17.f95, Vst 30.f95 and Vst31.f95 in the iso_varying_string
+! testsuite, where elemental tests are done.
+!
+! Reported by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+  integer, dimension (2) :: i = [1,2]
+  integer :: j = 64
+  character (len = 2) :: chr1 = "lm"
+  character (len = 1), dimension (2) :: chr2 = ["r", "s"]
+  if (any (foo (i, bar()) .ne. ["a", "b"])) call abort    ! This would fail
+  if (any (foo (i, "xy") .ne. ["x", "y"])) call abort     ! OK - not a function
+  if (any (foo (i, chr1) .ne. ["l", "m"])) call abort     ! ditto
+  if (any (foo (i, char (j)) .ne. ["A", "B"])) call abort ! This would fail
+  if (any (foo (i, chr2) .ne. ["s", "u"])) call abort     ! OK - not a scalar
+  if (any (foo (i, bar2()) .ne. ["e", "g"])) call abort   ! OK - not a scalar function
+contains
+  elemental character(len = 1) function foo (arg1, arg2)
+    integer, intent (in) :: arg1
+    character(len = *), intent (in) :: arg2
+    if (len (arg2) > 1) then
+      foo = arg2(arg1:arg1)
+    else
+      foo = char (ichar (arg2) + arg1)
+    end if
+  end function
+  character(len = 2) function bar ()
+    bar = "ab"
+  end function
+  function bar2 () result(res)
+    character (len = 1), dimension(2) :: res
+    res = ["d", "e"]
+  end function
+end
diff --git a/gcc/testsuite/gfortran.dg/elemental_subroutine_1.f90 b/gcc/testsuite/gfortran.dg/elemental_subroutine_1.f90
new file mode 100644
index 000000000..802d1ed20
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_subroutine_1.f90
@@ -0,0 +1,62 @@
+! { dg-do run }
+! Test the fix for pr22146, where and elemental subroutine with
+! array actual arguments would cause an ICE in gfc_conv_function_call.
+! The module is the original test case and the rest is a basic
+! functional test of the scalarization of the function call.
+!
+! Contributed by Erik Edelmann  <erik.edelmann@iki.fi>
+!             and Paul Thomas   <pault@gcc.gnu.org>
+
+  module pr22146
+
+contains
+
+    elemental subroutine foo(a)
+      integer, intent(out) :: a
+      a = 0
+    end subroutine foo
+
+    subroutine bar()
+      integer :: a(10)
+      call foo(a)
+    end subroutine bar
+
+end module pr22146
+
+  use pr22146
+  real, dimension (2)  :: x, y
+  real :: u, v
+  x = (/1.0, 2.0/)
+  u = 42.0
+
+  call bar ()
+
+! Check the various combinations of scalar and array.
+  call foobar (x, y)
+  if (any(y.ne.-x)) call abort ()
+
+  call foobar (u, y)
+  if (any(y.ne.-42.0)) call abort ()
+
+  call foobar (u, v)
+  if (v.ne.-42.0) call abort ()
+
+  v = 2.0
+  call foobar (v, x)
+  if (any(x /= -2.0)) call abort ()
+
+! Test an expression in the INTENT(IN) argument
+  x = (/1.0, 2.0/)
+  call foobar (cos (x) + u, y)
+  if (any(abs (y + cos (x) + u) .gt. 4.0e-6)) call abort ()
+
+contains
+
+  elemental subroutine foobar (a, b)
+    real, intent(IN) :: a
+    real, intent(out) :: b
+    b = -a
+  end subroutine foobar
+end
+
+! { dg-final { cleanup-modules "pr22146" } }
diff --git a/gcc/testsuite/gfortran.dg/elemental_subroutine_2.f90 b/gcc/testsuite/gfortran.dg/elemental_subroutine_2.f90
new file mode 100644
index 000000000..e95831186
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_subroutine_2.f90
@@ -0,0 +1,66 @@
+! { dg-do run }
+! Test the fix for pr22146, where and elemental subroutine with
+! array actual arguments would cause an ICE in gfc_conv_function_call.
+! This test checks that the main uses for elemental subroutines work
+! correctly; namely, as module procedures and as procedures called
+! from elemental functions. The compiler would ICE on the former with
+! the first version of the patch.
+!
+! Contributed by Paul Thomas   <pault@gcc.gnu.org>
+
+module type
+  type itype
+    integer :: i
+    character(1) :: ch
+  end type itype
+end module type
+
+module assign
+  interface assignment (=)
+    module procedure itype_to_int
+  end interface
+contains
+  elemental subroutine itype_to_int (i, it)
+    use type
+    type(itype), intent(in) :: it
+    integer, intent(out) :: i
+    i = it%i
+  end subroutine itype_to_int
+
+  elemental function i_from_itype (it) result (i)
+    use type
+    type(itype), intent(in) :: it
+    integer :: i
+    i = it
+  end function i_from_itype
+
+end module assign
+
+program test_assign
+  use type
+  use assign
+  type(itype) :: x(2, 2)
+  integer :: i(2, 2)
+
+! Test an elemental subroutine call from an elementary function.
+  x = reshape ((/(itype (j, "a"), j = 1,4)/), (/2,2/))
+  forall (j = 1:2, k = 1:2)
+    i(j, k) = i_from_itype (x (j, k))
+  end forall
+  if (any(reshape (i, (/4/)).ne.(/1,2,3,4/))) call abort ()
+
+! Check the interface assignment (not part of the patch).
+  x = reshape ((/(itype (j**2, "b"), j = 1,4)/), (/2,2/))
+  i = x
+  if (any(reshape (i, (/4/)).ne.(/1,4,9,16/))) call abort ()
+
+! Use the interface assignment within a forall block.
+  x = reshape ((/(itype (j**3, "c"), j = 1,4)/), (/2,2/))
+  forall (j = 1:2, k = 1:2)
+    i(j, k) = x (j, k)
+  end forall
+  if (any(reshape (i, (/4/)).ne.(/1,8,27,64/))) call abort ()
+
+end program test_assign
+
+! { dg-final { cleanup-modules "type assign" } }
diff --git a/gcc/testsuite/gfortran.dg/elemental_subroutine_3.f90 b/gcc/testsuite/gfortran.dg/elemental_subroutine_3.f90
new file mode 100644
index 000000000..1f93cd4a2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_subroutine_3.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+! Test the fix for PR25746, in which dependency checking was not being
+! done for elemental subroutines and therefore for interface assignments.
+!
+! This test is based on
+! http://home.comcast.net/~kmbtib/Fortran_stuff/elem_assign.f90
+! as reported by Harald Anlauf <anlauf@gmx.de> in the PR.
+! 
+module elem_assign
+   implicit none
+   type mytype
+      integer x
+   end type mytype
+   interface assignment(=)
+      module procedure myassign
+   end interface assignment(=)
+   contains
+      elemental subroutine myassign(x,y)
+         type(mytype), intent(out) :: x
+         type(mytype), intent(in) :: y
+! Multiply the components by 2 to verify that this is being called.
+         x%x = y%x*2
+      end subroutine myassign
+end module elem_assign
+
+program test
+   use elem_assign
+   implicit none
+   type(mytype) :: y(6), x(6) = (/mytype(1),mytype(20),mytype(300),&
+                                  mytype(4000),mytype(50000),&
+                                  mytype(1000000)/)
+   type(mytype) :: z(2, 3)
+! The original case - dependency between lhs and rhs. 
+   x = x((/2,3,1,4,5,6/))
+   if (any(x%x .ne. (/40, 600, 2, 8000, 100000, 2000000/))) call abort ()
+! Slightly more elborate case with non-trivial array ref on lhs.
+   x(4:1:-1) = x((/1,3,2,4/))
+   if (any(x%x .ne. (/16000, 1200, 4, 80, 100000, 2000000/))) call abort ()
+! Check that no-dependence case works....
+   y = x
+   if (any(y%x .ne. (/32000, 2400, 8, 160, 200000, 4000000/))) call abort ()
+! ...and now a case that caused headaches during the preparation of the patch
+   x(2:5) = x(1:4)
+   if (any(x%x .ne. (/16000, 32000, 2400, 8, 160, 2000000/))) call abort ()
+! Check offsets are done correctly in multi-dimensional cases
+   z = reshape (x, (/2,3/))
+   z(:, 3:2:-1) = z(:, 1:2)
+   y = reshape (z, (/6/))
+   if (any(y%x .ne. (/ 64000, 128000, 19200, 64, 128000, 256000/))) call abort ()
+end program test
+
+! { dg-final { cleanup-modules "elem_assign" } }
+
diff --git a/gcc/testsuite/gfortran.dg/elemental_subroutine_4.f90 b/gcc/testsuite/gfortran.dg/elemental_subroutine_4.f90
new file mode 100644
index 000000000..9d2bc492f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_subroutine_4.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! Test the fix for PR25099, in which conformance checking was not being
+! done for elemental subroutines and therefore for interface assignments.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+module elem_assign
+   implicit none
+   type mytype
+      integer x
+   end type mytype
+   interface assignment(=)
+      module procedure myassign
+   end interface assignment(=)
+   contains
+      elemental subroutine myassign(x,y)
+         type(mytype), intent(out) :: x
+         type(mytype), intent(in) :: y
+         x%x = y%x
+      end subroutine myassign
+end module elem_assign
+
+   use elem_assign
+   integer :: I(2,2),J(2)
+   type (mytype) :: w(2,2), x(4), y(5), z(4)
+! The original PR
+   CALL S(I,J) ! { dg-error "Incompatible ranks in elemental procedure" }
+! Check interface assignments
+   x = w       ! { dg-error "Incompatible ranks in elemental procedure" }
+   x = y       ! { dg-error "Different shape for elemental procedure" }
+   x = z
+CONTAINS
+   ELEMENTAL SUBROUTINE S(I,J)
+     INTEGER, INTENT(IN) :: I,J
+   END SUBROUTINE S
+END
+
+! { dg-final { cleanup-modules "elem_assign" } }
diff --git a/gcc/testsuite/gfortran.dg/elemental_subroutine_5.f90 b/gcc/testsuite/gfortran.dg/elemental_subroutine_5.f90
new file mode 100644
index 000000000..efadb6d14
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_subroutine_5.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+!
+! PR fortran/33231
+!
+! Elemental function:
+! Intent OUT/INOUT dummy: Actual needs to be an array
+! if any actual is an array
+!
+program prog
+implicit none
+integer :: i, j(2)
+call sub(i,1,2) ! OK, only scalar
+call sub(j,1,2) ! OK, scalar IN, array OUT
+call sub(j,[1,2],3) ! OK, scalar & array IN, array OUT
+call sub(j,[1,2],[1,2]) ! OK, all arrays
+
+call sub(i,1,2) ! OK, only scalar
+call sub(i,[1,2],3) ! { dg-error "is a scalar" }
+call sub(i,[1,2],[1,2]) ! { dg-error "is a scalar" }
+contains
+elemental subroutine sub(a,b,c)
+  integer :: func, a, b, c
+  intent(in) :: b,c
+  intent(out) :: a
+  a = b +c
+end subroutine sub
+end program prog
diff --git a/gcc/testsuite/gfortran.dg/elemental_subroutine_6.f90 b/gcc/testsuite/gfortran.dg/elemental_subroutine_6.f90
new file mode 100644
index 000000000..44577c888
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_subroutine_6.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! PR35184 ICE in gfc_conv_array_index_offset
+MODULE foo
+  TYPE, PUBLIC :: bar
+    PRIVATE
+      REAL :: value
+  END TYPE bar
+  INTERFACE ASSIGNMENT (=)
+    MODULE PROCEDURE assign_bar
+  END INTERFACE ASSIGNMENT (=)
+CONTAINS
+  ELEMENTAL SUBROUTINE assign_bar (to, from)
+    TYPE(bar), INTENT(OUT) :: to
+    TYPE(bar), INTENT(IN) :: from
+    to%value= from%value
+  END SUBROUTINE
+  SUBROUTINE my_sub (in, out)
+    IMPLICIT NONE
+    TYPE(bar), DIMENSION(:,:), POINTER :: in
+    TYPE(bar), DIMENSION(:,:), POINTER :: out
+    ALLOCATE( out(1:42, 1:42) )
+    out(1, 1:42) = in(1, 1:42)
+  END SUBROUTINE
+END MODULE foo
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/elemental_subroutine_7.f90 b/gcc/testsuite/gfortran.dg/elemental_subroutine_7.f90
new file mode 100644
index 000000000..7c7875bbf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_subroutine_7.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+!
+! PR fortran/38669
+! Loop bounds temporaries used before being defined for elemental subroutines
+!
+! Original testcase by Harald Anlauf <anlauf@gmx.de>
+
+program gfcbu84_main
+  implicit none
+  integer           :: jplev, k_lev
+  integer :: p(42)
+  real    :: r(42)
+  integer, pointer :: q(:)
+  jplev = 42
+  k_lev = 1
+  call random_number (r)
+  p = 41 * r + 1
+  allocate (q(jplev))
+
+  q = 0
+  call tq_tvgh (q(k_lev:), p(k_lev:))
+  if (any (p /= q)) call abort
+
+  q = 0
+  call tq_tvgh (q(k_lev:), (p(k_lev:)))
+  if (any (p /= q)) call abort
+
+  q = 0
+  call tq_tvgh (q(k_lev:), (p(p(k_lev:))))
+  if (any (p(p) /= q)) call abort
+
+  deallocate (q)
+
+  contains
+  elemental subroutine tq_tvgh (t, p)
+    integer ,intent (out)            :: t
+    integer ,intent (in)             :: p
+    t=p
+  end subroutine tq_tvgh
+end program gfcbu84_main
diff --git a/gcc/testsuite/gfortran.dg/empty_derived_type.f90 b/gcc/testsuite/gfortran.dg/empty_derived_type.f90
new file mode 100644
index 000000000..6bf616c2c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/empty_derived_type.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+module stuff
+   implicit none
+   type, bind(C) :: junk ! { dg-warning "may be inaccessible by the C companion" }
+      ! Empty!
+   end type junk
+end module stuff 
diff --git a/gcc/testsuite/gfortran.dg/empty_format_1.f90 b/gcc/testsuite/gfortran.dg/empty_format_1.f90
new file mode 100644
index 000000000..ad60afa3f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/empty_format_1.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR 17709
+! We weren't resetting the internal EOR flag correctly, so the second read
+! wasn't advancing to the next line.
+program main
+  integer io_unit
+  character*20 str
+  io_unit = 10
+  open (unit=io_unit,status='scratch',form='formatted')
+  write (io_unit, '(A)') "Line1"
+  write (io_unit, '(A)') "Line2"
+  write (io_unit, '(A)') "Line3"
+  rewind (io_unit)
+  read (io_unit,'(A)') str
+  if (str .ne. "Line1") call abort
+  read (io_unit,'()')
+  read (io_unit,'(A)') str
+  if (str .ne. "Line3") call abort
+  close(unit=io_unit)
+end
+
diff --git a/gcc/testsuite/gfortran.dg/empty_function_1.f90 b/gcc/testsuite/gfortran.dg/empty_function_1.f90
new file mode 100644
index 000000000..1556a5090
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/empty_function_1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+!
+! PR fortran/38252
+! FUNCTION rejected if both specification and execution part are empty
+!
+! Contributed by Daniel Kraft <d@domob.eu>
+
+INTEGER FUNCTION test ()
+CONTAINS
+END FUNCTION test
diff --git a/gcc/testsuite/gfortran.dg/empty_label.f b/gcc/testsuite/gfortran.dg/empty_label.f
new file mode 100644
index 000000000..446fe8b13
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/empty_label.f
@@ -0,0 +1,5 @@
+C { dg-do compile }
+C { dg-options "-Werror -fmax-errors=1" }
+100   ! { dg-warning "empty statement" }
+      end
+C { dg-error "count reached limit" "" { target *-*-* } 0 }
diff --git a/gcc/testsuite/gfortran.dg/empty_label.f90 b/gcc/testsuite/gfortran.dg/empty_label.f90
new file mode 100644
index 000000000..6300d3079
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/empty_label.f90
@@ -0,0 +1,5 @@
+! { dg-do compile }
+! { dg-options "-Werror -fmax-errors=1" }
+100   ! { dg-warning "empty statement" }
+end
+! { dg-error "count reached limit" "" { target *-*-* } 0 }
diff --git a/gcc/testsuite/gfortran.dg/empty_type.f90 b/gcc/testsuite/gfortran.dg/empty_type.f90
new file mode 100644
index 000000000..cea25660d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/empty_type.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! PR fortran/34202
+! ICE on contruction of empty types
+! Testcase contributed by Tobias Burnus
+
+program bug4a
+  implicit none
+  type bug4
+    ! Intentionally left empty
+  end type bug4
+
+  type compound
+    type(bug4) b
+  end type compound
+
+  type(bug4), parameter :: f = bug4()
+  type(compound), parameter :: g = compound(bug4())
+end program bug4a
+
diff --git a/gcc/testsuite/gfortran.dg/end_subroutine_1.f90 b/gcc/testsuite/gfortran.dg/end_subroutine_1.f90
new file mode 100644
index 000000000..b42f95054
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/end_subroutine_1.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
+interface
+  subroutine foo()
+  end 
+  integer function bar()
+  end 
+end interface
+contains
+  subroutine test()
+  end
+  integer function f()
+    f = 42
+  end
+end
diff --git a/gcc/testsuite/gfortran.dg/end_subroutine_2.f90 b/gcc/testsuite/gfortran.dg/end_subroutine_2.f90
new file mode 100644
index 000000000..8f2e3d10a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/end_subroutine_2.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+program main
+interface
+  subroutine foo()
+  end 
+  integer function bar()
+  end 
+end interface
+contains
+  subroutine test()
+  end ! { dg-error "Fortran 2008: END statement instead of END SUBROUTINE" }
+  end subroutine  ! To silence successive errors
+end program
+
+subroutine test2()
+contains
+  integer function f()
+    f = 42
+  end ! { dg-error "Fortran 2008: END statement instead of END FUNCTION" }
+  end function  ! To silence successive errors
+end subroutine test2
+
diff --git a/gcc/testsuite/gfortran.dg/endfile.f b/gcc/testsuite/gfortran.dg/endfile.f
new file mode 100644
index 000000000..6ece5459f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/endfile.f
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR25550 file data corrupted after reading end of file.
+! Derived from example given in PR from Dale Ranta.
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org> 
+      integer data
+      data=-1
+      open(unit=11,status='scratch',form='unformatted')
+      write(11)data
+      read(11,end=1000 )data
+      call abort()
+ 1000 continue
+      rewind (11)
+      read(11)data
+ 1001 continue
+      if(data.ne.-1) call abort
+      end
+
+
diff --git a/gcc/testsuite/gfortran.dg/endfile.f90 b/gcc/testsuite/gfortran.dg/endfile.f90
new file mode 100644
index 000000000..60875ce23
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/endfile.f90
@@ -0,0 +1,31 @@
+! { dg-do run { target fd_truncate } } 
+! pr18364 endfile does not truncate file.
+!   write out 20 records
+!   rewind
+!   read 10 records
+!   endfile
+!   close file
+!   open file
+!   detect file has only 10 records  
+      implicit none
+      integer i,j
+      open(unit=10,file='test.dat',access='sequential',status='replace')
+      do i=1, 20
+        write (10,'(I4)') i
+      end do
+      rewind(10)
+      do i=1,10
+        read (10,'(I4)') j
+      end do
+      endfile(10)
+      close(10)
+      open(unit=10,file='test.dat',access='sequential',status='old')
+      do i=1,20 
+        read (10,'(I4)',end=99) j 
+      end do
+      ! should never get here
+      call abort
+  99  continue ! end of file
+      if (j.ne.10) call abort   
+      close(10,status='delete')
+      end
diff --git a/gcc/testsuite/gfortran.dg/endfile_2.f90 b/gcc/testsuite/gfortran.dg/endfile_2.f90
new file mode 100644
index 000000000..e91e80eb2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/endfile_2.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! pr18778 abort on endfile without opening unit 
+      program test
+      implicit none
+      integer i
+      endfile(8)
+      rewind(8)
+      read(8,end=0023)i
+      call abort ! should never get here
+      stop
+ 0023 continue
+      close(8,status='delete')
+      end
diff --git a/gcc/testsuite/gfortran.dg/endfile_3.f90 b/gcc/testsuite/gfortran.dg/endfile_3.f90
new file mode 100644
index 000000000..0c413145c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/endfile_3.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! pr44477 READ/WRITE not allowed after ENDFILE 
+!-------------------------------------------
+  open(10, form='formatted', &
+    action='write', position='rewind', status="scratch")
+  endfile(10)
+  write(10,'(a)') "aa" ! { dg-shouldfail "Cannot perform ENDFILE" }
+end
+
diff --git a/gcc/testsuite/gfortran.dg/endfile_4.f90 b/gcc/testsuite/gfortran.dg/endfile_4.f90
new file mode 100644
index 000000000..a2462c9f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/endfile_4.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+! pr44477 ENDFILE not allowed after ENDFILE
+!-------------------------------------------
+  open(10, form='formatted', &
+    action='write', position='rewind', status="scratch")
+  endfile(10)
+  endfile(10) ! { dg-shouldfail "Cannot perform ENDFILE" }
+end
diff --git a/gcc/testsuite/gfortran.dg/entry_1.f90 b/gcc/testsuite/gfortran.dg/entry_1.f90
new file mode 100644
index 000000000..c9048a044
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_1.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! Test alternate entry points in a module procedure
+! Also check that references to sibling entry points are resolved correctly.
+module m
+contains
+subroutine indirecta (p)
+  call p (3, 4)
+end subroutine
+subroutine indirectb (p)
+  call p (5)
+end subroutine
+
+subroutine test1
+  implicit none
+  call indirecta (foo)
+  call indirectb (bar)
+end subroutine
+
+subroutine foo(a, b)
+  integer a, b
+  logical, save :: was_foo = .false.
+  if ((a .ne. 3) .or. (b .ne. 4)) call abort
+  was_foo = .true.
+entry bar(a)
+  if (was_foo) then
+    if ((a .ne. 3) .or. (b .ne. 4)) call abort
+  else
+    if (a .ne. 5) call abort
+  end if
+  was_foo = .false.
+end subroutine
+
+subroutine test2
+  call foo (3, 4)
+  call bar (5)
+end subroutine
+end module
+
+program p
+  use m
+  call foo (3, 4)
+  call bar (5)
+  call test1 ()
+  call test2 ()
+end program
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/entry_10.f90 b/gcc/testsuite/gfortran.dg/entry_10.f90
new file mode 100644
index 000000000..154d44ea9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_10.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! Test fix for PR31474, in which the use of ENTRYs as module
+! procedures in a generic interface would cause an internal error.
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+!
+module a
+  interface b
+    module procedure c, d
+  end interface
+contains
+  real function d (i)
+    real c, i
+    integer j
+    d = 1.0
+    return
+  entry c (j)
+    d = 2.0
+  end function
+  real function e (i)
+    real f, i
+    integer j
+    e = 3.0
+    return
+  entry f (j)
+    e = 4.0
+  end function
+end module
+
+  use a
+  if (b (1.0) .ne. 1.0) call abort ()
+  if (b (1  ) .ne. 2.0) call abort ()
+  if (e (1.0) .ne. 3.0) call abort ()
+  if (f (1  ) .ne. 4.0) call abort ()
+end
+! { dg-final { cleanup-modules "a" } }
diff --git a/gcc/testsuite/gfortran.dg/entry_11.f90 b/gcc/testsuite/gfortran.dg/entry_11.f90
new file mode 100644
index 000000000..07e7c3413
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_11.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! PR31609 module that calls a contained function with an ENTRY point
+! Test case derived from the PR
+
+MODULE ksbin1_aux_mod
+  CONTAINS
+    SUBROUTINE sub
+    i = k()
+    END SUBROUTINE sub
+    FUNCTION j () 
+      print *, "in j"    
+    j = 111 
+    ENTRY k () 
+      print *, "in k"    
+    k = 222
+    END FUNCTION j
+END MODULE ksbin1_aux_mod
+
+program testit
+  use ksbin1_aux_mod
+  l = j()
+  print *, l
+  l = k()
+  print *, l
+end program testit
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/entry_12.f90 b/gcc/testsuite/gfortran.dg/entry_12.f90
new file mode 100644
index 000000000..5513697a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_12.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! Tests the fix for pr31609, where module procedure entries found
+! themselves in the wrong namespace.  This test checks that all
+! combinations of generic and specific calls work correctly.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org> as comment #8 to the pr.
+!
+MODULE ksbin1_aux_mod
+  interface foo
+    module procedure j
+  end interface
+  interface bar
+    module procedure k
+  end interface
+  interface foobar
+    module procedure j, k
+  end interface
+  CONTAINS
+    FUNCTION j () 
+    j = 1
+    return
+    ENTRY k (i) 
+    k = 2
+    END FUNCTION j
+END MODULE ksbin1_aux_mod
+
+    use ksbin1_aux_mod
+    if (any ((/foo (), bar (99), foobar (), foobar (99), j (), k (99)/) .ne. &
+             (/1, 2, 1, 2, 1, 2/))) Call abort ()
+end
+! { dg-final { cleanup-modules "ksbin1_aux_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/entry_13.f90 b/gcc/testsuite/gfortran.dg/entry_13.f90
new file mode 100644
index 000000000..3a45fc5ea
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_13.f90
@@ -0,0 +1,80 @@
+! { dg-do run }
+! Tests the fix for pr31214, in which the typespec for the entry would be lost,
+! thereby causing the function to be disallowed, since the function and entry
+! types did not match.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+module type_mod
+  implicit none
+
+  type x
+     real x
+  end type x
+  type y
+     real x
+  end type y
+  type z
+     real x
+  end type z
+
+  interface assignment(=)
+     module procedure equals
+  end interface assignment(=)
+
+  interface operator(//)
+     module procedure a_op_b, b_op_a
+  end interface operator(//)
+
+  interface operator(==)
+     module procedure a_po_b, b_po_a
+  end interface operator(==)
+
+  contains
+     subroutine equals(x,y)
+        type(z), intent(in) :: y
+        type(z), intent(out) :: x
+
+        x%x = y%x
+     end subroutine equals
+
+     function a_op_b(a,b)
+        type(x), intent(in) :: a
+        type(y), intent(in) :: b
+        type(z) a_op_b
+        type(z) b_op_a
+        a_op_b%x = a%x + b%x
+        return
+     entry b_op_a(b,a)
+        b_op_a%x = a%x - b%x
+     end function a_op_b
+
+     function a_po_b(a,b)
+        type(x), intent(in) :: a
+        type(y), intent(in) :: b
+        type(z) a_po_b
+        type(z) b_po_a
+     entry b_po_a(b,a)
+        a_po_b%x = a%x/b%x
+     end function a_po_b
+end module type_mod
+
+program test
+  use type_mod
+  implicit none
+  type(x) :: x1 = x(19.0_4)
+  type(y) :: y1 = y(7.0_4)
+  type(z) z1
+
+  z1 = x1//y1
+  if (abs(z1%x - (19.0_4 + 7.0_4)) > epsilon(x1%x)) call abort ()
+  z1 = y1//x1
+  if (abs(z1%x - (19.0_4 - 7.0_4)) > epsilon(x1%x)) call abort ()
+
+  z1 = x1==y1
+  if (abs(z1%x - 19.0_4/7.0_4) > epsilon(x1%x)) call abort ()
+  z1 = y1==x1
+  if (abs(z1%x - 19.0_4/7.0_4) > epsilon(x1%x)) call abort ()
+end program test
+! { dg-final { cleanup-modules "type_mod" } }
+
diff --git a/gcc/testsuite/gfortran.dg/entry_14.f90 b/gcc/testsuite/gfortran.dg/entry_14.f90
new file mode 100644
index 000000000..e0aa00078
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_14.f90
@@ -0,0 +1,103 @@
+! { dg-do run }
+! 
+! PR fortran/34137
+!
+! Entry was previously not possible in a module.
+! Checks also whether the different result combinations
+! work properly.
+!
+module m1
+  implicit none
+contains
+function func(a)
+  implicit none
+  integer :: a, func
+  real :: ent
+  func = a*4
+  return
+entry ent(a)
+  ent = -a*2.0
+  return
+end function func
+end module m1
+
+module m2
+  implicit none
+contains
+function func(a)
+  implicit none
+  integer :: a, func
+  real :: func2
+  func = a*8
+  return
+entry ent(a) result(func2)
+  func2 = -a*4.0
+  return
+end function func
+end module m2
+
+module m3
+  implicit none
+contains
+function func(a) result(res)
+  implicit none
+  integer :: a, res
+  real :: func2
+  res = a*12
+  return
+entry ent(a) result(func2)
+  func2 = -a*6.0
+  return
+end function func
+end module m3
+
+
+module m4
+  implicit none
+contains
+function func(a) result(res)
+  implicit none
+  integer :: a, res
+  real :: ent
+  res = a*16
+  return
+entry ent(a)
+  ent = -a*8.0
+  return
+end function func
+end module m4
+
+program main
+  implicit none
+  call test1()
+  call test2()
+  call test3()
+  call test4()
+contains
+  subroutine test1()
+    use m1
+    implicit none
+    if(func(3) /= 12) call abort()
+    if(abs(ent(7) + 14.0) > tiny(1.0)) call abort()
+  end subroutine test1
+  subroutine test2()
+    use m2
+    implicit none
+    if(func(9) /= 72) call abort()
+    if(abs(ent(11) + 44.0) > tiny(1.0)) call abort()
+  end subroutine test2
+  subroutine test3()
+    use m3
+    implicit none
+    if(func(13) /= 156) call abort()
+    if(abs(ent(17) + 102.0) > tiny(1.0)) call abort()
+  end subroutine test3
+  subroutine test4()
+    use m4
+    implicit none
+    if(func(23) /= 368) call abort()
+    if(abs(ent(27) + 216.0) > tiny(1.0)) call abort()
+  end subroutine test4
+end program main
+
+! { dg-final { cleanup-modules "m1 m2 m3 m4" } }
diff --git a/gcc/testsuite/gfortran.dg/entry_15.f90 b/gcc/testsuite/gfortran.dg/entry_15.f90
new file mode 100644
index 000000000..0449695e7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_15.f90
@@ -0,0 +1,37 @@
+! { dg-do compile }
+! 
+! PR fortran/34137
+!
+! Entry was previously not possible in a module.
+! Checks also whether the different result combinations
+! work properly.
+!
+module m2
+  implicit none
+contains
+function func(a)
+  implicit none
+  integer :: a, func
+  real :: func2
+  func = a*8
+  return
+entry ent(a) result(func2)
+  ent = -a*4.0 ! { dg-error "is not a variable" }
+  return
+end function func
+end module m2
+
+module m3
+  implicit none
+contains
+function func(a) result(res)
+  implicit none
+  integer :: a, res
+  real :: func2
+  res = a*12
+  return
+entry ent(a) result(func2)
+  ent = -a*6.0 ! { dg-error "is not a variable" }
+  return
+end function func
+end module m3
diff --git a/gcc/testsuite/gfortran.dg/entry_16.f90 b/gcc/testsuite/gfortran.dg/entry_16.f90
new file mode 100644
index 000000000..384d99fd7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_16.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+! Tests the fix for PR33499 in which the ENTRY cx_radc was not
+! getting its TYPE.
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+!
+MODULE complex
+  IMPLICIT NONE
+  PRIVATE
+  PUBLIC :: cx, OPERATOR(+), OPERATOR(.eq.)
+  TYPE cx
+    integer :: re
+    integer :: im
+  END TYPE cx
+  INTERFACE OPERATOR (+)
+    MODULE PROCEDURE cx_cadr, cx_radc
+  END INTERFACE
+  INTERFACE OPERATOR (.eq.)
+    MODULE PROCEDURE cx_eq
+  END INTERFACE
+  CONTAINS
+  FUNCTION cx_cadr(z, r)
+  ENTRY cx_radc(r, z)
+    TYPE (cx) :: cx_cadr, cx_radc
+    TYPE (cx), INTENT(IN) :: z
+    integer, INTENT(IN) :: r
+    cx_cadr%re = z%re + r
+    cx_cadr%im = z%im
+  END FUNCTION cx_cadr
+  FUNCTION cx_eq(u, v)
+    TYPE (cx), INTENT(IN) :: u, v
+    logical :: cx_eq
+    cx_eq = (u%re .eq. v%re) .and. (u%im .eq. v%im)
+  END FUNCTION cx_eq
+END MODULE complex
+
+  use complex
+  type(cx) :: a = cx (1, 2), c, d
+  logical :: f
+  integer :: b = 3
+  if (.not.((a + b) .eq. (b + a))) call abort ()
+  if (.not.((a + b) .eq. cx (4, 2))) call abort ()
+end
+! { dg-final { cleanup-modules "complex" } }
diff --git a/gcc/testsuite/gfortran.dg/entry_17.f90 b/gcc/testsuite/gfortran.dg/entry_17.f90
new file mode 100644
index 000000000..5671cfe50
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_17.f90
@@ -0,0 +1,55 @@
+function test1(n)
+  integer  :: n
+  character(n) :: test1
+  character(n) :: bar1
+  test1 = ""
+  return
+entry bar1()
+  bar1 = ""
+end function test1
+
+function test2()
+  character(1) :: test2
+  character(1) :: bar2
+  test2 = ""
+  return
+entry bar2()
+  bar2 = ""
+end function test2
+
+function test3() ! { dg-warning "Obsolescent feature" }
+  character(*) :: test3
+  character(*) :: bar3 ! { dg-warning "Obsolescent feature" }
+  test3 = ""
+  return
+entry bar3()
+  bar3 = ""
+end function test3
+
+function test4(n) ! { dg-warning "returning variables of different string lengths" }
+  integer  :: n
+  character(n) :: test4
+  character(*) :: bar4 ! { dg-warning "Obsolescent feature" }
+  test4 = ""
+  return
+entry bar4()
+  bar4 = ""
+end function test4
+
+function test5() ! { dg-warning "returning variables of different string lengths" }
+  character(1) :: test5
+  character(2) :: bar5
+  test5 = ""
+  return
+entry bar5()
+  bar5 = ""
+end function test5
+
+function test6() ! { dg-warning "Obsolescent feature|returning variables of different string lengths" }
+  character(*) :: test6
+  character(2) :: bar6
+  test6 = ""
+  return
+entry bar6()
+  bar6 = ""
+end function test6
diff --git a/gcc/testsuite/gfortran.dg/entry_18.f90 b/gcc/testsuite/gfortran.dg/entry_18.f90
new file mode 100644
index 000000000..0cfe84213
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_18.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! Test fix for PR37583, in which:
+! (i) the reference to glocal prior to the ENTRY caused an internal
+! error and
+! (ii) the need for a RECURSIVE attribute was ignored.
+!
+! Contributed by Arjen Markus <arjen.markus@wldelft.nl>
+!
+module gsub
+contains
+recursive subroutine suba( g )   ! prefix with "RECURSIVE"
+   interface
+       real function g(x)
+       real x
+       end function
+   end interface
+   real :: x, y
+   call mysub( glocala )
+   return
+entry glocala( x, y )
+   y = x
+end subroutine
+subroutine subb( g )
+   interface
+       real function g(x)
+       real x
+       end function
+   end interface
+   real :: x, y
+   call mysub( glocalb ) ! { dg-warning "Non-RECURSIVE" }
+   return
+entry glocalb( x, y )
+   y = x
+end subroutine
+end module
+! { dg-final { cleanup-modules "gsub" } }
diff --git a/gcc/testsuite/gfortran.dg/entry_19.f90 b/gcc/testsuite/gfortran.dg/entry_19.f90
new file mode 100644
index 000000000..87b52ad67
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_19.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+! 
+!
+! Entry is obsolete in Fortran 2008
+!
+subroutine foo()
+entry bar() ! { dg-warning "Fortran 2008 obsolescent feature: ENTRY" }
+end 
diff --git a/gcc/testsuite/gfortran.dg/entry_2.f90 b/gcc/testsuite/gfortran.dg/entry_2.f90
new file mode 100644
index 000000000..5c0a32e52
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_2.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! Arguments to procedures with multiple entry points may be absent, however
+! they are not optional, unless explicitly maked as such.
+subroutine foo(i, a, b)
+  logical a(2, 2)
+  logical b(1)
+  ! Check we don't get an "DIM must not be optional" error
+  a = any(b, i)
+entry bar()
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/entry_3.f90 b/gcc/testsuite/gfortran.dg/entry_3.f90
new file mode 100644
index 000000000..b4473df31
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_3.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! Test assumed shape arrays in procedures with multiple entry points.
+! Arguments that aren't present in all entry points must be treated like
+! optional arguments.
+module entry_4
+contains
+subroutine foo(a)
+  integer, dimension(:) :: a
+  integer, dimension(:) :: b
+  a = (/1, 2/)
+  return
+entry bar(b)
+  b = (/3, 4/)
+end subroutine
+end module
+
+program entry_4_prog
+  use entry_4
+  integer :: a(2)
+  a = 0
+  call foo(a)
+  if (any (a .ne. (/1, 2/))) call abort
+  call bar(a)
+  if (any (a .ne. (/3, 4/))) call abort
+end program
+
+! { dg-final { cleanup-modules "entry_4" } }
diff --git a/gcc/testsuite/gfortran.dg/entry_4.f90 b/gcc/testsuite/gfortran.dg/entry_4.f90
new file mode 100644
index 000000000..9a3b89a62
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_4.f90
@@ -0,0 +1,28 @@
+! { dg-do compile { target i?86-*-* x86_64-*-* } }
+function f1 () result (r)      ! { dg-error "can't be a POINTER" }
+integer, pointer :: r
+real e1
+allocate (r)
+r = 6
+return
+entry e1 ()
+e1 = 12
+entry e1a ()
+e1a = 13
+end function
+function f2 ()
+integer, dimension (2, 7, 6) :: e2   ! { dg-error "can't be an array" }
+f2 = 6
+return
+entry e2 ()
+e2 (:, :, :) = 2
+end function
+integer(kind=8) function f3 ()      ! { dg-error "can't be of type" }
+complex(kind=8) e3              ! { dg-error "can't be of type" }
+f3 = 1
+return
+entry e3 ()
+e3 = 2
+entry e3a ()
+e3a = 3
+end function
diff --git a/gcc/testsuite/gfortran.dg/entry_5.f90 b/gcc/testsuite/gfortran.dg/entry_5.f90
new file mode 100644
index 000000000..ad0554c76
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_5.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! PR 24008
+! an argument list to the entry is required
+REAL FUNCTION funct()
+  funct = 0.0
+  RETURN
+!
+  ENTRY enter RESULT (answer)  ! { dg-error "Unclassifiable statement" }
+  answer = 1.0
+  RETURN
+END FUNCTION funct
diff --git a/gcc/testsuite/gfortran.dg/entry_6.f90 b/gcc/testsuite/gfortran.dg/entry_6.f90
new file mode 100644
index 000000000..103392606
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_6.f90
@@ -0,0 +1,56 @@
+! { dg-do run }
+! Tests the fix for PR24558, which reported that module
+! alternate function entries did not work.
+!
+! Contributed by Erik Edelmann  <eedelman@gcc.gnu.org>
+!
+module foo
+contains
+    function n1 (a)
+        integer :: n1, n2, a, b
+        integer, save :: c
+        c = a
+        n1 = c**3
+        return
+    entry n2 (b)
+        n2 = c * b
+        n2 = n2**2
+        return
+    end function n1
+    function z1 (u)
+        complex :: z1, z2, u, v
+        z1 = (1.0, 2.0) * u
+        return
+    entry z2 (v)
+        z2 = (3, 4) * v
+        return
+    end function z1
+    function n3 (d)
+        integer :: n3, d
+        n3 = n2(d) * n1(d) ! Check sibling references.
+        return
+    end function n3
+    function c1 (a)
+        character(4) :: c1, c2, a, b
+        c1 = a
+        if (a .eq. "abcd") c1 = "ABCD"
+        return
+    entry c2 (b)
+        c2 = b
+        if (b .eq. "wxyz") c2 = "WXYZ"
+        return
+    end function c1
+end module foo
+    use foo
+    if (n1(9) .ne. 729) call abort ()
+    if (n2(2) .ne. 324) call abort ()
+    if (n3(19) .ne. 200564019) call abort ()
+    if (c1("lmno") .ne. "lmno") call abort ()
+    if (c1("abcd") .ne. "ABCD") call abort ()
+    if (c2("lmno") .ne. "lmno") call abort ()
+    if (c2("wxyz") .ne. "WXYZ") call abort ()
+    if (z1((3,4)) .ne. (-5, 10)) call abort ()
+    if (z2((5,6)) .ne. (-9, 38)) call abort ()
+ end
+
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/entry_7.f90 b/gcc/testsuite/gfortran.dg/entry_7.f90
new file mode 100644
index 000000000..b011fe63b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_7.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! Check that PR20877 and PR25047 are fixed by the patch for
+! PR24558. Both modules would emit the error:
+! insert_bbt(): Duplicate key found!
+! because of the prior references to a module function entry.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+MODULE TT
+CONTAINS
+  FUNCTION K(I) RESULT(J)
+    ENTRY J() ! { dg-error "conflicts with RESULT attribute" }
+  END FUNCTION K
+
+  integer function foo ()
+    character*4 bar ! { dg-error "type CHARACTER" }
+    foo = 21
+    return
+  entry bar ()
+    bar = "abcd"
+  end function
+END MODULE TT
+
+
+! { dg-final { cleanup-modules "TT" } }
diff --git a/gcc/testsuite/gfortran.dg/entry_8.f90 b/gcc/testsuite/gfortran.dg/entry_8.f90
new file mode 100644
index 000000000..02ec2b904
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_8.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! Check for PR 27478
+      FUNCTION X()
+      ENTRY X1
+      IF (X .GT. 0) CALL FOO(X)
+      IF (Y .GT. 0) CALL FOO(Y)
+      END
+
+      FUNCTION TSL(PIN)
+      ENTRY TSL1(PIN)
+      IF (DBLE(TSL) .GT. PIN) TSL = 705.47
+      TSL= PPP(TSL)
+      END
diff --git a/gcc/testsuite/gfortran.dg/entry_9.f90 b/gcc/testsuite/gfortran.dg/entry_9.f90
new file mode 100644
index 000000000..5dcb6e3b1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_9.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! Check whether RESULT of ENTRY defaults to entry-name.
+! PR fortran/30873
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+MODULE M1
+  CONTAINS
+    FUNCTION F2(K)
+      INTEGER :: F2,K
+      F2=E1(K)
+    END FUNCTION F2
+
+    RECURSIVE FUNCTION F1(I)
+      INTEGER :: F1,I,E1
+      F1=F2(I)
+      RETURN
+     ENTRY E1(I)
+      E1=-I
+      RETURN
+    END FUNCTION F1
+END  MODULE M1
+
+program main
+  use m1
+  if (E1(5) /= -5) call abort()
+  if (F2(4) /= -4) call abort()
+  if (F1(1) /= -1) call abort()
+end program main
+
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/entry_array_specs_1.f90 b/gcc/testsuite/gfortran.dg/entry_array_specs_1.f90
new file mode 100644
index 000000000..5e6e5f676
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_array_specs_1.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! Tests the fix for PR25091 and PR25092 in which mismatched array
+! specifications between entries of the same procedure were not diagnosed.
+
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk> 
+
+! This was PR25091 - no diagnostic given on error
+ FUNCTION F1() RESULT(RES_F1) ! { dg-error "mismatched array specifications" }
+ INTEGER RES_F1(2,2)
+ INTEGER RES_E1(4)
+ ENTRY E1() RESULT(RES_E1)
+ END FUNCTION
+
+! This was PR25092 - no diagnostic given on error
+ FUNCTION F2() RESULT(RES_F2) ! { dg-error "mismatched array specifications" }
+ INTEGER :: RES_F2(4)
+ INTEGER :: RES_E2(3)
+ ENTRY E2() RESULT(RES_E2)
+ END FUNCTION
+
+! Check that the versions without explicit results give the error
+ FUNCTION F3() ! { dg-error "mismatched array specifications" }
+ INTEGER :: F3(4)
+ INTEGER :: E3(2,2)
+ ENTRY E3()
+ END FUNCTION
+
+ FUNCTION F4() ! { dg-error "mismatched array specifications" }
+ INTEGER :: F4(4)
+ INTEGER :: E4(3)
+ ENTRY E4()
+ END FUNCTION
+
+! Check that conforming entries are OK.
+ FUNCTION F5()
+ INTEGER :: F5(4,5,6)
+ INTEGER :: E5(4,5,6)
+ ENTRY E5()
+ END FUNCTION
diff --git a/gcc/testsuite/gfortran.dg/entry_array_specs_2.f b/gcc/testsuite/gfortran.dg/entry_array_specs_2.f
new file mode 100644
index 000000000..ba4de318c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_array_specs_2.f
@@ -0,0 +1,31 @@
+! { dg-do run }
+! Tests the patch for PR30025, aka 25818, in which the initialization
+! code for the array a, was causing a segfault in runtime for a call
+! to x, since n is missing.
+!
+! COntributed by Elizabeth Yip <elizabeth.l.yip@boeing.com>
+      program test_entry
+      common // j
+      real a(10)
+      a(1) = 999.
+      call x
+      if (j .ne. 1) call abort ()
+      call y(a,10)
+      if (j .ne. 2) call abort ()
+      stop
+      end 
+      subroutine x
+      common // j
+      real a(n)
+      j = 1
+      return
+      entry y(a,n)
+      call foo(a(1))
+      end
+      subroutine foo(a)
+      common // j
+      real a
+      j = 2
+      return
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/entry_array_specs_3.f90 b/gcc/testsuite/gfortran.dg/entry_array_specs_3.f90
new file mode 100644
index 000000000..b54a27039
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_array_specs_3.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! PR fortran/34861, in which the test of conformity of the result array bounds
+! would barf because they are not known at compile time in this case.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+FUNCTION I_IMFUD0 ( IDA2 , NDS4, NDS3) RESULT(I_IMFUDP)
+  INTEGER  ::   NDS4, NDS3
+  INTEGER  ::   IDA2(5,NDS4,NDS3,2)
+  INTEGER  ::   I_IMFUDP(SIZE(IDA2,1), SIZE(IDA2,2), SIZE(IDA2,3), SIZE(IDA2,4))
+  ENTRY I_IMFUDX (NDS4, NDS3, IDA2) RESULT(I_IMFUDP)
+  ENTRY I_IMFUDY (NDS3, NDS4, IDA2) RESULT(I_IMFUDP)
+  ENTRY I_IMFUDZ (NDS3, IDA2, NDS4) RESULT(I_IMFUDP)
+  I_IMFUDP = 1-IDA2(:,:,:,::NDS4-NDS3)
+END FUNCTION
diff --git a/gcc/testsuite/gfortran.dg/entry_dummy_ref_1.f90 b/gcc/testsuite/gfortran.dg/entry_dummy_ref_1.f90
new file mode 100644
index 000000000..8985b935b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_dummy_ref_1.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! Tests fix for PR25090 in which references in specification
+! expressions to variables that were not entry formal arguments
+! would be missed.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+   SUBROUTINE S1(I)
+   CHARACTER(LEN=I+J) :: a
+   real :: x(i:j), z
+   a = ""  ! { dg-error "before the ENTRY statement in which it is a parameter" }
+   x = 0.0 ! { dg-error "before the ENTRY statement in which it is a parameter" }
+   ENTRY E1(J)
+   END SUBROUTINE S1
+   END
diff --git a/gcc/testsuite/gfortran.dg/entry_dummy_ref_2.f90 b/gcc/testsuite/gfortran.dg/entry_dummy_ref_2.f90
new file mode 100644
index 000000000..46dbdf6c2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_dummy_ref_2.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! Tests fix for PR25058 in which references to dummy
+! parameters before the entry would be missed.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+MODULE M1
+CONTAINS
+FUNCTION F1(I) RESULT(RF1)
+ INTEGER :: I,K,RE1,RF1
+ RE1=K ! { dg-error "before the ENTRY statement" }
+ RETURN
+ ENTRY E1(K) RESULT(RE1)
+ RE1=-I
+ RETURN
+END FUNCTION F1
+END  MODULE M1
+END
+
+! { dg-final { cleanup-modules "M1" } }
diff --git a/gcc/testsuite/gfortran.dg/entry_dummy_ref_3.f90 b/gcc/testsuite/gfortran.dg/entry_dummy_ref_3.f90
new file mode 100644
index 000000000..379f6fba3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_dummy_ref_3.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+! PR fortran/33818
+!
+
+subroutine ExportZMX(lu)
+  implicit none
+  integer :: lu
+  interface
+    function LowerCase(str)
+      character(*),intent(in) :: str
+      character(len(str))     :: LowerCase
+    end function LowerCase
+  end interface
+  character(*),parameter :: UNAME(1:1)=(/'XXX'/)
+  write(lu,'(a)') 'UNIT '//UpperCase(UNAME(1))
+  write(lu,'(a)') 'Unit '//LowerCase(UNAME(1))
+entry ExportSEQ(lu)
+contains
+  function UpperCase(str) result(res)
+    character(*),intent(in) :: str
+    character(len(str)) res
+    res=str
+  end function
+end
diff --git a/gcc/testsuite/gfortran.dg/enum_1.f90 b/gcc/testsuite/gfortran.dg/enum_1.f90
new file mode 100644
index 000000000..0156cb576
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/enum_1.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! Program to test ENUM parsing 
+
+program main
+  implicit none
+  enum, bind (c)
+    enumerator :: red, black
+    enumerator blue
+  end enum
+  if (red /= 0) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/enum_10.c b/gcc/testsuite/gfortran.dg/enum_10.c
new file mode 100644
index 000000000..28beb12f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/enum_10.c
@@ -0,0 +1,27 @@
+/* This testcase is meant to be compiled together with enum_10.f90  */
+
+extern void abort (void);
+
+typedef enum
+  { MAX1 = 127 } onebyte;
+
+void f1_ (onebyte *i, int *j)
+{
+  if (*i != *j) abort ();
+}
+
+typedef enum
+  { MAX2 = 32767 } twobyte;
+
+void f2_ (twobyte *i, int *j)
+{
+  if (*i != *j) abort ();
+}
+
+typedef enum
+  { MAX4 = 2000000 } fourbyte; /* don't need the precise value. */
+
+void f4_ (fourbyte *i, int *j)
+{
+  if (*i != *j) abort ();
+}
diff --git a/gcc/testsuite/gfortran.dg/enum_10.f90 b/gcc/testsuite/gfortran.dg/enum_10.f90
new file mode 100644
index 000000000..99a16901c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/enum_10.f90
@@ -0,0 +1,64 @@
+! { dg-do run }
+! { dg-additional-sources enum_10.c }
+! { dg-options "-fshort-enums -w" }
+! { dg-options "-fshort-enums -w -Wl,--no-enum-size-warning" { target arm*-*-linux*eabi } }
+! Make sure short enums are indeed interoperable with the
+! corresponding C type.
+
+module enum_10
+enum, bind( c )
+   enumerator :: one1 = 1, two1, max1 = huge(1_1)
+end enum
+
+enum, bind( c )
+   enumerator :: one2 = 1, two2, max2 = huge(1_2)
+end enum
+
+enum, bind( c )
+   enumerator :: one4 = 1, two4, max4 = huge(1_4)
+end enum
+end module enum_10
+
+use enum_10
+
+interface f1
+  subroutine f1(i,j)
+    use enum_10
+    integer (kind(max1)) :: i
+    integer :: j
+  end subroutine f1
+end interface
+
+
+interface f2
+  subroutine f2(i,j)
+    use enum_10
+    integer (kind(max2)) :: i
+    integer :: j
+  end subroutine f2
+end interface
+
+
+interface f4
+  subroutine f4(i,j)
+    use enum_10
+    integer (kind(max4)) :: i
+    integer :: j
+  end subroutine f4
+end interface
+
+
+call f1 (one1, 1)
+call f1 (two1, 2)
+call f1 (max1, huge(1_1)+0) ! Adding 0 to get default integer
+
+call f2 (one2, 1)
+call f2 (two2, 2)
+call f2 (max2, huge(1_2)+0)
+
+call f4 (one4, 1)
+call f4 (two4, 2)
+call f4 (max4, huge(1_4)+0)
+end
+
+! { dg-final { cleanup-modules "enum_10" } }
diff --git a/gcc/testsuite/gfortran.dg/enum_2.f90 b/gcc/testsuite/gfortran.dg/enum_2.f90
new file mode 100644
index 000000000..8f7aea1f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/enum_2.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! Program to test ENUM parsing errors 
+
+program main
+  implicit none
+  enum, bind (c)
+    enumerator :: red, black
+    integer :: x  ! { dg-error "Unexpected data declaration" }
+    enumerator blue = 1  ! { dg-error "Syntax error in ENUMERATOR definition" }
+  end enum
+
+  red = 42 ! { dg-error "variable definition context" }
+
+  enumerator :: sun  ! { dg-error "ENUM" }
+end program main
diff --git a/gcc/testsuite/gfortran.dg/enum_3.f90 b/gcc/testsuite/gfortran.dg/enum_3.f90
new file mode 100644
index 000000000..277cabe9a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/enum_3.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! Program to test ENUM parsing errors 
+
+program main
+  implicit none
+  enum, bind (c)
+    enumerator :: red, black = 2.2  ! { dg-error "initialized with integer expression" }
+    enumerator :: blue = "x"  ! { dg-error "initialized with integer expression" }
+  end enum  ! { dg-error "has no ENUMERATORS" }
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/enum_4.f90 b/gcc/testsuite/gfortran.dg/enum_4.f90
new file mode 100644
index 000000000..6cca2ebc6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/enum_4.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! Program to test ENUM parsing errors 
+
+program main
+  implicit none
+  enum, bind (c)
+    enumerator :: red, black = 2     
+    enumerator :: blue = 1, red  ! { dg-error "already has basic type" }
+  end enum
+
+  enum, bind (c)
+    enumerator :: r, b(10) = 2  ! { dg-error "Syntax error" }
+    enumerator , save :: g = 1  ! { dg-error "Syntax error" }  
+  end  ! { dg-error " END ENUM" } 
+
+end program main  ! { dg-error "Expecting END ENUM statement" }
+! { dg-error "Unexpected end of file" "" { target "*-*-*" } 0 }
diff --git a/gcc/testsuite/gfortran.dg/enum_5.f90 b/gcc/testsuite/gfortran.dg/enum_5.f90
new file mode 100644
index 000000000..81a1dd5df
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/enum_5.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! Program to test ENUM parsing errors 
+
+program main
+  implicit none
+  integer :: i = 1
+
+  enum, bind (c)
+    enumerator :: red, black = i  ! { dg-error "is a variable" }
+    enumerator :: blue = 1  
+  end enum junk  ! { dg-error "Syntax error" }
+
+  blue = 10  ! { dg-error "Unexpected assignment" }
+
+end program main  ! { dg-error "Expecting END ENUM" }
+ ! { dg-error "Unexpected end of file" "" { target "*-*-*" } 0 }
diff --git a/gcc/testsuite/gfortran.dg/enum_6.f90 b/gcc/testsuite/gfortran.dg/enum_6.f90
new file mode 100644
index 000000000..1c7c027a3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/enum_6.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! Program to test ENUM parsing errors 
+
+program main
+  implicit none
+  integer :: i = 1
+
+  enum, bind (c)
+    enumerator :: sun, mon = 2    
+    i = 2  ! { dg-error "Unexpected" }  
+    enumerator :: wed = 1    
+  end enum       
+
+  i = 1
+
+  enum, bind (c)  ! { dg-error "Unexpected" } 
+    enumerator :: red, black = 2  ! { dg-error "ENUM definition statement expected" }
+    enumerator :: blue = 1  ! { dg-error "ENUM definition statement expected" }
+  end enum  ! { dg-error "Expecting END PROGRAM" }
+
+end program main        
diff --git a/gcc/testsuite/gfortran.dg/enum_7.f90 b/gcc/testsuite/gfortran.dg/enum_7.f90
new file mode 100644
index 000000000..9971a5118
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/enum_7.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! Program to test ENUM parsing errors 
+
+program main
+  implicit none
+
+  enum, bind (c)
+    enumerator :: sun, mon = 2    
+    enum, bind (c)  ! { dg-error "Unexpected" }
+      enumerator :: apple, mango
+    end enum  
+    enumerator :: wed = 1  ! { dg-error "ENUM definition statement expected" }  
+  end enum  ! { dg-error "Expecting END PROGRAM" }  
+
+end program main        
diff --git a/gcc/testsuite/gfortran.dg/enum_8.f90 b/gcc/testsuite/gfortran.dg/enum_8.f90
new file mode 100644
index 000000000..819c58708
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/enum_8.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! Program to test the initialisation range of enumerators 
+! and kind values check
+
+program main
+  implicit none
+  enum, bind (c)
+    enumerator :: pp, qq = 4294967295, rr ! { dg-error "too big for its kind" }
+  end enum  ! { dg-error "has no ENUMERATORS" }
+
+  enum, bind (c)
+    enumerator :: p , q = 4294967299_8, r  ! { dg-error "Arithmetic overflow" }
+  end enum  ! { dg-error "has no ENUMERATORS" }
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/enum_9.f90 b/gcc/testsuite/gfortran.dg/enum_9.f90
new file mode 100644
index 000000000..8a5c60a10
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/enum_9.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-fshort-enums" }
+! { dg-options "-fshort-enums -Wl,--no-enum-size-warning" { target arm*-*-linux*eabi } }
+! Program to test enumerations when option -fshort-enums is given
+
+program main
+  implicit none
+  enum, bind (c)
+    enumerator :: red, black = 127
+    enumerator blue
+  end enum
+  if (red /= 0) call abort
+  if (black /= 127) call abort
+  if (blue /= 128) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/eof_1.f90 b/gcc/testsuite/gfortran.dg/eof_1.f90
new file mode 100644
index 000000000..05726bd14
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eof_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! Program to test for proper EOF errors when reading past the end of a file.
+! We used to get this wrong when a formatted read followed a list formatted
+! read.
+program eof_1
+  character(len=5) :: s
+
+  open (unit=11, status="SCRATCH")
+  write (11, '(a)') "Hello"
+  rewind(11)
+  read(11, *) s
+  if (s .ne. "Hello") call abort
+  read(11, '(a5)', end=10) s
+  call abort
+10 continue
+  close (11)
+end
+
diff --git a/gcc/testsuite/gfortran.dg/eof_2.f90 b/gcc/testsuite/gfortran.dg/eof_2.f90
new file mode 100644
index 000000000..b7c2c9172
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eof_2.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! Check that end= and iostat= specifiers are honoured when both are used
+program eof_2
+  integer ierr, i
+
+  open (11, status="SCRATCH")
+  ierr = 0
+  read (11, *, end=10, iostat=ierr) i
+  call abort
+10 continue
+  if (ierr .ge. 0) call abort
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/eof_3.f90 b/gcc/testsuite/gfortran.dg/eof_3.f90
new file mode 100644
index 000000000..f1d5098c7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eof_3.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! PR40714 A read hitting EOF should leave the unit structure in a correct state
+program test
+open(unit=32,status="scratch",access="sequential",form="unformatted")
+read(32,end=100)
+100 continue
+backspace(32)
+write (32)
+end program test
diff --git a/gcc/testsuite/gfortran.dg/eor_1.f90 b/gcc/testsuite/gfortran.dg/eor_1.f90
new file mode 100644
index 000000000..cd0004bb2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eor_1.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR 19451: The test for advance='NO' with eor used to be reversed.
+program main
+  character*2 c
+  open(12, status='SCRATCH')
+  write(12, '(A)') '123', '456'
+  rewind(12)
+  read(12, '(A2)', advance='NO', eor=100) c
+100 continue
+end program main
diff --git a/gcc/testsuite/gfortran.dg/eor_handling_1.f90 b/gcc/testsuite/gfortran.dg/eor_handling_1.f90
new file mode 100644
index 000000000..241f8a0fe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eor_handling_1.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! PR 17992:  Reading an empty file should yield zero with pad='YES'
+! (which is the default).
+! Test case supplied by milan@cmm.ki.si.
+program main
+  open(77,status='scratch')
+  write(77,'(A)') '',''
+  rewind(77)
+  i = 42
+  j = 42
+  read(77,'(/2i2)') i,j
+  if (i /= 0 .or. j /= 0) call abort
+  close(77)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/eor_handling_2.f90 b/gcc/testsuite/gfortran.dg/eor_handling_2.f90
new file mode 100644
index 000000000..9ae563846
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eor_handling_2.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! PR 19568:  Don't read across end of line when the format is longer
+!            than the line length and pad='yes' (default)
+program main
+  character(len=1) c1(10),c2(10)
+  open(77,status='scratch')
+  write(77,'(A)'), 'Line 1','Line 2','Line 3' ! { dg-warning "Comma before i/o item list" }
+  rewind(77)
+  read(77,'(10A1)'), c1 ! { dg-warning "Comma before i/o item list" }
+  read(77,'(10A1)'), c2 ! { dg-warning "Comma before i/o item list" }
+  if (c1(1) /= 'L' .or. c2(1) /= 'L') call abort
+  close(77)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/eor_handling_3.f90 b/gcc/testsuite/gfortran.dg/eor_handling_3.f90
new file mode 100644
index 000000000..4225e867a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eor_handling_3.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! PR 19595:  Handle end-of-record condition with pad=yes (default)
+program main
+  integer i1, i2
+  open(77,status='scratch')
+  write (77,'(A)') '123','456'
+  rewind(77)
+  read(77,'(2I2)',advance='no',eor=100) i1,i2
+  call abort
+100 continue
+  if (i1 /= 12 .or. i2 /= 3) call abort
+  close(77)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/eor_handling_4.f90 b/gcc/testsuite/gfortran.dg/eor_handling_4.f90
new file mode 100644
index 000000000..300c10b82
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eor_handling_4.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! PR 20092, 20131:  Handle end-of-record condition with pad=yes (default)
+! for standard input.  This test case only really tests  anything if,
+! by changing unit 5, you get to manipulate the standard input.
+program main
+  character(len=1) a(80)
+  close(5)
+  open(5,status="scratch")
+  write(5,'(A)') 'one', 'two', 's'
+  rewind(5)
+  do i=1,4
+     read(5,'(80a1)') a
+     if (a(1) == 's') goto 100
+  end do
+  call abort
+100 continue
+end program main
diff --git a/gcc/testsuite/gfortran.dg/eor_handling_5.f90 b/gcc/testsuite/gfortran.dg/eor_handling_5.f90
new file mode 100644
index 000000000..c116fb7bd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eor_handling_5.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! PR 20661: Handle non-advancing I/O with iostat
+! Test case by Walt Brainerd, The Fortran Company
+
+program fc002
+   character(len=1) :: c
+   integer :: k,k2
+   character(len=*), parameter :: f="(a)"
+   open(11,status="scratch", iostat=k)
+   if (k /= 0) call abort
+   write(11,f) "x"
+   rewind (11)
+   read(11, f, advance="no", iostat=k) c
+   if (k /= 0) call abort
+   read(11, f, advance="no", iostat=k) c
+   if (k >= 0) call abort
+   read(11, f, advance="no", iostat=k2) c
+   if (k2 >= 0 .or. k == k2) call abort
+end program fc002
diff --git a/gcc/testsuite/gfortran.dg/eoshift.f90 b/gcc/testsuite/gfortran.dg/eoshift.f90
new file mode 100644
index 000000000..ae7643bfd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eoshift.f90
@@ -0,0 +1,6 @@
+! { dg-do run }
+! PR 18958:  We used to segfault for eoshifting off the end of an array.
+program main
+  character(len=20) line
+  write (line,'(2I4)') eoshift((/1, 3/), 3)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/eoshift_2.f90 b/gcc/testsuite/gfortran.dg/eoshift_2.f90
new file mode 100644
index 000000000..a4c3b2ae2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eoshift_2.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! pr35724 compile time segmentation fault for eoshift with negative third arg
+subroutine ra0072(dda,lda,nf10,nf1,mf1,nf2)
+      real dda(10,10)
+      logical lda(10,10)
+      dda = eoshift(dda,(/mf1,nf1/),tws0r,nf3-nf1)
+      lda = cshift(lda,(/mf1,nf1/),nf3-nf1)
+      where (lda) dda = eoshift(dda,1,1.0,-mf1)
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/eoshift_bounds_1.f90 b/gcc/testsuite/gfortran.dg/eoshift_bounds_1.f90
new file mode 100644
index 000000000..f32341556
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eoshift_bounds_1.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect size in SHIFT argument of EOSHIFT intrinsic: should not be zero-sized" }
+program main
+  real, dimension(1,0) :: a, b, c
+  integer :: sp(3), i
+  a = 4.0
+  sp = 1
+  i = 1
+  b = eoshift (a,sp(1:i)) ! Invalid
+end program main
+! { dg-output "Fortran runtime error: Incorrect size in SHIFT argument of EOSHIFT intrinsic: should not be zero-sized" }
diff --git a/gcc/testsuite/gfortran.dg/eoshift_large_1.f90 b/gcc/testsuite/gfortran.dg/eoshift_large_1.f90
new file mode 100644
index 000000000..3b0ef7e36
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/eoshift_large_1.f90
@@ -0,0 +1,106 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_int }
+! Program to test the eoshift intrinsic for kind=16_k integers
+! 
+program intrinsic_eoshift
+  integer, parameter :: k=16
+  integer(kind=k), dimension(3_k, 3_k) :: a
+   integer(kind=k), dimension(3_k, 3_k, 2_k) :: b
+   integer(kind=k), dimension(3_k) :: bo, sh
+
+   ! Scalar shift and scalar bound.
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = eoshift (a, 1_k, 99_k, 1_k)
+   if (any (a .ne. reshape ((/2_k, 3_k, 99_k, 5_k, 6_k, 99_k, 8_k, 9_k, 99_k/), (/3_k, 3_k/)))) &
+      call abort
+
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = eoshift (a, 9999_k, 99_k, 1_k)
+   if (any (a .ne. 99_k)) call abort
+
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = eoshift (a, -2_k, dim = 2_k)
+   if (any (a .ne. reshape ((/0_k, 0_k, 0_k, 0_k, 0_k, 0_k, 1_k, 2_k, 3_k/), (/3_k, 3_k/)))) &
+      call abort
+
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = eoshift (a, -9999_k, 99_k, 1_k)
+   if (any (a .ne. 99_k)) call abort
+
+   ! Array shift and scalar bound.
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = eoshift (a, (/1_k, 0_k, -1_k/), 99_k, 1_k)
+   if (any (a .ne. reshape ((/2_k, 3_k, 99_k, 4_k, 5_k, 6_k, 99_k, 7_k, 8_k/), (/3_k, 3_k/)))) &
+      call abort
+
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = eoshift (a, (/9999_k, 0_k, -9999_k/), 99_k, 1_k)
+   if (any (a .ne. reshape ((/99_k, 99_k, 99_k, 4_k, 5_k, 6_k, 99_k, 99_k, 99_k/), (/3_k, 3_k/)))) &
+      call abort
+
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = eoshift (a, (/2_k, -2_k, 0_k/), dim = 2_k)
+   if (any (a .ne. reshape ((/7_k, 0_k, 3_k, 0_k, 0_k, 6_k, 0_k, 2_k, 9_k/), (/3_k, 3_k/)))) &
+      call abort
+
+   ! Scalar shift and array bound.
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = eoshift (a, 1_k, (/99_k, -1_k, 42_k/), 1_k)
+   if (any (a .ne. reshape ((/2_k, 3_k, 99_k, 5_k, 6_k, -1_k, 8_k, 9_k, 42_k/), (/3_k, 3_k/)))) &
+      call abort
+
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = eoshift (a, 9999_k, (/99_k, -1_k, 42_k/), 1_k)
+   if (any (a .ne. reshape ((/99_k, 99_k, 99_k, -1_k, -1_k, -1_k, 42_k, 42_k, 42_k/), &
+       (/3_k, 3_k/)))) call abort
+
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = eoshift (a, -9999_k, (/99_k, -1_k, 42_k/), 1_k)
+   if (any (a .ne. reshape ((/99_k, 99_k, 99_k, -1_k, -1_k, -1_k, 42_k, 42_k, 42_k/), &
+       (/3_k, 3_k/)))) call abort
+
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = eoshift (a, -2_k, (/99_k, -1_k, 42_k/), 2_k)
+   if (any (a .ne. reshape ((/99_k, -1_k, 42_k, 99_k, -1_k, 42_k, 1_k, 2_k, 3_k/), (/3_k, 3_k/)))) &
+      call abort
+
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   bo = (/99_k, -1_k, 42_k/)
+   a = eoshift (a, -2_k, bo, 2_k)
+   if (any (a .ne. reshape ((/99_k, -1_k, 42_k, 99_k, -1_k, 42_k, 1_k, 2_k, 3_k/), (/3_k, 3_k/)))) &
+      call abort
+
+   ! Array shift and array bound.
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = eoshift (a, (/1_k, 0_k, -1_k/), (/99_k, -1_k, 42_k/), 1_k)
+   if (any (a .ne. reshape ((/2_k, 3_k, 99_k, 4_k, 5_k, 6_k, 42_k, 7_k, 8_k/), (/3_k, 3_k/)))) &
+      call abort
+
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = eoshift (a, (/2_k, -2_k, 0_k/), (/99_k, -1_k, 42_k/), 2_k)
+   if (any (a .ne. reshape ((/7_k, -1_k, 3_k, 99_k, -1_k, 6_k, 99_k, 2_k, 9_k/), (/3_k, 3_k/)))) &
+      call abort
+
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   sh = (/ 3_k, -1_k, -3_k /)
+   bo = (/-999_k, -99_k, -9_k /)
+   a = eoshift(a, shift=sh, boundary=bo)
+   if (any (a .ne. reshape ((/ -999_k, -999_k, -999_k, -99_k, 4_k, 5_k, -9_k, -9_k, -9_k /), &
+        shape(a)))) call abort
+
+   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   a = eoshift (a, (/9999_k, -9999_k, 0_k/), (/99_k, -1_k, 42_k/), 2_k)
+   if (any (a .ne. reshape ((/99_k, -1_k, 3_k, 99_k, -1_k, 6_k, 99_k, -1_k, 9_k/), (/3_k, 3_k/)))) &
+      call abort
+
+   ! Test arrays > rank 2
+   b(:, :, 1_k) = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   b(:, :, 2_k) = 10_k + reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
+   b = eoshift (b, 1_k, 99_k, 1_k)
+   if (any (b(:, :, 1_k) .ne. reshape ((/2_k, 3_k, 99_k, 5_k, 6_k, 99_k, 8_k, 9_k, 99_k/), (/3_k, 3_k/)))) &
+      call abort
+   if (any (b(:, :, 2_k) .ne. reshape ((/12_k, 13_k, 99_k, 15_k, 16_k, 99_k, 18_k, 19_k, 99_k/), (/3_k, 3_k/)))) &
+      call abort
+
+   ! TODO: Test array sections
+end program
diff --git a/gcc/testsuite/gfortran.dg/equiv_1.f90 b/gcc/testsuite/gfortran.dg/equiv_1.f90
new file mode 100644
index 000000000..e9e441536
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_1.f90
@@ -0,0 +1,9 @@
+      program broken_equiv
+      real d (2)   ! { dg-error "Inconsistent equivalence rules" "d" }
+      real e      ! { dg-error "Inconsistent equivalence rules" "e" }
+      equivalence (d (1), e), (d (2), e)
+
+      real f (2)   ! { dg-error "Inconsistent equivalence rules" "f" }
+      double precision g (2) ! { dg-error "Inconsistent equivalence rules" "g" }
+      equivalence (f (1), g (1)), (f (2), g (2)) ! Not standard conforming
+      end
diff --git a/gcc/testsuite/gfortran.dg/equiv_2.f90 b/gcc/testsuite/gfortran.dg/equiv_2.f90
new file mode 100644
index 000000000..ee671f964
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_2.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+      subroutine broken_equiv1
+      character*4 h
+      character*3 i
+      equivalence (h(1:3), i(2:1))    ! { dg-error "has length zero" }
+      end subroutine
+
+      subroutine broken_equiv2
+      character*4 j
+      character*2 k
+      equivalence (j(2:3), k(1:5))    ! { dg-error "exceeds the string length" }
+      end subroutine
+
+      subroutine broken_equiv3
+      character*4 l
+      character*2 m
+      equivalence (l(2:3:4), m(1:2))    ! { dg-error "\[Ss\]yntax error" }
+      end subroutine
diff --git a/gcc/testsuite/gfortran.dg/equiv_5.f90 b/gcc/testsuite/gfortran.dg/equiv_5.f90
new file mode 100644
index 000000000..70b458bea
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_5.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! PR fortran/25078
+! An equivalence statement requires two or more objcets.
+program a
+  real x
+  equivalence(x) ! { dg-error "two or more objects" }
+end program a
diff --git a/gcc/testsuite/gfortran.dg/equiv_6.f90 b/gcc/testsuite/gfortran.dg/equiv_6.f90
new file mode 100644
index 000000000..1ab1a0513
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_6.f90
@@ -0,0 +1,77 @@
+! { dg-do run }
+! This checks the patch for PR25395, in which equivalences within one
+! segment were broken by indirect equivalences, depending on the
+! offset of the variable that bridges the indirect equivalence.
+!
+! This is a fortran95 version of the original testcase, which was
+! contributed by Harald Vogt  <harald.vogt@desy.de>
+program check_6
+  common /abc/ mwkx(80)
+  common /cde/ lischk(20)
+  dimension    listpr(20),lisbit(10),lispat(8)
+! This was badly compiled in the PR:
+  equivalence (listpr(10),lisbit(1),mwkx(10)), &
+              (lispat(1),listpr(10))
+  lischk = (/0, 0, 0, 0, 0, 0, 0, 0, 0, 1, &
+             2, 0, 0, 5, 6, 7, 8, 9,10, 0/)
+
+! These two calls replace the previously made call to subroutine
+! set_arrays which was erroneous because of parameter-induced 
+! aliasing.
+  call set_array_listpr (listpr)
+  call set_array_lisbit (lisbit)
+
+  if (any (listpr.ne.lischk)) call abort ()
+  call sub1
+  call sub2
+  call sub3
+end
+subroutine sub1
+  common /abc/ mwkx(80)
+  common /cde/ lischk(20)
+  dimension    listpr(20),lisbit(10),lispat(8)
+!     This workaround was OK
+  equivalence (listpr(10),lisbit(1)), &
+              (listpr(10),mwkx(10)),  &
+              (listpr(10),lispat(1))
+  call set_array_listpr (listpr)
+  call set_array_lisbit (lisbit)
+  if (any (listpr .ne. lischk)) call abort ()
+end
+!
+! Equivalences not in COMMON
+!___________________________
+! This gave incorrect results for the same reason as in MAIN.
+subroutine sub2
+  dimension   mwkx(80)
+  common /cde/ lischk(20)
+  dimension    listpr(20),lisbit(10),lispat(8)
+  equivalence (lispat(1),listpr(10)), &
+              (mwkx(10),lisbit(1),listpr(10))
+  call set_array_listpr (listpr)
+  call set_array_lisbit (lisbit)
+  if (any (listpr .ne. lischk)) call abort ()
+end
+! This gave correct results because the order in which the
+! equivalences are taken is different and was given in the PR.
+subroutine sub3
+  dimension   mwkx(80)
+  common /cde/ lischk(20)
+  dimension    listpr(20),lisbit(10),lispat(8)
+  equivalence (listpr(10),lisbit(1),mwkx(10)), &
+              (lispat(1),listpr(10))
+  call set_array_listpr (listpr)
+  call set_array_lisbit (lisbit)
+  if (any (listpr .ne. lischk)) call abort ()
+end
+
+subroutine set_array_listpr (listpr)
+  dimension listpr(20)
+  listpr = 0
+end
+
+subroutine set_array_lisbit (lisbit)
+  dimension lisbit(10)
+  lisbit = (/(i, i = 1, 10)/)
+  lisbit((/3,4/)) = 0
+end
diff --git a/gcc/testsuite/gfortran.dg/equiv_7.f90 b/gcc/testsuite/gfortran.dg/equiv_7.f90
new file mode 100644
index 000000000..23f707b39
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_7.f90
@@ -0,0 +1,114 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+! Tests the fix for PR29786, in which initialization of overlapping
+! equivalence elements caused a compile error.
+!
+! Contributed by Bernhard Fischer <aldot@gcc.gnu.org>
+!
+block data
+  common /global/ ca (4)
+  integer(4) ca, cb
+  equivalence (cb, ca(3))
+  data (ca(i), i = 1, 2) /42,43/, ca(4) /44/
+  data cb /99/
+end block data
+
+  integer(4), parameter :: abcd = ichar ("a") + 256_4 * (ichar("b") + 256_4 * &
+                                 (ichar ("c") + 256_4 * ichar ("d")))
+  logical(4), parameter :: bigendian = transfer (abcd, "wxyz") .eq. "abcd"
+
+  call int4_int4
+  call real4_real4
+  call complex_real
+  call check_block_data
+  call derived_types         ! Thanks to Tobias Burnus for this:)
+!
+! This came up in PR29786 comment #9 - Note the need to treat endianess
+! Thanks Dominique d'Humieres:)
+!
+  if (bigendian) then
+    if (d1mach_little (1) .ne. transfer ((/0_4, 1048576_4/), 1d0)) call abort ()
+    if (d1mach_little (2) .ne. transfer ((/-1_4,2146435071_4/), 1d0)) call abort ()
+  else
+    if (d1mach_big (1) .ne. transfer ((/1048576_4, 0_4/), 1d0)) call abort ()
+    if (d1mach_big (2) .ne. transfer ((/2146435071_4,-1_4/), 1d0)) call abort ()
+  end if 
+!
+contains
+  subroutine int4_int4
+      integer(4)         a(4)
+      integer(4)         b
+      equivalence (b,a(3))
+      data b/3/
+      data (a(i), i=1,2) /1,2/, a(4) /4/
+      if (any (a .ne. (/1, 2, 3, 4/))) call abort ()
+  end subroutine int4_int4
+  subroutine real4_real4
+      real(4)         a(4)
+      real(4)         b
+      equivalence (b,a(3))
+      data b/3.0_4/
+      data (a(i), i=1,2) /1.0_4, 2.0_4/, &
+            a(4) /4.0_4/
+      if (sum (abs (a -  &
+          (/1.0_4, 2.0_4, 3.0_4, 4.0_4/))) > 1.0e-6) call abort ()
+  end subroutine real4_real4
+  subroutine complex_real
+      complex(4)         a(4)
+      real(4)            b(2)
+      equivalence (b,a(3))
+      data b(1)/3.0_4/, b(2)/4.0_4/
+      data (a(i), i=1,2) /(0.0_4, 1.0_4),(2.0_4,0.0_4)/, &
+            a(4) /(0.0_4,5.0_4)/
+      if (sum (abs (a - (/(0.0_4, 1.0_4),(2.0_4, 0.0_4), &
+          (3.0_4, 4.0_4),(0.0_4, 5.0_4)/)))  > 1.0e-6) call abort ()
+  end subroutine complex_real
+  subroutine check_block_data
+      common /global/ ca (4)
+      equivalence (ca(3), cb)
+      integer(4) ca
+      if (any (ca .ne. (/42, 43, 99, 44/))) call abort ()
+  end subroutine check_block_data
+  function d1mach_little(i) result(d1mach)
+    implicit none
+    double precision d1mach,dmach(5)
+    integer i
+    integer*4 large(4),small(4)
+    equivalence ( dmach(1), small(1) )
+    equivalence ( dmach(2), large(1) )
+    data small(1),small(2) / 0,   1048576/
+    data large(1),large(2) /-1,2146435071/
+    d1mach = dmach(i) 
+  end function d1mach_little
+  function d1mach_big(i) result(d1mach)
+    implicit none
+    double precision d1mach,dmach(5)
+    integer i
+    integer*4 large(4),small(4)
+    equivalence ( dmach(1), small(1) )
+    equivalence ( dmach(2), large(1) )
+    data small(1),small(2) /1048576,    0/
+    data large(1),large(2) /2146435071,-1/
+    d1mach = dmach(i) 
+  end function d1mach_big
+    subroutine derived_types
+      TYPE T1
+        sequence
+        character (3) :: chr
+        integer :: i = 1
+        integer :: j
+        END TYPE T1
+      TYPE T2
+        sequence
+        character (3) :: chr = "wxy"
+        integer :: i = 1
+        integer :: j = 4
+      END TYPE T2
+      TYPE(T1) :: a1
+      TYPE(T2) :: a2
+      EQUIVALENCE(a1,a2)         ! { dg-warning="mixed|components" }
+      if (a1%chr .ne. "wxy") call abort ()
+      if (a1%i .ne. 1) call abort ()
+      if (a1%j .ne. 4) call abort ()
+      end subroutine derived_types
+end
diff --git a/gcc/testsuite/gfortran.dg/equiv_8.f90 b/gcc/testsuite/gfortran.dg/equiv_8.f90
new file mode 100644
index 000000000..a2ed7f034
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_8.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+!
+! PR fortran/41755
+!
+      common /uno/ aa
+      equivalence (aa,aaaaa)   (bb,cc) ! { dg-error "Expecting a comma in EQUIVALENCE" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/equiv_constraint_1.f90 b/gcc/testsuite/gfortran.dg/equiv_constraint_1.f90
new file mode 100644
index 000000000..75c3aa813
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_constraint_1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! PR20901 - F95 constrains mixing of types in equivalence.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+ character(len=4) :: a
+ integer :: i
+ equivalence(a,i) ! { dg-error "in default CHARACTER EQUIVALENCE statement at" }
+ END
+
+
diff --git a/gcc/testsuite/gfortran.dg/equiv_constraint_2.f90 b/gcc/testsuite/gfortran.dg/equiv_constraint_2.f90
new file mode 100644
index 000000000..8a4e0b5ff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_constraint_2.f90
@@ -0,0 +1,74 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR20901 - Checks resolution of types in EQUIVALENCE statement when
+! f95 standard is imposed.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+  type   :: numeric_type
+    sequence
+    integer      :: i
+    real         :: x
+    real(kind=8) :: d
+    complex      :: z
+    logical      :: l
+  end type numeric_type
+
+  type (numeric_type) :: my_num, thy_num
+
+  type   :: numeric_type2
+    sequence
+    integer      :: i
+    real         :: x
+    real(kind=8) :: d
+    complex      :: z
+    logical      :: l
+  end type numeric_type2
+
+  type (numeric_type2) :: his_num
+
+  type       :: char_type
+    sequence
+    character(4) :: ch
+    character(4) :: cha (6)
+  end type char_type
+
+  type (char_type) ::  my_char
+
+  type       :: mixed_type
+    sequence
+    integer     :: i(4)
+    character(4) :: cha (6)
+  end type mixed_type
+
+  type (mixed_type) ::  my_mixed, thy_mixed
+
+  character(len=4) :: ch
+  integer         :: num
+  integer(kind=8) :: non_def
+  complex(kind=8) :: my_z, thy_z
+
+! Permitted: character with character sequence
+!            numeric with numeric sequence
+!            numeric sequence with numeric sequence
+!            non-default of same type
+!            mixed sequences of same type
+  equivalence (ch, my_char)
+  equivalence (num, my_num)
+  equivalence (my_num, his_num, thy_num)
+  equivalence (my_z, thy_z)
+  equivalence (my_mixed, thy_mixed)
+
+! Not permitted by the standard - OK with -std=gnu
+  equivalence (my_mixed, my_num) ! { dg-error "with mixed components in EQUIVALENCE" }
+  equivalence (my_z, num) ! { dg-error "Non-default type object or sequence" }
+  equivalence (my_char, my_num) ! { dg-error "in default CHARACTER EQUIVALENCE" }
+  equivalence (ch, my_num) ! { dg-error "in default CHARACTER EQUIVALENCE" }
+  equivalence (my_num, ch) ! { dg-error "in default NUMERIC EQUIVALENCE" }
+  equivalence (num, my_char) ! { dg-error "in default NUMERIC EQUIVALENCE" }
+  equivalence (my_char, num) ! { dg-error "in default CHARACTER EQUIVALENCE" }
+  equivalence (non_def, ch) ! { dg-error "Non-default type object or sequence" }
+  equivalence (my_z, ch) ! { dg-error "Non-default type object or sequence" }
+  equivalence (my_z, num) ! { dg-error "Non-default type object or sequence" }
+ END
diff --git a/gcc/testsuite/gfortran.dg/equiv_constraint_3.f90 b/gcc/testsuite/gfortran.dg/equiv_constraint_3.f90
new file mode 100644
index 000000000..6d7c36313
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_constraint_3.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! PR20900 - USE associated variables cannot be equivalenced.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+MODULE TEST
+ INTEGER :: I
+END MODULE
+! note 11.7
+USE TEST, ONLY : K=>I
+INTEGER :: L
+EQUIVALENCE(K,L) ! { dg-error "conflicts with USE ASSOCIATED attribute" }
+END
+
+! { dg-final { cleanup-modules "TEST" } }
diff --git a/gcc/testsuite/gfortran.dg/equiv_constraint_4.f90 b/gcc/testsuite/gfortran.dg/equiv_constraint_4.f90
new file mode 100644
index 000000000..be9591afb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_constraint_4.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-O0" }
+! PR20901 - check that derived/numeric equivalence works with std!=f95.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+TYPE data_type
+ SEQUENCE
+ INTEGER :: I
+END TYPE data_type
+INTEGER :: J = 7
+TYPE(data_type) :: dd
+EQUIVALENCE(dd,J)
+if (dd%i.ne.7) call abort ()
+END
+
+
+
diff --git a/gcc/testsuite/gfortran.dg/equiv_constraint_5.f90 b/gcc/testsuite/gfortran.dg/equiv_constraint_5.f90
new file mode 100644
index 000000000..1f7dddc84
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_constraint_5.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-options "-O0" }
+! PR20902 - Overlapping initializers in an equivalence block must
+! have the same value.
+!
+! The code was replaced completely after the fix for PR30875, which
+! is a repeat of the original and comes from the same contributor.
+! The fix for 20902 was wrong.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+  TYPE T1
+    sequence
+    integer :: i=1
+  END TYPE T1
+  TYPE T2           ! OK because initializers are equal
+    sequence
+    integer :: i=1
+  END TYPE T2
+  TYPE T3
+    sequence
+    integer :: i=2 ! { dg-error "Overlapping unequal initializers" }
+  END TYPE T3
+  TYPE(T1) :: a1
+  TYPE(T2) :: a2
+  TYPE(T3) :: a3
+  EQUIVALENCE (a1, a2)
+  EQUIVALENCE (a1, a3)
+  write(6, *) a1, a2, a3
+END
+
diff --git a/gcc/testsuite/gfortran.dg/equiv_constraint_6.f90 b/gcc/testsuite/gfortran.dg/equiv_constraint_6.f90
new file mode 100644
index 000000000..9cc4c9bbe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_constraint_6.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! PR16404 test 3 and PR20835 - Target cannot be equivalence object.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+  REAL :: A
+  REAL, TARGET :: B
+  EQUIVALENCE(A,B) ! { dg-error "conflicts with TARGET attribute" }
+END
+
diff --git a/gcc/testsuite/gfortran.dg/equiv_constraint_7.f90 b/gcc/testsuite/gfortran.dg/equiv_constraint_7.f90
new file mode 100644
index 000000000..080cdef54
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_constraint_7.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-O0" }
+! PR20890 - Equivalence cannot contain overlapping unequal initializers.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+! Started out being in BLOCK DATA; however, blockdata variables must be in
+! COMMON and therefore cannot have F95 style initializers....
+ MODULE DATA
+  INTEGER :: I=1,J=2  ! { dg-error "Overlapping unequal initializers" }
+  EQUIVALENCE(I,J)
+ END MODULE DATA
+ END
+! { dg-final { cleanup-modules "data" } }
diff --git a/gcc/testsuite/gfortran.dg/equiv_constraint_8.f90 b/gcc/testsuite/gfortran.dg/equiv_constraint_8.f90
new file mode 100644
index 000000000..1cb28b031
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_constraint_8.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-O0" }
+! PR20899 - Common block variables cannot be equivalenced in a pure procedure.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+common /z/ i
+contains
+pure integer function test(j)
+  integer, intent(in) :: j
+  common /z/ i
+  integer :: k
+  equivalence(i,k) ! { dg-error "EQUIVALENCE object in the pure" }
+  k=1 ! { dg-error "variable definition context" }
+  test=i*j
+end function test
+end
+
diff --git a/gcc/testsuite/gfortran.dg/equiv_constraint_9.f90 b/gcc/testsuite/gfortran.dg/equiv_constraint_9.f90
new file mode 100644
index 000000000..0e4e832c4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_constraint_9.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR fortran/34655
+!
+! Check for F2003's 5.5.2.5 Restrictions on common and equivalence
+! Test case contributed by Joost VandeVondele.
+!
+implicit none
+type data_type
+ sequence
+ integer :: I = 7
+end type data_type
+
+
+type data_type2
+ sequence
+ integer :: I
+end type data_type2
+
+type(data_type) :: dd, ff
+type(data_type2) :: gg
+integer :: j, k, m
+EQUIVALENCE(dd,J) ! { dg-error "with default initialization cannot be in EQUIVALENCE with a variable in COMMON" }
+EQUIVALENCE(ff,k)
+EQUIVALENCE(gg,m)
+COMMON /COM/ j
+COMMON /COM/ m
+END
diff --git a/gcc/testsuite/gfortran.dg/equiv_substr.f90 b/gcc/testsuite/gfortran.dg/equiv_substr.f90
new file mode 100644
index 000000000..bad3a3a20
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_substr.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! PR fortran/34557
+!
+! Substrings with space before '(' were not properly parsed.
+!
+implicit none
+character :: A(2,2)*2, B(2)*3, C*5
+equivalence (A (2,1) (1:1), B (1) (2:3), C (3:5))
+end
diff --git a/gcc/testsuite/gfortran.dg/erf.f90 b/gcc/testsuite/gfortran.dg/erf.f90
new file mode 100644
index 000000000..33d0ecc60
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/erf.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+!
+! Check whether ERF/ERFC take scalars and arrays as arguments (PR31760).
+!
+PROGRAM test_erf
+  REAL :: r = 0.0, ra(2) = (/ 0.0, 1.0 /)
+
+  r  = erf(r)
+  r  = erfc(r)
+
+  ra = erf(ra)
+  ra = erfc(ra)
+END PROGRAM
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/erf_2.F90 b/gcc/testsuite/gfortran.dg/erf_2.F90
new file mode 100644
index 000000000..c92f45b04
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/erf_2.F90
@@ -0,0 +1,55 @@
+! { dg-do run { xfail spu-*-* } }
+! { dg-options "-fno-range-check -ffree-line-length-none -O0" }
+! { dg-add-options ieee }
+!
+! XFAILed for SPU targets because our library implementation of
+! the double-precision erf/erfc functions is not accurate enough.
+!
+! Check that simplification functions and runtime library agree on ERF,
+! ERFC and ERFC_SCALED.
+
+program test
+  implicit none
+
+  interface check
+    procedure check_r4
+    procedure check_r8
+  end interface check
+
+  real(kind=4) :: x4
+  real(kind=8) :: x8
+
+#define CHECK(a) \
+  x8 = a ; x4 = a ; \
+  call check(erf(real(a,kind=8)), erf(x8)) ; \
+  call check(erf(real(a,kind=4)), erf(x4)) ; \
+  call check(erfc(real(a,kind=8)), erfc(x8)) ; \
+  call check(erfc(real(a,kind=4)), erfc(x4)) ; \
+  call check(erfc_scaled(real(a,kind=8)), erfc_scaled(x8)) ; \
+  call check(erfc_scaled(real(a,kind=4)), erfc_scaled(x4)) ;
+
+  CHECK(0.0)
+  CHECK(0.9)
+  CHECK(1.9)
+  CHECK(19.)
+  CHECK(190.)
+
+  CHECK(-0.0)
+  CHECK(-0.9)
+  CHECK(-1.9)
+  CHECK(-19.)
+  CHECK(-190.)
+
+contains
+
+  subroutine check_r4 (a, b)
+    real(kind=4), intent(in) :: a, b
+    if (abs(a - b) > 10 * spacing(a)) call abort
+  end subroutine
+
+  subroutine check_r8 (a, b)
+    real(kind=8), intent(in) :: a, b
+    if (abs(a - b) > 10 * spacing(a)) call abort
+  end subroutine
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/erfc_scaled_1.f90 b/gcc/testsuite/gfortran.dg/erfc_scaled_1.f90
new file mode 100644
index 000000000..eeb54c829
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/erfc_scaled_1.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+!
+! { dg-options "" }
+! Do not run with -pedantic checks enabled as "check"
+! contains internal procedures which is a vendor extension
+
+program test
+  implicit none
+
+  interface check
+    procedure check_r4
+    procedure check_r8
+  end interface check
+
+  real(kind=4) :: x4
+  real(kind=8) :: x8
+
+  x8 = 1.9_8 ; x4 = 1.9_4
+
+  call check(erfc_scaled(x8), erfc_scaled(1.9_8))
+  call check(erfc_scaled(x4), erfc_scaled(1.9_4))
+
+contains
+  subroutine check_r4 (a, b)
+    real(kind=4), intent(in) :: a, b
+    if (abs(a - b) > 1.e-5 * abs(b)) call abort
+  end subroutine
+  subroutine check_r8 (a, b)
+    real(kind=8), intent(in) :: a, b
+    if (abs(a - b) > 1.e-7 * abs(b)) call abort
+  end subroutine
+end program test
diff --git a/gcc/testsuite/gfortran.dg/erfc_scaled_2.f90 b/gcc/testsuite/gfortran.dg/erfc_scaled_2.f90
new file mode 100644
index 000000000..97fa91fb9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/erfc_scaled_2.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+!
+! Check that ERFC_SCALED can be used in initialization expressions
+  real, parameter :: r = 100*erfc_scaled(12.7)
+  integer(kind=int(r)) :: i
+
+  real(kind=8), parameter :: r8 = 100*erfc_scaled(6.77)
+  integer(kind=int(r8)) :: j
+
+  i = 12
+  j = 8
+  print *, i, j
+
+  end
diff --git a/gcc/testsuite/gfortran.dg/error_format.f90 b/gcc/testsuite/gfortran.dg/error_format.f90
new file mode 100644
index 000000000..227a3e0c8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/error_format.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! { dg-shouldfail "Runtime error format check" }
+! PR32456 IO error message should show Unit/Filename
+program test
+  implicit none
+  integer :: i
+  open(99, status="scratch")
+  read(99,*) i
+end program
+! { dg-output ".*(unit = 99, file = .*)" }
+! { dg-output "Fortran runtime error: End of file" }
diff --git a/gcc/testsuite/gfortran.dg/error_recovery_1.f90 b/gcc/testsuite/gfortran.dg/error_recovery_1.f90
new file mode 100644
index 000000000..8d4f65baf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/error_recovery_1.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! PR fortran/24549 (and duplicate PR fortran/27487)
+module gfcbug29_import
+  interface
+     subroutine foo (x)
+       something :: dp ! { dg-error "Unclassifiable statement" }
+       real (kind=dp) :: x ! { dg-error "has not been declared or is a variable, which does not reduce to a constant expression" }
+     end subroutine foo
+  end interface
+end module gfcbug29_import
+
+subroutine FOO
+    X :: I ! { dg-error "Unclassifiable statement" }
+    equivalence (I,I)
+end
diff --git a/gcc/testsuite/gfortran.dg/error_recovery_2.f90 b/gcc/testsuite/gfortran.dg/error_recovery_2.f90
new file mode 100644
index 000000000..445b0b777
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/error_recovery_2.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! PR27954 Internal compiler error on bad statements
+! Derived from test case submitted in PR.
+subroutine bad1
+  character*20 :: y, x 00  ! { dg-error "Syntax error" }
+  data  y /'abcdef'/, x /'jbnhjk'/ pp  ! { dg-error "Syntax error" }
+end subroutine bad1
+
+subroutine bad2
+  character*20 :: y, x 00  ! { dg-error "Syntax error" }
+  data  y /'abcdef'/, x /'jbnhjk'/ pp  ! { dg-error "Syntax error" }
+  print *, "basket case."
+end subroutine bad2
+
+subroutine bad3
+  implicit none
+  character*20 :: y, x 00  ! { dg-error "Syntax error" }
+  data  y /'abcdef'/, x /'jbnhjk'/ pp  ! { dg-error "Syntax error" }
+  print *, "basket case that segfaults without patch."
+end subroutine bad3
+
diff --git a/gcc/testsuite/gfortran.dg/error_recovery_3.f90 b/gcc/testsuite/gfortran.dg/error_recovery_3.f90
new file mode 100644
index 000000000..b1da9cbba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/error_recovery_3.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! PR30779 incomplete file triggers ICE.
+! Note: This file is deliberately cut short to verify a graceful exit. Before
+! the patch this gave ICE.
+MODULE M1
+ INTEGER :: I
+END MODULE M1
+
+USE M1,                    ONLY: I,&! { dg-error "Missing" }
+! { dg-final { cleanup-modules "M1" } }
+
diff --git a/gcc/testsuite/gfortran.dg/error_recovery_4.f90 b/gcc/testsuite/gfortran.dg/error_recovery_4.f90
new file mode 100644
index 000000000..31e0e3b9a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/error_recovery_4.f90
@@ -0,0 +1,5 @@
+! { dg-do compile }
+! PR33609 ICE on arithmetic overflow
+! Before patch, this segfaulted.
+print *, real(huge(1.0_8),4) ! { dg-error "Arithmetic overflow" }
+end
diff --git a/gcc/testsuite/gfortran.dg/error_recovery_5.f90 b/gcc/testsuite/gfortran.dg/error_recovery_5.f90
new file mode 100644
index 000000000..88acf93cc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/error_recovery_5.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! PR34411 hang-up during read of non-expected input
+! Test case derived from that given in PR
+! Prior to patch, the do loop was infinite, limits set in this one
+program pr34411
+  real :: x,y
+  ii = 0
+  iostat = 0
+  x = 0.0; y= 0.0
+  open (10, status="scratch")
+  write (10, '(a)')" 289  329.142  214.107   12.313   12.050   11.913   11.868"
+  write (10, '(a)')"  2038.497 99.99  0.00   0.019    0.021    0.025    0.034"
+  write (10, '(a)')""
+  write (10, '(a)')" 413  360.334  245.261   12.375   11.910   11.469   11.086"
+  write (10, '(a)')"  2596.395 99.99  0.00   0.019    0.017    0.016    0.015" 
+  write (10, '(a)')""
+  write (10, '(a)')" 655  332.704  317.964   12.523   12.212   11.998   11.892"
+  write (10, '(a)')"  1627.586 99.99  0.00   0.005    0.005    0.006    0.007"
+  write (10, '(a)')""
+  write (10, '(a)')" 360  379.769  231.226   12.709   12.422   12.195   11.941"
+  write (10, '(a)')"  2561.539 99.99  0.00   0.042    0.043    0.050    0.055"
+  rewind 10
+  do i = 1,100
+     read(10,'(T7,2F9.3)', iostat=ii, end=666) x,y
+  end do
+666 continue
+  if (i /= 12) call abort
+  if (x /= 379.76901 .and. y /= 231.22600) call abort
+  close(10)
+end program pr34411
diff --git a/gcc/testsuite/gfortran.dg/error_stop_1.f08 b/gcc/testsuite/gfortran.dg/error_stop_1.f08
new file mode 100644
index 000000000..80a19b1e7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/error_stop_1.f08
@@ -0,0 +1,5 @@
+! { dg-do run }
+program stopper
+  real, dimension(5,5,5) :: i
+  error stop size(i) ! { dg-shouldfail "ERROR STOP 125" }
+end program stopper
diff --git a/gcc/testsuite/gfortran.dg/error_stop_2.f08 b/gcc/testsuite/gfortran.dg/error_stop_2.f08
new file mode 100644
index 000000000..8e3e71159
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/error_stop_2.f08
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! PR44371 STOP parsing rejects valid code.
+  real, dimension(5,5,5) :: i
+  character(1) c, y
+  y = 'y'
+  read(y,*) c
+  if (c=='x') stop; if (c=='X') stop
+  if (c=='x') stop size(i); if (c=='X') stop
+
+  if (c=='y') stop size(i) if (c=='Y') stop ! { dg-error "Syntax error in STOP" }
+  end
diff --git a/gcc/testsuite/gfortran.dg/execute_command_line_1.f90 b/gcc/testsuite/gfortran.dg/execute_command_line_1.f90
new file mode 100644
index 000000000..faaa860c9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/execute_command_line_1.f90
@@ -0,0 +1,60 @@
+! { dg-do compile }
+!
+! Check that we accept all variants of the EXECUTE_COMMAND_LINE intrinsic.
+!
+  integer :: i, j
+  character(len=100) :: s
+
+  s = ""
+
+  call execute_command_line ("ls *.f90")
+
+  print *, "-----------------------------"
+
+  call execute_command_line ("sleep 1 ; ls *.f90", .false.)
+  print *, "I'm not waiting"
+  call sleep(2)
+
+  print *, "-----------------------------"
+
+  call execute_command_line ("sleep 1 ; ls *.f90", .true.)
+  print *, "I did wait"
+  call sleep(2)
+
+  print *, "-----------------------------"
+
+  call execute_command_line ("ls *.f90", .true., i)
+  print *, "Exist status was: ", i
+
+  print *, "-----------------------------"
+
+  call execute_command_line ("ls *.doesnotexist", .true., i)
+  print *, "Exist status was: ", i
+
+  print *, "-----------------------------"
+
+  call execute_command_line ("echo foo", .true., i, j)
+  print *, "Exist status was: ", i
+  print *, "Command status was: ", j
+
+  print *, "-----------------------------"
+
+  call execute_command_line ("echo foo", .true., i, j, s)
+  print *, "Exist status was: ", i
+  print *, "Command status was: ", j
+  print *, "Error message is: ", trim(s)
+
+  print *, "-----------------------------"
+
+  call execute_command_line ("ls *.doesnotexist", .true., i, j, s)
+  print *, "Exist status was: ", i
+  print *, "Command status was: ", j
+  print *, "Error message is: ", trim(s)
+
+  print *, "-----------------------------"
+
+  call execute_command_line ("sleep 20", .false.)
+  print *, "Please kill me with ^C"
+  call sleep (10)
+
+  end
diff --git a/gcc/testsuite/gfortran.dg/exit_1.f08 b/gcc/testsuite/gfortran.dg/exit_1.f08
new file mode 100644
index 000000000..9ebc2eccb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/exit_1.f08
@@ -0,0 +1,50 @@
+! { dg-do run }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+
+! PR fortran/44709
+! Check that exit and cycle from within a BLOCK works for loops as expected.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER :: i
+  
+  ! Simple exit without loop name.
+  DO
+    BLOCK
+      EXIT
+    END BLOCK
+    CALL abort ()
+  END DO
+
+  ! Cycle without loop name.
+  DO i = 1, 1
+    BLOCK
+      CYCLE
+    END BLOCK
+    CALL abort ()
+  END DO
+
+  ! Exit loop by name from within a BLOCK.
+  loop1: DO
+    DO
+      BLOCK
+        EXIT loop1
+      END BLOCK
+      CALL abort ()
+    END DO
+    CALL abort ()
+  END DO loop1
+
+  ! Cycle loop by name from within a BLOCK.
+  loop2: DO i = 1, 1
+    loop3: DO
+      BLOCK
+        CYCLE loop2
+      END BLOCK
+      CALL abort ()
+    END DO loop3
+    CALL abort ()
+  END DO loop2
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/exit_2.f08 b/gcc/testsuite/gfortran.dg/exit_2.f08
new file mode 100644
index 000000000..9b383f03b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/exit_2.f08
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+
+! PR fortran/44709
+! Check that the resolving of loop names in parent namespaces introduced to
+! handle intermediate BLOCK's does not go too far and other sanity checks.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+  
+  EXIT ! { dg-error "is not within a construct" }
+  EXIT foobar ! { dg-error "is unknown" }
+  EXIT main ! { dg-error "is not a construct name" }
+
+  mainLoop: DO
+    CALL test ()
+  END DO mainLoop
+
+  otherLoop: DO
+    EXIT mainLoop ! { dg-error "is not within construct 'mainloop'" }
+  END DO otherLoop
+
+CONTAINS
+
+  SUBROUTINE test ()
+    EXIT mainLoop ! { dg-error "is unknown" }
+  END SUBROUTINE test
+
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/exit_3.f08 b/gcc/testsuite/gfortran.dg/exit_3.f08
new file mode 100644
index 000000000..732497b6d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/exit_3.f08
@@ -0,0 +1,88 @@
+! { dg-do run }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+
+! PR fortran/44602
+! Check for correct behaviour of EXIT / CYCLE combined with non-loop
+! constructs at run-time.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  TYPE :: t
+  END TYPE t
+
+  INTEGER :: i
+  CLASS(t), ALLOCATABLE :: var
+
+  ! EXIT and CYCLE without names always refer to innermost *loop*.  This
+  ! however is checked at run-time already in exit_1.f08.
+
+  ! Basic EXITs from different non-loop constructs.
+
+  i = 2
+  myif: IF (i == 1) THEN
+    CALL abort ()
+    EXIT myif
+  ELSE IF (i == 2) THEN
+    EXIT myif
+    CALL abort ()
+  ELSE
+    CALL abort ()
+    EXIT myif
+  END IF myif
+
+  mysel: SELECT CASE (i)
+    CASE (1)
+      CALL abort ()
+      EXIT mysel
+    CASE (2)
+      EXIT mysel
+      CALL abort ()
+    CASE DEFAULT
+      CALL abort ()
+      EXIT mysel
+  END SELECT mysel
+
+  mycharsel: SELECT CASE ("foobar")
+    CASE ("abc")
+      CALL abort ()
+      EXIT mycharsel
+    CASE ("xyz")
+      CALL abort ()
+      EXIT mycharsel
+    CASE DEFAULT
+      EXIT mycharsel
+      CALL abort ()
+  END SELECT mycharsel
+
+  myblock: BLOCK
+    EXIT myblock
+    CALL abort ()
+  END BLOCK myblock
+
+  myassoc: ASSOCIATE (x => 5 + 2)
+    EXIT myassoc
+    CALL abort ()
+  END ASSOCIATE myassoc
+
+  ALLOCATE (t :: var)
+  mytypesel: SELECT TYPE (var)
+    TYPE IS (t)
+      EXIT mytypesel
+      CALL abort ()
+    CLASS DEFAULT
+      CALL abort ()
+      EXIT mytypesel
+  END SELECT mytypesel
+
+  ! Check EXIT with nested constructs.
+  outer: BLOCK
+    inner: IF (.TRUE.) THEN
+      EXIT outer
+      CALL abort ()
+    END IF inner
+    CALL abort ()
+  END BLOCK outer
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/exit_4.f08 b/gcc/testsuite/gfortran.dg/exit_4.f08
new file mode 100644
index 000000000..8033efc47
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/exit_4.f08
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! { dg-options "-std=f2008 -fcoarray=single" }
+
+! PR fortran/44602
+! Check for compile-time errors with non-loop EXITs.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER :: bar(2)
+
+  ! Must not exit CRITICAL.
+  mycrit: CRITICAL
+    EXIT mycrit ! { dg-error "leaves CRITICAL" }
+  END CRITICAL mycrit
+
+  ! CYCLE is only allowed for loops!
+  myblock: BLOCK
+    CYCLE myblock ! { dg-error "is not applicable to non-loop construct 'myblock'" }
+  END BLOCK myblock
+
+  ! Invalid construct.
+  ! Thanks to Mikael Morin, mikael.morin@sfr.fr.
+  baz: WHERE ([ .true., .true. ])
+    bar = 0
+    EXIT baz ! { dg-error "is not applicable to construct 'baz'" }
+  END WHERE baz
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/exit_5.f03 b/gcc/testsuite/gfortran.dg/exit_5.f03
new file mode 100644
index 000000000..3129b4743
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/exit_5.f03
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! PR fortran/44602
+! Check for F2008 rejection of non-loop EXIT.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  myname: IF (.TRUE.) THEN
+    EXIT myname ! { dg-error "Fortran 2008" }
+  END IF myname
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/exponent_1.f90 b/gcc/testsuite/gfortran.dg/exponent_1.f90
new file mode 100644
index 000000000..9f701e82b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/exponent_1.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! PR fortran/28276
+! Original code submitted by Harald Anlauf
+! Converted to Dejagnu for the testsuite by Steven G. Kargl
+!
+program gfcbug36
+  implicit none
+  real, parameter :: one = 1.0
+  real :: a = one
+
+  if (fraction(a) /= 0.5) call abort
+  if (fraction(one) /= 0.5) call abort
+  if (fraction(1.0) /= 0.5) call abort
+
+  if (exponent(a) /= 1.0) call abort
+  if (exponent(one) /= 1.0) call abort
+  if (exponent (1.0) /= 1.0) call abort
+
+  if (scale(fraction(a),   exponent(a))   / a   /= 1.) call abort
+  if (scale(fraction(one), exponent(one)) / one /= 1.) call abort
+  if (scale(fraction(1.0), exponent(1.0)) / 1.0 /= 1.) call abort
+
+end program gfcbug36
diff --git a/gcc/testsuite/gfortran.dg/exponent_2.f90 b/gcc/testsuite/gfortran.dg/exponent_2.f90
new file mode 100644
index 000000000..1b917066c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/exponent_2.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! { dg-options "-fdefault-integer-8" }
+! PR fortran/32942
+! Testcase contributed by Dominique d'Humieres <dominiq@lps.ens.fr>.
+integer i
+real x
+x = 3.0
+if (2 /= exponent(x)) call abort
+i = exponent (x)
+if (i /= 2) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/extended_char_comparison_1.f b/gcc/testsuite/gfortran.dg/extended_char_comparison_1.f
new file mode 100644
index 000000000..b3d7c0456
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extended_char_comparison_1.f
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR 27715 - the front end and the library used to have different ideas
+! about ordering for characters whose encoding is above 127.
+
+      program main
+      character*1 c1, c2
+      logical a1, a2
+      c1 = 'ç';
+      c2 = 'c';
+      a1 = c1 > c2;
+      call setval(c1, c2)
+      a2 = c1 > c2
+      if (a1 .neqv. a2) call abort
+      end
+
+      subroutine setval(c1, c2)
+      character*1 c1, c2
+      c1 = 'ç';
+      c2 = 'c';
+      end
diff --git a/gcc/testsuite/gfortran.dg/extends_1.f03 b/gcc/testsuite/gfortran.dg/extends_1.f03
new file mode 100644
index 000000000..57a50732c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_1.f03
@@ -0,0 +1,73 @@
+! { dg-do run }
+! A basic functional test of derived type extension.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module persons
+  type :: person
+    character(24) :: name = ""
+    integer :: ss = 1
+  end type person
+end module persons
+
+module person_education
+  use persons
+  type, extends(person) :: education
+    integer ::  attainment = 0
+    character(24) :: institution = ""
+  end type education
+end module person_education
+
+  use person_education
+  type, extends(education) :: service
+    integer :: personnel_number = 0
+    character(24) :: department = ""
+  end type service
+  
+  type, extends(service) :: person_record
+    type (person_record), pointer :: supervisor => NULL ()
+  end type person_record
+  
+  type(person_record), pointer :: recruit, supervisor
+  
+! Check that references by ultimate component work
+
+  allocate (supervisor)
+  supervisor%name = "Joe Honcho"
+  supervisor%ss = 123455
+  supervisor%attainment = 100
+  supervisor%institution = "Celestial University"
+  supervisor%personnel_number = 1
+  supervisor%department = "Directorate"
+
+  recruit => entry ("John Smith", 123456, 1, "Bog Hill High School", &
+                    99, "Records", supervisor)
+
+  if (trim (recruit%name) /= "John Smith") call abort
+  if (recruit%name /= recruit%service%name) call abort
+  if (recruit%supervisor%ss /= 123455) call abort
+  if (recruit%supervisor%ss /= supervisor%person%ss) call abort
+
+  deallocate (supervisor)
+  deallocate (recruit)
+contains
+  function entry (name, ss, attainment, institution, &
+                  personnel_number, department, supervisor) result (new_person)
+    integer :: ss, attainment, personnel_number
+    character (*) :: name, institution, department
+    type (person_record), pointer :: supervisor, new_person
+
+    allocate (new_person)
+
+! Check mixtures of references
+    new_person%person%name = name
+    new_person%service%education%person%ss = ss
+    new_person%service%attainment = attainment
+    new_person%education%institution = institution
+    new_person%personnel_number = personnel_number
+    new_person%service%department = department
+    new_person%supervisor => supervisor
+  end function
+end
+
+! { dg-final { cleanup-modules "persons person_education" } }
diff --git a/gcc/testsuite/gfortran.dg/extends_10.f03 b/gcc/testsuite/gfortran.dg/extends_10.f03
new file mode 100644
index 000000000..fbcaa7efc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_10.f03
@@ -0,0 +1,34 @@
+! { dg-do compile }
+!
+! PR 42545: type extension: parent component has wrong accessibility
+!
+! Reported by Reinhold Bader <bader@lrz.de>
+
+module mo
+  implicit none
+  type :: t1
+    integer :: i = 1
+  end type
+  type, extends(t1) :: t2
+    private
+    real :: x = 2.0
+  end type
+  type :: u1
+    integer :: j = 1
+  end type
+  type, extends(u1) :: u2
+    real :: y = 2.0
+  end type
+  private :: u1
+end module
+
+program pr
+  use mo
+  implicit none
+  type(t2) :: a
+  type(u2) :: b
+  print *,a%t1%i
+  print *,b%u1%j  ! { dg-error "is a PRIVATE component of" }
+end program
+
+! { dg-final { cleanup-modules "mo" } }
diff --git a/gcc/testsuite/gfortran.dg/extends_11.f03 b/gcc/testsuite/gfortran.dg/extends_11.f03
new file mode 100644
index 000000000..58bde73ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_11.f03
@@ -0,0 +1,41 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/45586
+! Test that access to inherited components are properly generated
+!
+! Stripped down from extends_1.f03
+!
+  type :: person
+    integer :: ss = 1
+  end type person
+
+  type, extends(person) :: education
+    integer ::  attainment = 0
+  end type education
+
+  type, extends(education) :: service
+    integer :: personnel_number = 0
+  end type service
+
+  type, extends(service) :: person_record
+    type (person_record), pointer :: supervisor => NULL ()
+  end type person_record
+  
+  type(person_record) :: recruit
+  
+
+  ! Check that references by ultimate component and by parent type work
+  ! All the following component access are equivalent
+  recruit%ss = 2
+  recruit%person%ss = 3
+  recruit%education%ss = 4
+  recruit%education%person%ss = 5
+  recruit%service%ss = 6
+  recruit%service%person%ss = 7
+  recruit%service%education%ss = 8
+  recruit%service%education%person%ss = 9
+end
+
+! { dg-final { scan-tree-dump-times " +recruit\\.service\\.education\\.person\\.ss =" 8 "original"} }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/extends_12.f03 b/gcc/testsuite/gfortran.dg/extends_12.f03
new file mode 100644
index 000000000..a93f6d0f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_12.f03
@@ -0,0 +1,24 @@
+! { dg-do compile }
+!
+! PR 48706: Type extension inside subroutine
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+module mod_diff_01
+  implicit none
+  type :: foo
+  end type
+contains
+  subroutine create_ext
+    type, extends(foo) :: foo_e
+    end type
+  end subroutine
+end module
+
+program diff_01
+  use mod_diff_01
+  implicit none
+  call create_ext()
+end program
+
+! { dg-final { cleanup-modules "mod_diff_01" } }
diff --git a/gcc/testsuite/gfortran.dg/extends_13.f03 b/gcc/testsuite/gfortran.dg/extends_13.f03
new file mode 100644
index 000000000..5d986877d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_13.f03
@@ -0,0 +1,30 @@
+! { dg-do compile }
+!
+! PR 47601: [OOP] Internal Error: mio_component_ref(): Component not found
+!
+! Contributed by Rich Townsend <townsend@astro.wisc.edu>
+
+module type_definitions
+  implicit none
+  type :: matching 
+     integer :: n = -999
+  end type
+  type, extends(matching) :: ellipse
+  end type
+end module type_definitions
+
+module elliptical_elements
+  implicit none
+contains
+  function line(e) result(a2n)
+    use type_definitions
+    type(ellipse), intent(in) :: e
+    complex, dimension(e%N) :: a2n   ! <- change "e%N" to "10" 
+  end function line
+end module
+
+  use type_definitions
+  use elliptical_elements
+end
+
+! { dg-final { cleanup-modules "type_definitions elliptical_elements" } }
diff --git a/gcc/testsuite/gfortran.dg/extends_14.f03 b/gcc/testsuite/gfortran.dg/extends_14.f03
new file mode 100644
index 000000000..876e8c703
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_14.f03
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR 49466: [4.6/4.7 Regression] Memory leak with assignment of extended derived types
+!
+! Contributed by Rich Townsend <townsend@astro.wisc.edu>
+
+program evolve_aflow
+
+  implicit none
+
+  type :: state_t
+     real, allocatable :: U(:)
+  end type
+
+  type, extends(state_t) :: astate_t
+  end type
+
+  type(astate_t) :: a,b
+
+  allocate(a%U(1000))
+
+  a = b
+
+end program 
+
+! { dg-final { scan-tree-dump-times "__builtin_free" 3 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/extends_2.f03 b/gcc/testsuite/gfortran.dg/extends_2.f03
new file mode 100644
index 000000000..aabbf662a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_2.f03
@@ -0,0 +1,66 @@
+! { dg-do run }
+! A test of f95 style constructors with derived type extension.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module persons
+  type :: person
+    character(24) :: name = ""
+    integer :: ss = 1
+  end type person
+end module persons
+
+module person_education
+  use persons
+  type, extends(person) :: education
+    integer ::  attainment = 0
+    character(24) :: institution = ""
+  end type education
+end module person_education
+
+  use person_education
+  type, extends(education) :: service
+    integer :: personnel_number = 0
+    character(24) :: department = ""
+  end type service
+
+  type, extends(service) :: person_record
+    type (person_record), pointer :: supervisor => NULL ()
+  end type person_record
+
+  type(person_record), pointer :: recruit, supervisor
+
+! Check that simple constructor works
+  allocate (supervisor)
+  supervisor%service = service ("Joe Honcho", 123455, 100, &
+                                "Celestial University", 1, &
+                                "Directorate")
+
+  recruit => entry ("John Smith", 123456, 1, "Bog Hill High School", &
+                    99, "Records", supervisor)
+
+  if (trim (recruit%name) /= "John Smith") call abort
+  if (recruit%name /= recruit%service%name) call abort
+  if (recruit%supervisor%ss /= 123455) call abort
+  if (recruit%supervisor%ss /= supervisor%person%ss) call abort
+
+  deallocate (supervisor)
+  deallocate (recruit)
+contains
+  function entry (name, ss, attainment, institution, &
+                  personnel_number, department, supervisor) result (new_person)
+    integer :: ss, attainment, personnel_number
+    character (*) :: name, institution, department
+    type (person_record), pointer :: supervisor, new_person
+
+    allocate (new_person)
+
+! Check nested constructors
+    new_person = person_record (education (person (name, ss), &
+                                attainment, institution), &
+                                personnel_number, department, &
+                                supervisor)
+  end function
+end
+
+! { dg-final { cleanup-modules "persons person_education" } }
diff --git a/gcc/testsuite/gfortran.dg/extends_3.f03 b/gcc/testsuite/gfortran.dg/extends_3.f03
new file mode 100644
index 000000000..27ae670d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_3.f03
@@ -0,0 +1,71 @@
+! { dg-do run }
+! A test of f2k style constructors with derived type extension.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module persons
+  type :: person
+    character(24) :: name = ""
+    integer :: ss = 1
+  end type person
+end module persons
+
+module person_education
+  use persons
+  type, extends(person) :: education
+    integer ::  attainment = 0
+    character(24) :: institution = ""
+  end type education
+end module person_education
+
+  use person_education
+  type, extends(education) :: service
+    integer :: personnel_number = 0
+    character(24) :: department = ""
+  end type service
+
+  type, extends(service) :: person_record
+    type (person_record), pointer :: supervisor => NULL ()
+  end type person_record
+
+  type(person_record), pointer :: recruit, supervisor
+  
+! Check that F2K constructor with missing entries works
+  allocate (supervisor)
+  supervisor%service = service (NAME = "Joe Honcho", SS= 123455)
+
+  recruit => entry ("John Smith", 123456, 1, "Bog Hill High School", &
+                    99, "Records", supervisor)
+
+  if (supervisor%ss /= 123455) call abort
+  if (trim (supervisor%name) /= "Joe Honcho") call abort
+  if (trim (supervisor%institution) /= "") call abort
+  if (supervisor%attainment /= 0) call abort
+
+  if (trim (recruit%name) /= "John Smith") call abort
+  if (recruit%name /= recruit%service%name) call abort
+  if (recruit%supervisor%ss /= 123455) call abort
+  if (recruit%supervisor%ss /= supervisor%person%ss) call abort
+
+  deallocate (supervisor)
+  deallocate (recruit)
+contains
+  function entry (name, ss, attainment, institution, &
+                  personnel_number, department, supervisor) result (new_person)
+    integer :: ss, attainment, personnel_number
+    character (*) :: name, institution, department
+    type (person_record), pointer :: supervisor, new_person
+
+    allocate (new_person)
+
+! Check F2K constructor with order shuffled a bit
+    new_person = person_record (NAME = name, SS =ss, &
+                                DEPARTMENT = department, &
+                                INSTITUTION = institution, &
+                                PERSONNEL_NUMBER = personnel_number, &
+                                ATTAINMENT = attainment, &
+                                SUPERVISOR = supervisor)
+  end function
+end
+
+! { dg-final { cleanup-modules "persons person_education" } }
diff --git a/gcc/testsuite/gfortran.dg/extends_4.f03 b/gcc/testsuite/gfortran.dg/extends_4.f03
new file mode 100644
index 000000000..941a66392
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_4.f03
@@ -0,0 +1,52 @@
+! { dg-do run }
+! Check that derived type extension is compatible with renaming
+! the parent type and that allocatable components are OK.  At
+! the same time, private type and components are checked.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module mymod
+  type :: a
+    real, allocatable :: x(:)
+    integer, private :: ia = 0
+  end type a
+  type :: b
+    private
+    real, allocatable :: x(:)
+    integer :: i
+  end type b
+contains
+  function set_b () result (res)
+    type(b) :: res
+    allocate (res%x(2))
+    res%x = [10.0, 20.0]
+    res%i = 1
+  end function
+  subroutine check_b (arg)
+    type(b) :: arg
+    if (any (arg%x /= [10.0, 20.0])) call abort
+    if (arg%i /= 1) call abort
+  end subroutine
+end module mymod
+
+  use mymod, e => a
+  type, extends(e) :: f
+    integer :: if
+  end type f
+  type, extends(b) :: d
+    integer :: id
+  end type d
+
+  type(f) :: p
+  type(d) :: q
+
+  p = f (x = [1.0, 2.0], if = 3)
+  if (any (p%e%x /= [1.0, 2.0])) call abort
+
+  q%b = set_b ()
+  call check_b (q%b)
+  q = d (b = set_b (), id = 99)
+  call check_b (q%b)
+end
+
+! { dg-final { cleanup-modules "persons person_education" } }
diff --git a/gcc/testsuite/gfortran.dg/extends_5.f03 b/gcc/testsuite/gfortran.dg/extends_5.f03
new file mode 100644
index 000000000..5146d4563
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_5.f03
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! Some errors for derived type extension.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module m
+  use iso_c_binding
+  type :: date
+    sequence
+    integer :: yr, mon
+    integer,public :: day
+  end type
+  type, bind(c) :: dt
+    integer(c_int) :: yr, mon
+    integer(c_int) :: day
+  end type
+end module m
+
+  use m
+  type, extends(date) :: datetime ! { dg-error "because it is a SEQUENCE type" }
+  end type ! { dg-error "Expecting END PROGRAM" }
+
+  type, extends(dt) :: dt_type ! { dg-error "because it is BIND" }
+  end type ! { dg-error "Expecting END PROGRAM" }
+end
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/extends_6.f03 b/gcc/testsuite/gfortran.dg/extends_6.f03
new file mode 100644
index 000000000..a50a9b751
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_6.f03
@@ -0,0 +1,49 @@
+! { dg-do compile }
+! Some errors pointed out in the development of the patch.
+!
+! Contributed by Tobias Burnus  <burnus@net-b.de>
+!
+module m
+  type :: date
+    private
+    integer :: yr, mon
+    integer,public :: day
+  end type
+  type :: dt
+    integer :: yr, mon
+    integer :: day
+  end type
+end module m
+
+  use m
+  type, extends(date) :: datetime
+    integer :: hr, min, sec
+  end type
+  type(datetime) :: o_dt
+
+  type :: one
+    integer :: i
+  end type one
+
+  type, extends(one) :: two
+    real :: r
+  end type two
+
+  o_dt%day = 5  ! VALID but failed in first version of EXTENDS patch
+  o_dt%yr  = 5  ! { dg-error "is a PRIVATE component of" }
+
+  t = two(one = one(4), i = 5, r=4.4) ! { dg-error "has already been set" }
+
+  call foo
+contains
+  subroutine foo
+    use m, date_type => dt
+    type, extends(date_type) :: dt_type
+    end type
+    type (dt_type) :: foo_dt
+    foo_dt%date_type%day = 1
+    foo_dt%dt%day = 1 ! { dg-error "not a member" }
+  end subroutine
+end
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/extends_7.f03 b/gcc/testsuite/gfortran.dg/extends_7.f03
new file mode 100644
index 000000000..ebb2fcc3e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_7.f03
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! Check for re-definition of inherited components in the sub-type.
+
+MODULE m1
+  IMPLICIT NONE
+
+  TYPE supert
+    INTEGER :: c1
+    INTEGER, PRIVATE :: c2
+  END TYPE supert
+
+END MODULE m1
+
+MODULE m2
+  USE m1 ! { dg-error "already in the parent type" }
+  IMPLICIT NONE
+
+  TYPE, EXTENDS(supert) :: subt
+    INTEGER :: c1 ! { dg-error "already in the parent type" }
+    INTEGER :: c2 ! { dg-error "already in the parent type" }
+  END TYPE subt
+
+END MODULE m2
+
+! { dg-final { cleanup-modules "m1 m2" } }
diff --git a/gcc/testsuite/gfortran.dg/extends_8.f03 b/gcc/testsuite/gfortran.dg/extends_8.f03
new file mode 100644
index 000000000..4af5ab932
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_8.f03
@@ -0,0 +1,17 @@
+! { dg-do compile }
+!
+! PR 41784: [OOP] ICE in load_derived_extensions
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+module m
+  type  :: A
+  end type
+  type, extends(A) :: B
+  end type
+end module
+
+use m, only: A
+end
+ 
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/extends_9.f03 b/gcc/testsuite/gfortran.dg/extends_9.f03
new file mode 100644
index 000000000..f59b97396
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_9.f03
@@ -0,0 +1,36 @@
+! { dg-do compile }
+!
+! PR42257: [OOP] Compiler segmentation fault due missing public statement
+!
+! Contributed by Oystein Olsen <oystein.olsen@astro.uio.no>
+
+MODULE run_example_fortran03
+  IMPLICIT NONE
+  PRIVATE
+  PUBLIC :: epoch
+
+  INTEGER, PARAMETER :: I4B = SELECTED_INT_KIND(9)
+  INTEGER, PARAMETER :: DP = SELECTED_REAL_KIND(15,307)
+
+  TYPE epoch
+     INTEGER(I4B) :: i = 2451545
+     REAL(DP)     :: f = 0.5_DP
+  END TYPE
+
+  TYPE, EXTENDS(epoch) :: time
+     REAL(DP) :: t = 0.0_DP   
+  END TYPE
+END MODULE
+
+
+  USE  run_example_fortran03
+  IMPLICIT NONE
+
+  CLASS(epoch), ALLOCATABLE :: e4
+
+  ALLOCATE(epoch::e4)
+  WRITE(*,*) e4%i, e4%f
+
+END
+ 
+! { dg-final { cleanup-modules "run_example_fortran03" } }
diff --git a/gcc/testsuite/gfortran.dg/extends_type_of_1.f03 b/gcc/testsuite/gfortran.dg/extends_type_of_1.f03
new file mode 100644
index 000000000..9e983846c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_type_of_1.f03
@@ -0,0 +1,48 @@
+! { dg-do run }
+!
+! Verifying the runtime behavior of the intrinsic function EXTENDS_TYPE_OF.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+ implicit none
+
+ intrinsic :: extends_type_of
+
+ type :: t1
+   integer :: i = 42
+ end type
+
+ type, extends(t1) :: t2
+   integer :: j = 43
+ end type
+
+ type, extends(t2) :: t3
+   class(t1),pointer :: cc
+ end type
+
+ class(t1), pointer :: c1,c2
+ type(t1), target :: x
+ type(t2), target :: y
+ type(t3), target :: z
+ 
+ c1 => x
+ c2 => y
+ z%cc => y
+
+ if (.not. extends_type_of (c1, c1)) call abort()
+ if (      extends_type_of (c1, c2)) call abort()
+ if (.not. extends_type_of (c2, c1)) call abort()
+
+ if (.not. extends_type_of (x, x)) call abort()
+ if (      extends_type_of (x, y)) call abort()
+ if (.not. extends_type_of (y, x)) call abort()
+
+ if (.not. extends_type_of (c1, x)) call abort()
+ if (      extends_type_of (c1, y)) call abort()
+ if (.not. extends_type_of (x, c1)) call abort()
+ if (.not. extends_type_of (y, c1)) call abort()
+
+ if (.not. extends_type_of (z,   c1)) call abort()
+ if (      extends_type_of (z%cc, z)) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/extends_type_of_2.f03 b/gcc/testsuite/gfortran.dg/extends_type_of_2.f03
new file mode 100644
index 000000000..f882cb1c6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_type_of_2.f03
@@ -0,0 +1,36 @@
+! { dg-do run }
+!
+! PR 47180: [OOP] EXTENDS_TYPE_OF returns the wrong result for disassociated polymorphic pointers 
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+implicit none
+
+type t1
+  integer :: a
+end type t1
+
+type, extends(t1):: t11
+  integer :: b
+end type t11
+
+type(t1)  , target  :: a1
+type(t11) , target  :: a11
+class(t1) , pointer :: b1
+class(t11), pointer :: b11
+
+b1  => NULL()
+b11 => NULL()
+
+if (.not. extends_type_of(b1 , a1)) call abort()
+if (.not. extends_type_of(b11, a1)) call abort()
+if (.not. extends_type_of(b11,a11)) call abort()
+
+b1  => a1
+b11 => a11
+
+if (.not. extends_type_of(b1 , a1)) call abort()
+if (.not. extends_type_of(b11, a1)) call abort()
+if (.not. extends_type_of(b11,a11)) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/extends_type_of_3.f90 b/gcc/testsuite/gfortran.dg/extends_type_of_3.f90
new file mode 100644
index 000000000..346542fe5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/extends_type_of_3.f90
@@ -0,0 +1,111 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/41580
+!
+! Compile-time simplification of SAME_TYPE_AS
+! and EXTENDS_TYPE_OF.
+!
+
+implicit none
+type t1
+  integer :: a
+end type t1
+type, extends(t1):: t11
+  integer :: b
+end type t11
+type, extends(t11):: t111
+  integer :: c
+end type t111
+type t2
+  integer :: a
+end type t2
+
+type(t1) a1
+type(t11) a11
+type(t2) a2
+class(t1), allocatable :: b1
+class(t11), allocatable :: b11
+class(t2), allocatable :: b2
+
+logical, parameter :: p1 = same_type_as(a1,a2)  ! F
+logical, parameter :: p2 = same_type_as(a2,a1)  ! F
+logical, parameter :: p3 = same_type_as(a1,a11) ! F
+logical, parameter :: p4 = same_type_as(a11,a1) ! F
+logical, parameter :: p5 = same_type_as(a11,a11)! T
+logical, parameter :: p6 = same_type_as(a1,a1)  ! T
+
+if (p1 .or. p2 .or. p3 .or. p4 .or. .not. p5 .or. .not. p6) call should_not_exist()
+
+! Not (trivially) compile-time simplifiable:
+if (same_type_as(b1,a1)  .neqv. .true.) call abort()
+if (same_type_as(b1,a11) .neqv. .false.) call abort()
+allocate(t1 :: b1)
+if (same_type_as(b1,a1)  .neqv. .true.) call abort()
+if (same_type_as(b1,a11) .neqv. .false.) call abort()
+deallocate(b1)
+allocate(t11 :: b1)
+if (same_type_as(b1,a1)  .neqv. .false.) call abort()
+if (same_type_as(b1,a11) .neqv. .true.) call abort()
+deallocate(b1)
+
+! .true. -> same type
+if (extends_type_of(a1,a1)   .neqv. .true.) call should_not_exist()
+if (extends_type_of(a11,a11) .neqv. .true.) call should_not_exist()
+if (extends_type_of(a2,a2)   .neqv. .true.) call should_not_exist()
+
+! .false. -> type compatibility possible
+if (extends_type_of(a1,a2)  .neqv. .false.) call should_not_exist()
+if (extends_type_of(a2,a1)  .neqv. .false.) call should_not_exist()
+if (extends_type_of(a11,a2) .neqv. .false.) call should_not_exist()
+if (extends_type_of(a2,a11) .neqv. .false.) call should_not_exist()
+
+if (extends_type_of(b1,b2)  .neqv. .false.) call should_not_exist()
+if (extends_type_of(b2,b1)  .neqv. .false.) call should_not_exist()
+if (extends_type_of(b11,b2) .neqv. .false.) call should_not_exist()
+if (extends_type_of(b2,b11) .neqv. .false.) call should_not_exist()
+
+if (extends_type_of(b1,a2)  .neqv. .false.) call should_not_exist()
+if (extends_type_of(b2,a1)  .neqv. .false.) call should_not_exist()
+if (extends_type_of(b11,a2) .neqv. .false.) call should_not_exist()
+if (extends_type_of(b2,a11) .neqv. .false.) call should_not_exist()
+
+if (extends_type_of(a1,b2)  .neqv. .false.) call should_not_exist()
+if (extends_type_of(a2,b1)  .neqv. .false.) call should_not_exist()
+if (extends_type_of(a11,b2) .neqv. .false.) call should_not_exist()
+if (extends_type_of(a2,b11) .neqv. .false.) call should_not_exist()
+
+! type extension possible, compile-time checkable
+if (extends_type_of(a1,a11) .neqv. .false.) call should_not_exist()
+if (extends_type_of(a11,a1) .neqv. .true.) call should_not_exist()
+if (extends_type_of(a1,a11) .neqv. .false.) call should_not_exist()
+
+if (extends_type_of(b1,a1)   .neqv. .true.) call should_not_exist()
+if (extends_type_of(b11,a1)  .neqv. .true.) call should_not_exist()
+if (extends_type_of(b11,a11) .neqv. .true.) call should_not_exist()
+if (extends_type_of(b1,a11)  .neqv. .false.) call should_not_exist()
+
+if (extends_type_of(a1,b11)  .neqv. .false.) call abort()
+
+! Special case, simplified at tree folding:
+if (extends_type_of(b1,b1)   .neqv. .true.) call abort()
+
+! All other possibilities are not compile-time checkable
+if (extends_type_of(b11,b1)  .neqv. .true.) call abort()
+!if (extends_type_of(b1,b11)  .neqv. .false.) call abort() ! FAILS due to PR 47189
+if (extends_type_of(a11,b11) .neqv. .true.) call abort()
+allocate(t11 :: b11)
+if (extends_type_of(a11,b11) .neqv. .true.) call abort()
+deallocate(b11)
+allocate(t111 :: b11)
+if (extends_type_of(a11,b11) .neqv. .false.) call abort()
+deallocate(b11)
+allocate(t11 :: b1)
+if (extends_type_of(a11,b1) .neqv. .true.) call abort()
+deallocate(b1)
+
+end
+
+! { dg-final { scan-tree-dump-times "abort" 13 "original" } }
+! { dg-final { scan-tree-dump-times "should_not_exist" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/external_implicit_none.f90 b/gcc/testsuite/gfortran.dg/external_implicit_none.f90
new file mode 100644
index 000000000..43cfb2848
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/external_implicit_none.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! Tests fix for PR18737 - ICE on external symbol of unknown type.
+program test
+  implicit none
+  real(8) :: x
+  external bug  ! { dg-error "has no IMPLICIT type" }
+
+  x = 2
+  print *, bug(x)
+  
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/external_initializer.f90 b/gcc/testsuite/gfortran.dg/external_initializer.f90
new file mode 100644
index 000000000..eec240917
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/external_initializer.f90
@@ -0,0 +1,5 @@
+! { dg-do compile }
+! PR20849 - An external symbol may not have a initializer.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+REAL, EXTERNAL :: X=0 ! { dg-error "not have an initializer" }
+END
diff --git a/gcc/testsuite/gfortran.dg/external_procedures_1.f90 b/gcc/testsuite/gfortran.dg/external_procedures_1.f90
new file mode 100644
index 000000000..de273d52e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/external_procedures_1.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! This tests the patch for PR25024.
+
+! PR25024 - The external attribute for subroutine a would cause an ICE.
+  subroutine A ()
+    EXTERNAL A  ! { dg-error "EXTERNAL attribute conflicts with SUBROUTINE" }
+  END
+
+function ext (y)  ! { dg-error "EXTERNAL attribute conflicts with FUNCTION" }
+  real ext, y
+  external ext
+  !ext = y * y
+end function ext
+
+function ext1 (y)
+  real ext1, y
+  external z        ! OK no conflict
+  ext1 = y * y
+end function ext1
+
+program main
+  real ext, inval
+  external ext       ! OK, valid external reference.
+  external main      ! { dg-error "PROGRAM attribute conflicts with EXTERNAL" }
+  interface
+    function ext1 (y)
+      real ext1, y
+      external ext1
+    end function ext1  ! { dg-error "Duplicate EXTERNAL attribute" }
+  end interface
+  inval = 1.0
+  print *, ext(inval)
+  print *, ext1(inval)
+  print *, inv(inval)
+contains
+  function inv (y)  ! { dg-error "EXTERNAL attribute conflicts with FUNCTION" }
+    real inv, y
+    external inv
+    !inv = y * y * y
+  end function inv
+end program main
+
diff --git a/gcc/testsuite/gfortran.dg/external_procedures_2.f90 b/gcc/testsuite/gfortran.dg/external_procedures_2.f90
new file mode 100644
index 000000000..3f13dac3d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/external_procedures_2.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+! Tests the for PR30410, in which the reference to extfunc would
+! be incorrectly made to the module namespace.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+!
+module mod1
+contains
+  function eval (func, x1)
+    real     :: eval, func, x1
+    external :: func
+    eval = func (x1)
+  end function eval
+end module mod1
+!-------------------------------
+module mod2
+  use mod1, only : eval
+  real, external :: extfunc     ! This was referenced as __mod2__extfunc__
+contains
+
+  subroutine foo (x0)
+    real :: x0, x1
+    x1 = 42
+    x0 = eval (extfunc, x1)
+  end subroutine foo
+
+end module mod2
+!-------------------------------
+function extfunc (x)
+  real, intent(in) ::  x
+  real             ::  extfunc
+  extfunc = x
+end function extfunc
+!-------------------------------
+program gfcbug53
+  use mod2, only : foo
+  real :: x0 = 0
+  call foo (x0)
+  print *, x0
+end program gfcbug53
+! { dg-final { cleanup-modules "mod1 mod2" } }
diff --git a/gcc/testsuite/gfortran.dg/external_procedures_3.f90 b/gcc/testsuite/gfortran.dg/external_procedures_3.f90
new file mode 100644
index 000000000..987ba793c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/external_procedures_3.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+! Tests the fix for PR32926, in which the call to fcn
+! in bar would cause an ICE because it had not been referenced
+! in the namespace where it was declared.
+!
+! Contributed by Ralph Baker Kearfott <rbk@louisiana.edu>
+!
+subroutine foobar1
+  common // chr
+  character(8) :: chr
+  chr = "foobar1"
+end subroutine
+subroutine foobar2
+  common // chr
+  character(8) :: chr
+  chr = "foobar2"
+end subroutine
+
+subroutine foo (fcn)
+  external fcn
+  call bar
+contains
+  subroutine bar
+    call fcn
+  end subroutine bar
+end subroutine foo
+
+  external foo, foobar1, foobar2
+  common // chr
+  character(8) :: chr
+  call foo (foobar1)
+  if (chr .ne. "foobar1") call abort ()
+  call foo (foobar2)
+  if (chr .ne. "foobar2") call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/f2003_inquire_1.f03 b/gcc/testsuite/gfortran.dg/f2003_inquire_1.f03
new file mode 100644
index 000000000..544a8109a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2003_inquire_1.f03
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+character(25) :: sround, ssign, sasynchronous, sdecimal, sencoding
+integer :: vsize, vid
+logical :: vpending
+
+open(10, file='mydata', asynchronous="yes", blank="null", &
+& decimal="comma", encoding="utf-8", sign="plus")
+
+inquire(unit=10, round=sround, sign=ssign, size=vsize, id=vid, &
+& pending=vpending, asynchronous=sasynchronous, decimal=sdecimal, &
+& encoding=sencoding)
+
+if (ssign.ne."PLUS") call abort
+if (sasynchronous.ne."YES") call abort
+if (sdecimal.ne."COMMA") call abort
+if (sencoding.ne."UTF-8") call abort
+if (vpending) call abort
+
+close(10, status="delete")
+end
diff --git a/gcc/testsuite/gfortran.dg/f2003_io_1.f03 b/gcc/testsuite/gfortran.dg/f2003_io_1.f03
new file mode 100644
index 000000000..f1d67c5aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2003_io_1.f03
@@ -0,0 +1,37 @@
+! { dg-do run { target fd_truncate } }
+! { dg-options "-std=gnu" }
+! Test case prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+real :: a(4), b(4)
+real :: c
+integer :: istat, j
+character(25) :: msg
+
+a = 23.45
+b = 0.0
+open(10, file='mydata', asynchronous="yes", blank="null")
+
+write(10,'(10f8.3)', asynchronous="yes", decimal="comma", id=j) a
+rewind(10)
+read(10,'(10f8.3)', asynchronous="yes", decimal="comma", blank="zero") b
+if (any(b.ne.23.45)) call abort
+
+c = 3.14
+write(msg, *, decimal="comma") c
+if (msg(1:7).ne."   3,14") call abort
+
+b = 0.0
+rewind(10)
+write(10,'(10f8.3)', asynchronous="yes", decimal="point") a
+rewind(10)
+read(10,'(10f8.3)', asynchronous="yes", decimal="point") b
+if (any(b.ne.23.45)) call abort
+
+wait(unit=10, err=25, iostat=istat, iomsg=msg, end=35, id=j)
+
+! do some stuff with a
+25 continue
+
+35 continue
+
+close(10, status="delete")
+end
diff --git a/gcc/testsuite/gfortran.dg/f2003_io_2.f03 b/gcc/testsuite/gfortran.dg/f2003_io_2.f03
new file mode 100644
index 000000000..54c0516df
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2003_io_2.f03
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! Test case prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+integer :: istat, idvar
+character(25) :: msg
+real, dimension(10) :: a, b
+
+a = 43.21
+open(10, file='mydata', asynchronous="yes")
+write(10,'(10f8.3)', asynchronous="yes", decimal="comma") a
+rewind(10)
+read(10,'(10f8.3)', asynchronous="yes", decimal="comma", id=idvar) b
+istat = 123456
+wait(unit=10, err=25, iostat=istat, iomsg=msg, end=35, id=idvar)
+
+print *, istat
+
+25 continue
+
+35 continue
+end
diff --git a/gcc/testsuite/gfortran.dg/f2003_io_3.f03 b/gcc/testsuite/gfortran.dg/f2003_io_3.f03
new file mode 100644
index 000000000..37c07e3f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2003_io_3.f03
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! Test case prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+integer :: istat
+character(25) :: msg
+real, dimension(10) :: a, b
+namelist /mynml/ a, b
+msg = "null"
+a = 43.21
+WRITE(99,'(10f8.3)',decimal="comma") a
+rewind(99)
+read(99,'(dc,10f8.3)',blank=msg) b
+write(99,'(dp,10f8.3)',round="up")
+rewind(99)
+read(99,'(10f8.3)',pad="yes")
+msg="suppress"
+write(99,'(10f8.3)',sign=msg)
+write(99,delim="apostrophe", fmt=*)
+write(99,nml=mynml,delim="none")
+end
diff --git a/gcc/testsuite/gfortran.dg/f2003_io_4.f03 b/gcc/testsuite/gfortran.dg/f2003_io_4.f03
new file mode 100644
index 000000000..fa09737b4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2003_io_4.f03
@@ -0,0 +1,33 @@
+! { dg-do run }
+! Test case prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+! Test of decimal= feature
+
+integer :: istat
+character(80) :: msg
+real, dimension(4) :: a, b, c
+namelist /mynml/ a, b
+msg = "yes"
+a = 43.21
+b = 3.131
+c = 5.432
+open(99, decimal="comma", status="scratch")
+write(99,'(10f8.3)') a
+a = 0.0
+rewind(99)
+read(99,'(10f8.3)') a
+if (any(a.ne.43.21)) call abort
+
+write(msg,'(dp,f8.3,dc,f8.2,dp,f8.3)', decimal="comma") a(1), b(1), c(1)
+if (trim(msg).ne."  43.210    3,13   5.432") call abort
+
+close(99)
+open(99, decimal="comma", status="scratch")
+write(99,nml=mynml)
+a = 0.0
+b = 0.0
+rewind(99)
+read(99,nml=mynml)
+if (any(a.ne.43.21)) call abort
+if (any(b.ne.3.131)) call abort
+close(99)
+end
diff --git a/gcc/testsuite/gfortran.dg/f2003_io_5.f03 b/gcc/testsuite/gfortran.dg/f2003_io_5.f03
new file mode 100644
index 000000000..b816ded69
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2003_io_5.f03
@@ -0,0 +1,26 @@
+! { dg-do run }
+! Test case prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+! Test of decimal="comma" in namelist and complex
+integer :: i
+real :: a(10) = [ (i*1.3, i=1,10) ]
+real :: b(10)
+complex :: c
+character(34) :: complex
+namelist /nm/ a
+
+open(99,file="mynml",form="formatted",decimal="point",status="replace")
+write(99,nml=nm,decimal="comma")
+a = 5.55
+rewind(99)
+read(99,nml=nm,decimal="comma")
+if (any (a /= [ (i*1.3, i=1,10) ])) call abort
+close(99, status="delete")
+
+c = (3.123,4.456)
+write(complex,*,decimal="comma") c
+if (complex.ne." (  3,1229999    ;  4,4559999    )") call abort
+c = (0.0, 0.0)
+read(complex,*,decimal="comma") c
+if (complex.ne." (  3,1229999    ;  4,4559999    )") call abort
+
+end
diff --git a/gcc/testsuite/gfortran.dg/f2003_io_6.f03 b/gcc/testsuite/gfortran.dg/f2003_io_6.f03
new file mode 100644
index 000000000..40758e223
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2003_io_6.f03
@@ -0,0 +1,11 @@
+! { dg-do run }
+! Test case prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+! Test of decimal="comma" in namelist, checks separators
+implicit none
+integer :: i
+real :: a(6) = 0.0
+character(len=30) :: str = '&nm a = 1,3; 4, 5; 5; 7; /'
+namelist /nm/ a
+read(str,nml=nm,decimal='comma')
+if (any(a.ne.[ 1.3, 4.0, 5.0, 5.0, 7.0, 0.0 ])) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/f2003_io_7.f03 b/gcc/testsuite/gfortran.dg/f2003_io_7.f03
new file mode 100644
index 000000000..6d2c11dfc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2003_io_7.f03
@@ -0,0 +1,27 @@
+! { dg-do run }
+! Test case prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+! Test of sign=, decimal=, and blank= .
+program iotests
+  implicit none
+  character(len=45) :: a
+  character(len=4) :: mode = "what"
+  real, parameter :: pi = 3.14159265358979323846
+  real(kind=8), dimension(3) :: b
+  !
+  write(a,'(f10.3,s,f10.3,sp,f10.3,ss,f10.3)',SIGN='PLUS') pi, pi, pi, pi
+  if (a /= "    +3.142     3.142    +3.142     3.142") call abort
+  !
+  open(8,sign="plus")
+  write(8,'(f10.3,dc,f10.3,dp,f10.3)',DECIMAL='COMMA',&
+        & sign="suppress") pi, pi, pi
+  rewind(8)
+  read(8,'(a)') a
+  if (a /= "     3,142     3,142     3.142") call abort
+  close(8,status="delete")
+  !
+  !              "123456789 123456789  12345678901
+  write(a,'(a)') "53 256.84, 2 2 2.  ; 33.3 3   1  "
+  read(a, '(f9.2,1x,f8.2,2x,f11.7)', blank="zero") b(1),b(2),b(3)
+  if (any(abs(b - [530256.84, 20202.00, 33.3030001]) > .03)) call abort
+end program iotests
+
diff --git a/gcc/testsuite/gfortran.dg/f2003_io_8.f03 b/gcc/testsuite/gfortran.dg/f2003_io_8.f03
new file mode 100644
index 000000000..2362697c6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2003_io_8.f03
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-std=gnu" }
+!
+real :: a(4), b(4)
+real :: c
+integer :: istat, j
+character(25) :: msg
+
+open(10, file='mydata', asynchronous="yes", blank="null")
+write(10,'(10f8.3)', asynchronous='no', decimal="comma", id=j) a ! { dg-error "must be with ASYNCHRONOUS=" }
+read(10,'(10f8.3)', id=j, decimal="comma", blank="zero") b ! { dg-error "must be with ASYNCHRONOUS=" }
+read(10,'(10f8.3)', asynchronous=msg, decimal="comma", blank="zero") b ! { dg-error "must be an initialization expression" }
+end
diff --git a/gcc/testsuite/gfortran.dg/f2c_1.f90 b/gcc/testsuite/gfortran.dg/f2c_1.f90
new file mode 100644
index 000000000..9f45d05bf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2c_1.f90
@@ -0,0 +1,73 @@
+! Make sure the f2c calling conventions work
+! { dg-do run }
+! { dg-options "-ff2c" }
+
+function f(x)
+  f = x
+end function f
+
+complex function c(a,b)
+  c = cmplx (a,b)
+end function c
+
+double complex function d(e,f)
+  double precision e, f
+  d = cmplx (e, f, kind(d))
+end function d
+
+subroutine test_with_interface()
+  interface
+     real function f(x)
+       real::x
+     end function f
+  end interface
+
+  interface
+     complex function c(a,b)
+       real::a,b
+     end function c
+  end interface
+
+  interface
+     double complex function d(e,f)
+       double precision::e,f
+     end function d
+  end interface
+  
+  double precision z, w
+
+  x = 8.625
+  if (x /= f(x)) call abort ()
+  y = f(x)
+  if (x /= y) call abort ()
+
+  a = 1.
+  b = -1.
+  if (c(a,b) /= cmplx(a,b)) call abort ()
+
+  z = 1.
+  w = -1.
+  if (d(z,w) /= cmplx(z,w, kind(z))) call abort ()
+end subroutine test_with_interface
+
+external f, c, d
+real f
+complex c
+double complex d
+double precision z, w
+
+x = 8.625
+if (x /= f(x)) call abort ()
+y = f(x)
+if (x /= y) call abort ()
+
+a = 1.
+b = -1.
+if (c(a,b) /= cmplx(a,b)) call abort ()
+
+z = 1.
+w = -1.
+if (d(z,w) /= cmplx(z,w, kind(z))) call abort ()
+
+call test_with_interface ()
+end
diff --git a/gcc/testsuite/gfortran.dg/f2c_2.f90 b/gcc/testsuite/gfortran.dg/f2c_2.f90
new file mode 100644
index 000000000..51556894b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2c_2.f90
@@ -0,0 +1,23 @@
+! Some basic testing that calls to the library still work correctly with
+! -ff2c
+!
+! Once the library has support for f2c calling conventions (i.e. passing
+! a REAL(kind=4) or COMPLEX-valued intrinsic as procedure argument works), we
+! can simply add -ff2c to the list of options to cycle through, and get
+! complete coverage.  As of 2005-03-05 this doesn't work.
+! { dg-do run }
+! { dg-options "-ff2c" }
+
+complex c
+double complex d
+
+x = 2.
+if ((sqrt(x) - 1.41)**2 > 1.e-4) call abort ()
+x = 1.
+if ((atan(x) - 3.14/4) ** 2 > 1.e-4) call abort ()
+c = (-1.,0.)
+if (sqrt(c) /= (0., 1.)) call abort ()
+d = c
+if (sqrt(d) /= (0._8, 1._8)) call abort ()
+end
+ 
diff --git a/gcc/testsuite/gfortran.dg/f2c_3.f90 b/gcc/testsuite/gfortran.dg/f2c_3.f90
new file mode 100644
index 000000000..685445702
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2c_3.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-ff2c" }
+! Verifies that internal functions are not broken by f2c calling conventions
+program test
+  real, target :: f
+  real, pointer :: q
+  real :: g
+  f = 1.0
+  q=>f
+  g = foo(q)
+  if (g .ne. 1.0) call abort
+contains
+function foo (p)
+  real, pointer :: foo
+  real, pointer :: p
+  foo => p
+end function
+end program
diff --git a/gcc/testsuite/gfortran.dg/f2c_4.c b/gcc/testsuite/gfortran.dg/f2c_4.c
new file mode 100644
index 000000000..7fb1debf3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2c_4.c
@@ -0,0 +1,74 @@
+/*  Check -ff2c calling conventions
+    Return value of COMPLEX function is via an extra argument in the
+     calling sequence that points to where to store the return value
+    Additional underscore appended to function name
+  
+   Simplified from f2c output and tested with g77 */
+
+/* We used to #include <complex.h>, but this fails for some platforms
+   (like cygwin) who don't have it yet.  */
+#define complex __complex__
+#define _Complex_I (1.0iF)
+
+typedef float real;
+typedef double doublereal;
+
+extern double f2c_4b__(double *);
+extern void f2c_4d__( complex float *, complex float *);
+extern void f2c_4f__( complex float *, int *,complex float *);
+extern void f2c_4h__( complex double *, complex double *);
+extern void f2c_4j__( complex double *, int *, complex double *);
+extern void abort (void);
+
+void f2c_4a__(void) {
+  double a,b;
+  a = 1023.0;
+  b=f2c_4b__(&a);
+  if ( a != b ) abort();
+}
+
+void f2c_4c__(void) {
+  complex float x,ret_val;
+  x = 1234 + 5678 * _Complex_I;
+  f2c_4d__(&ret_val,&x);
+  if ( x != ret_val ) abort();
+}
+
+void f2c_4e__(void) {
+  complex float x,ret_val;
+  int i=0;
+  x = 1234 + 5678 * _Complex_I;
+  f2c_4f__(&ret_val,&i,&x);
+  if ( x != ret_val ) abort();
+}
+
+void f2c_4g__(void) {
+  complex double x,ret_val;
+  x = 1234 + 5678.0f * _Complex_I;
+  f2c_4h__(&ret_val,&x);
+  if ( x != ret_val ) abort();
+}
+
+void f2c_4i__(void) {
+  complex double x,ret_val;
+  int i=0;
+  x = 1234.0f + 5678.0f * _Complex_I;
+  f2c_4j__(&ret_val,&i,&x);
+  if ( x != ret_val ) abort();
+}
+
+void f2c_4k__(complex float *ret_val, complex float *x) {
+  *ret_val = *x;
+}
+
+void f2c_4l__(complex float *ret_val, int *i, complex float *x) {
+  *ret_val = *x;
+}
+
+void f2c_4m__(complex double *ret_val, complex double *x) {
+  *ret_val = *x;
+}
+
+void f2c_4n__(complex double *ret_val, int *i, complex double *x) {
+  *ret_val = *x;
+}
diff --git a/gcc/testsuite/gfortran.dg/f2c_4.f90 b/gcc/testsuite/gfortran.dg/f2c_4.f90
new file mode 100644
index 000000000..a0d1909bf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2c_4.f90
@@ -0,0 +1,58 @@
+! { dg-do run }
+! { dg-additional-sources f2c_4.c }
+! { dg-options "-ff2c -w" }
+
+! Check -ff2c calling conventions
+!   Return value of REAL function is promoted to C type double
+!   Return value of COMPLEX function is via an extra argument in the
+!    calling sequence that points to where to store the return value
+!   Addional underscore appended to function name
+program f2c_4
+  complex c, f2c_4k, f2c_4l
+  double complex z, f2c_4m, f2c_4n
+  integer i
+
+  ! Promotion of REAL function
+  call f2c_4a()
+
+  ! Return COMPLEX arg - call Fortran routines from C
+  call f2c_4c()
+  call f2c_4e()
+  call f2c_4g()
+  call f2c_4i()
+
+  !  Return COMPLEX arg - call C routines from Fortran 
+  c = cmplx(1234.0,5678.0)
+  z = dcmplx(1234.0d0,5678.0d0)
+  if ( c .ne. f2c_4k(c) )   call abort
+  if ( c .ne. f2c_4l(i,c) ) call abort
+  if ( z .ne. f2c_4m(z) )   call abort
+  if ( z .ne. f2c_4n(i,z) ) call abort
+
+end
+
+real function f2c_4b(x)
+  double precision x
+  f2c_4b = x
+end
+
+complex function f2c_4d(x)
+  complex x
+  f2c_4d = x
+end
+
+complex function f2c_4f(i,x)
+  complex x
+  integer i
+  f2c_4f = x
+end
+
+double complex function f2c_4h(x)
+  double complex x
+  f2c_4h = x
+end
+
+double complex function f2c_4j(i,x)
+  double complex x
+  f2c_4j = x
+end
diff --git a/gcc/testsuite/gfortran.dg/f2c_5.c b/gcc/testsuite/gfortran.dg/f2c_5.c
new file mode 100644
index 000000000..bb57556d0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2c_5.c
@@ -0,0 +1,9 @@
+extern float f2c_5b_(double *);
+extern void abort (void);
+
+void f2c_5a_(void) {
+  double a,b;
+  a = 1023.0;
+  b=f2c_5b_(&a);
+  if ( a != b ) abort();
+}
diff --git a/gcc/testsuite/gfortran.dg/f2c_5.f90 b/gcc/testsuite/gfortran.dg/f2c_5.f90
new file mode 100644
index 000000000..cfc37c82e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2c_5.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-additional-sources f2c_5.c }
+! { dg-options "-fno-f2c -w" }
+! Check calling conventions without -ff2c
+program f2c_5  
+  call f2c_5a()
+end
+
+real function f2c_5b(x)
+  double precision x
+  f2c_5b = x
+end
diff --git a/gcc/testsuite/gfortran.dg/f2c_6.f90 b/gcc/testsuite/gfortran.dg/f2c_6.f90
new file mode 100644
index 000000000..d28724cfa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2c_6.f90
@@ -0,0 +1,84 @@
+! { dg-do run }
+! { dg-options "-ff2c" }
+! Verifies that complex pointer results work with -ff2c
+! try all permutations of result clause in function yes/no
+!                     and result clause in interface yes/no
+! this is not possible in Fortran 77, but this exercises a previously
+! buggy codepath
+function c() result (r)
+  common // z
+  complex, pointer :: r
+  complex, target :: z
+
+  r=>z
+end function c
+
+function d()
+  common // z
+  complex, pointer :: d
+  complex, target :: z
+
+  d=>z
+end function d
+
+function e()
+  common // z
+  complex, pointer :: e
+  complex, target :: z
+
+  e=>z
+end function e
+
+function f() result(r)
+  common // z
+  complex, pointer :: r
+  complex, target :: z
+
+  r=>z
+end function f
+
+interface
+   function c ()
+     complex, pointer :: c
+   end function c
+end interface
+interface
+   function d()
+     complex, pointer :: d
+   end function d
+end interface
+interface
+   function e () result(r)
+     complex, pointer :: r
+   end function e
+end interface
+interface
+   function f () result(r)
+     complex, pointer :: r
+   end function f
+end interface
+
+common // z
+complex, target :: z
+complex, pointer :: p
+
+z = (1.,0.)
+p => c()
+z = (2.,0.)
+if (p /= z) call abort ()
+
+NULLIFY(p)
+p => d()
+z = (3.,0.)
+if (p /= z) call abort ()
+
+NULLIFY(p)
+p => e()
+z = (4.,0.)
+if (p /= z) call abort ()
+
+NULLIFY(p)
+p => f()
+z = (5.,0.)
+if (p /= z) call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/f2c_7.f90 b/gcc/testsuite/gfortran.dg/f2c_7.f90
new file mode 100644
index 000000000..d67e10bc2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2c_7.f90
@@ -0,0 +1,57 @@
+! { dg-do run }
+! { dg-options "-ff2c" }
+! Verifies that array results work with -ff2c
+! try all permutations of result clause in function yes/no
+!                     and result clause in interface yes/no
+! this is not possible in Fortran 77, but this exercises a previously
+! buggy codepath
+function c() result (r)
+  complex :: r(5)
+  r = 0.
+end function c
+
+function d()
+  complex :: d(5)
+  d = 1.
+end function d
+
+subroutine test_without_result
+interface
+   function c ()
+     complex :: c(5)
+   end function c
+end interface
+interface
+   function d ()
+     complex :: d(5)
+   end function d
+end interface
+complex z(5)
+z = c()
+if (any(z /= 0.)) call abort ()
+z = d()
+if (any(z /= 1.)) call abort ()
+end subroutine test_without_result
+
+subroutine test_with_result
+interface
+   function c () result(r)
+     complex :: r(5)
+   end function c
+end interface
+interface
+   function d () result(r)
+     complex :: r(5)
+   end function d
+end interface
+complex z(5)
+z = c()
+if (any(z /= 0.)) call abort ()
+z = d()
+if (any(z /= 1.)) call abort ()
+end subroutine test_with_result
+
+call test_without_result
+call test_with_result
+end
+  
diff --git a/gcc/testsuite/gfortran.dg/f2c_8.f90 b/gcc/testsuite/gfortran.dg/f2c_8.f90
new file mode 100644
index 000000000..03baa36be
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2c_8.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-ff2c" }
+! PR 25392
+! Verify that the type of the result variable matches the declared
+! type of the function.  The actual type of the function may be
+! different for f2c calling conventions.
+real function goo () result (foo)
+  real x
+  foo = sign(foo, x)
+end
+
+real function foo ()
+  real x
+  foo = sign(foo, x)
+end
+
diff --git a/gcc/testsuite/gfortran.dg/f2c_9.f90 b/gcc/testsuite/gfortran.dg/f2c_9.f90
new file mode 100644
index 000000000..59c3fbe8b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/f2c_9.f90
@@ -0,0 +1,52 @@
+! { dg-do run }
+! { dg-options "-ff2c" }
+! PR 34868
+
+function f(a) result(res)
+  implicit none
+  real(8), intent(in) :: a(:)
+  complex(8) :: res
+
+  res = cmplx(sum(a),product(a),8)
+end function f
+
+function g(a)
+  implicit none
+  real(8), intent(in) :: a(:)
+  complex(8) :: g
+
+  g = cmplx(sum(a),product(a),8)
+end function g
+
+program test
+  real(8) :: a(1,5)
+  complex(8) :: c
+  integer :: i
+
+  interface
+    complex(8) function f(a)
+      real(8), intent(in) :: a(:)
+    end function f
+    function g(a) result(res)
+      real(8), intent(in) :: a(:)
+      complex(8) :: res
+    end function g
+  end interface
+
+  do i = 1, 5
+    a(1,i) = sqrt(real(i,kind(a)))
+  end do
+
+  c = f(a(1,:))
+  call check (real(c), sum(a))
+  call check (imag(c), product(a))
+
+  c = g(a(1,:))
+  call check (real(c), sum(a))
+  call check (imag(c), product(a))
+contains
+  subroutine check (a, b)
+    real(8), intent(in) :: a, b
+    if (abs(a - b) > 1.e-10_8) call abort
+  end subroutine check
+end program test
diff --git a/gcc/testsuite/gfortran.dg/fgetc_1.f90 b/gcc/testsuite/gfortran.dg/fgetc_1.f90
new file mode 100644
index 000000000..966e15a98
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fgetc_1.f90
@@ -0,0 +1,39 @@
+! Testcase for the FGETC and FPUTC intrinsics
+! { dg-do run }
+  character(len=5) s
+  integer st
+
+  s = "12345"
+  open(10,status="scratch")
+  write(10,"(A)") "abcde"
+  rewind(10)
+  call fgetc(10,s,st)
+  if ((st /= 0) .or. (s /= "a    ")) call abort
+  call fgetc(10,s,st)
+  close(10)
+
+  open(10,status="scratch")
+  s = "12345"
+  call fputc(10,s,st)
+  if (st /= 0) call abort
+  call fputc(10,"2",st)
+  if (st /= 0) call abort
+  call fputc(10,"3 ",st)
+  if (st /= 0) call abort
+  rewind(10)
+  call fgetc(10,s)
+  if (s(1:1) /= "1") call abort
+  call fgetc(10,s)
+  if (s(1:1) /= "2") call abort
+  call fgetc(10,s,st)
+  if ((s(1:1) /= "3") .or. (st /= 0)) call abort
+  call fgetc(10,s,st)
+  if (st /= -1) call abort
+  close (10)
+
+! FGETC and FPUTC on units not opened should not work
+  call fgetc(12,s,st)
+  if (st /= -1) call abort
+  call fputc(12,s,st)
+  if (st /= -1) call abort
+  end
diff --git a/gcc/testsuite/gfortran.dg/fgetc_2.f90 b/gcc/testsuite/gfortran.dg/fgetc_2.f90
new file mode 100644
index 000000000..6dd12c4e2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fgetc_2.f90
@@ -0,0 +1,39 @@
+! Testcase for the FGETC and FPUTC intrinsics
+! { dg-do run }
+  character(len=5) s
+  integer st
+
+  s = "12345"
+  open(10,status="scratch")
+  write(10,"(A)") "abcde"
+  rewind(10)
+  st = fgetc(10,s)
+  if ((st /= 0) .or. (s /= "a    ")) call abort
+  st = fgetc(10,s)
+  close(10)
+
+  open(10,status="scratch")
+  s = "12345"
+  st = fputc(10,s)
+  if (st /= 0) call abort
+  st = fputc(10,"2")
+  if (st /= 0) call abort
+  st = fputc(10,"3 ")
+  if (st /= 0) call abort
+  rewind(10)
+  st = fgetc(10,s)
+  if (s(1:1) /= "1") call abort
+  st = fgetc(10,s)
+  if (s(1:1) /= "2") call abort
+  st = fgetc(10,s)
+  if ((s(1:1) /= "3") .or. (st /= 0)) call abort
+  st = fgetc(10,s)
+  if (st /= -1) call abort
+  close (10)
+
+! FGETC and FPUTC on units not opened should not work
+  st = fgetc(12,s)
+  if (st /= -1) call abort
+  st = fputc(12,s)
+  if (st /= -1) call abort
+  end
diff --git a/gcc/testsuite/gfortran.dg/finalize_1.f08 b/gcc/testsuite/gfortran.dg/finalize_1.f08
new file mode 100644
index 000000000..e1501ef66
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_1.f08
@@ -0,0 +1,31 @@
+! { dg-do compile }
+
+! Parsing of finalizer procedure definitions.
+! Check that CONTAINS is allowed in TYPE definition; but empty only for F2008
+
+MODULE final_type
+  IMPLICIT NONE
+
+  TYPE :: mytype
+    INTEGER, ALLOCATABLE :: fooarr(:)
+    REAL :: foobar
+  CONTAINS
+  END TYPE mytype
+
+CONTAINS
+  
+  SUBROUTINE bar
+    TYPE :: t
+    CONTAINS ! This is ok
+    END TYPE t
+    ! Nothing
+  END SUBROUTINE bar
+
+END MODULE final_type
+
+PROGRAM finalizer
+  IMPLICIT NONE
+  ! Do nothing here
+END PROGRAM finalizer
+
+! { dg-final { cleanup-modules "final_type" } }
diff --git a/gcc/testsuite/gfortran.dg/finalize_2.f03 b/gcc/testsuite/gfortran.dg/finalize_2.f03
new file mode 100644
index 000000000..b91bedff8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_2.f03
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! Parsing of finalizer procedure definitions.
+! Check empty CONTAINS errors out for F2003.
+
+MODULE final_type
+  IMPLICIT NONE
+
+  TYPE :: mytype
+    INTEGER, ALLOCATABLE :: fooarr(:)
+    REAL :: foobar
+  CONTAINS
+  END TYPE mytype ! { dg-error "Fortran 2008" }
+
+END MODULE final_type
+
+PROGRAM finalizer
+  IMPLICIT NONE
+  ! Do nothing here
+END PROGRAM finalizer
+
+! { dg-final { cleanup-modules "final_type" } }
diff --git a/gcc/testsuite/gfortran.dg/finalize_3.f03 b/gcc/testsuite/gfortran.dg/finalize_3.f03
new file mode 100644
index 000000000..edc493bfc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_3.f03
@@ -0,0 +1,25 @@
+! { dg-do compile }
+
+! Parsing of finalizer procedure definitions.
+! Check that CONTAINS disallows further components and no double CONTAINS
+! is allowed.
+
+MODULE final_type
+  IMPLICIT NONE
+
+  TYPE :: mytype
+    INTEGER, ALLOCATABLE :: fooarr(:)
+    REAL :: foobar
+  CONTAINS
+  CONTAINS ! { dg-error "Already inside a CONTAINS block" }
+    INTEGER :: x ! { dg-error "must precede CONTAINS" }
+  END TYPE mytype
+
+END MODULE final_type
+
+PROGRAM finalizer
+  IMPLICIT NONE
+  ! Do nothing here
+END PROGRAM finalizer
+
+! { dg-final { cleanup-modules "final_type" } }
diff --git a/gcc/testsuite/gfortran.dg/finalize_4.f03 b/gcc/testsuite/gfortran.dg/finalize_4.f03
new file mode 100644
index 000000000..6e99256c2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_4.f03
@@ -0,0 +1,55 @@
+! { dg-do compile }
+
+! Parsing of finalizer procedure definitions.
+! Check parsing of valid finalizer definitions.
+
+MODULE final_type
+  IMPLICIT NONE
+
+  TYPE :: mytype
+    INTEGER, ALLOCATABLE :: fooarr(:)
+    REAL :: foobar
+  CONTAINS
+    FINAL :: finalize_single
+    FINAL finalize_vector, finalize_matrix
+    ! TODO:  Test with different kind type parameters once they are implemented.
+  END TYPE mytype
+
+CONTAINS
+
+  ELEMENTAL SUBROUTINE finalize_single (el)
+    IMPLICIT NONE
+    TYPE(mytype), INTENT(IN) :: el
+    ! Do nothing in this test
+  END SUBROUTINE finalize_single
+
+  SUBROUTINE finalize_vector (el)
+    IMPLICIT NONE
+    TYPE(mytype), INTENT(INOUT) :: el(:)
+    ! Do nothing in this test
+  END SUBROUTINE finalize_vector
+
+  SUBROUTINE finalize_matrix (el)
+    IMPLICIT NONE
+    TYPE(mytype) :: el(:, :)
+    ! Do nothing in this test
+  END SUBROUTINE finalize_matrix
+
+END MODULE final_type
+
+PROGRAM finalizer
+  USE final_type, ONLY: mytype
+  IMPLICIT NONE
+
+  TYPE(mytype) :: el, vec(42)
+  TYPE(mytype), ALLOCATABLE :: mat(:, :)
+
+  ALLOCATE(mat(2, 3))
+  DEALLOCATE(mat)
+
+END PROGRAM finalizer
+
+! TODO: Remove this once finalization is implemented.
+! { dg-excess-errors "not yet implemented" }
+
+! { dg-final { cleanup-modules "final_type" } }
diff --git a/gcc/testsuite/gfortran.dg/finalize_5.f03 b/gcc/testsuite/gfortran.dg/finalize_5.f03
new file mode 100644
index 000000000..1df2d8cf2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_5.f03
@@ -0,0 +1,114 @@
+! { dg-do compile }
+
+! Parsing of finalizer procedure definitions.
+! Check for appropriate errors on invalid final procedures.
+
+MODULE final_type
+  IMPLICIT NONE
+
+  TYPE :: mytype
+    INTEGER, ALLOCATABLE :: fooarr(:)
+    REAL :: foobar
+    FINAL :: finalize_matrix ! { dg-error "must be inside a derived type" }
+  CONTAINS
+    FINAL :: ! { dg-error "Empty FINAL" }
+    FINAL ! { dg-error "Empty FINAL" }
+    FINAL :: + ! { dg-error "Expected module procedure name" }
+    FINAL :: iamnot ! { dg-error "is not a SUBROUTINE" }
+    FINAL :: finalize_single finalize_vector ! { dg-error "Expected ','" }
+    FINAL :: finalize_single, finalize_vector
+    FINAL :: finalize_single ! { dg-error "is already defined" }
+    FINAL :: finalize_vector_2 ! { dg-error "has the same rank" }
+    FINAL :: finalize_single_2 ! { dg-error "has the same rank" }
+    FINAL :: bad_function ! { dg-error "is not a SUBROUTINE" }
+    FINAL bad_num_args_1 ! { dg-error "must have exactly one argument" }
+    FINAL bad_num_args_2 ! { dg-error "must have exactly one argument" }
+    FINAL bad_arg_type
+    FINAL :: bad_pointer
+    FINAL :: bad_alloc
+    FINAL :: bad_optional
+    FINAL :: bad_intent_out
+
+    ! TODO:  Test for polymorphism, kind parameters once those are implemented.
+  END TYPE mytype
+
+CONTAINS
+
+  SUBROUTINE finalize_single (el)
+    IMPLICIT NONE
+    TYPE(mytype) :: el
+  END SUBROUTINE finalize_single
+
+  ELEMENTAL SUBROUTINE finalize_single_2 (el)
+    IMPLICIT NONE
+    TYPE(mytype), INTENT(IN) :: el
+  END SUBROUTINE finalize_single_2
+
+  SUBROUTINE finalize_vector (el)
+    IMPLICIT NONE
+    TYPE(mytype), INTENT(INOUT) :: el(:)
+  END SUBROUTINE finalize_vector
+
+  SUBROUTINE finalize_vector_2 (el)
+    IMPLICIT NONE
+    TYPE(mytype), INTENT(IN) :: el(:)
+  END SUBROUTINE finalize_vector_2
+  
+  SUBROUTINE finalize_matrix (el)
+    IMPLICIT NONE
+    TYPE(mytype) :: el(:, :)
+  END SUBROUTINE finalize_matrix
+
+  INTEGER FUNCTION bad_function (el)
+    IMPLICIT NONE
+    TYPE(mytype) :: el
+
+    bad_function = 42
+  END FUNCTION bad_function
+
+  SUBROUTINE bad_num_args_1 ()
+    IMPLICIT NONE
+  END SUBROUTINE bad_num_args_1
+
+  SUBROUTINE bad_num_args_2 (el, x)
+    IMPLICIT NONE
+    TYPE(mytype) :: el
+    COMPLEX :: x
+  END SUBROUTINE bad_num_args_2
+
+  SUBROUTINE bad_arg_type (el) ! { dg-error "must be of type 'mytype'" }
+    IMPLICIT NONE
+    REAL :: el
+  END SUBROUTINE bad_arg_type
+
+  SUBROUTINE bad_pointer (el) ! { dg-error "must not be a POINTER" }
+    IMPLICIT NONE
+    TYPE(mytype), POINTER :: el
+  END SUBROUTINE bad_pointer
+
+  SUBROUTINE bad_alloc (el) ! { dg-error "must not be ALLOCATABLE" }
+    IMPLICIT NONE
+    TYPE(mytype), ALLOCATABLE :: el(:)
+  END SUBROUTINE bad_alloc
+
+  SUBROUTINE bad_optional (el) ! { dg-error "must not be OPTIONAL" }
+    IMPLICIT NONE
+    TYPE(mytype), OPTIONAL :: el
+  END SUBROUTINE bad_optional
+
+  SUBROUTINE bad_intent_out (el) ! { dg-error "must not be INTENT\\(OUT\\)" }
+    IMPLICIT NONE
+    TYPE(mytype), INTENT(OUT) :: el
+  END SUBROUTINE bad_intent_out
+
+END MODULE final_type
+
+PROGRAM finalizer
+  IMPLICIT NONE
+  ! Nothing here, errors above
+END PROGRAM finalizer
+
+! TODO: Remove this once finalization is implemented.
+! { dg-excess-errors "not yet implemented" }
+
+! { dg-final { cleanup-modules "final_type" } }
diff --git a/gcc/testsuite/gfortran.dg/finalize_6.f90 b/gcc/testsuite/gfortran.dg/finalize_6.f90
new file mode 100644
index 000000000..e790f4efb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_6.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! Parsing of finalizer procedure definitions.
+! Check that CONTAINS/FINAL in derived types is rejected for F95.
+
+MODULE final_type
+  IMPLICIT NONE
+
+  TYPE :: mytype
+    INTEGER :: fooarr(42)
+    REAL :: foobar
+  CONTAINS ! { dg-error "Fortran 2003" }
+    FINAL :: finalize_single ! { dg-error "Fortran 2003" }
+  END TYPE mytype
+
+CONTAINS
+
+  SUBROUTINE finalize_single (el)
+    IMPLICIT NONE
+    TYPE(mytype) :: el
+    ! Do nothing in this test
+  END SUBROUTINE finalize_single
+
+END MODULE final_type
+
+PROGRAM finalizer
+  IMPLICIT NONE
+  ! Do nothing
+END PROGRAM finalizer
+
+! TODO: Remove this once finalization is implemented.
+! { dg-excess-errors "not yet implemented" }
+
+! { dg-final { cleanup-modules "final_type" } }
diff --git a/gcc/testsuite/gfortran.dg/finalize_7.f03 b/gcc/testsuite/gfortran.dg/finalize_7.f03
new file mode 100644
index 000000000..db6b4bea9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_7.f03
@@ -0,0 +1,59 @@
+! { dg-do compile }
+! { dg-options "-Wsurprising" }
+
+! Implementation of finalizer procedures.
+! Check for expected warnings on dubious FINAL constructs.
+
+MODULE final_type
+  IMPLICIT NONE
+
+  TYPE :: type_1
+    INTEGER, ALLOCATABLE :: fooarr(:)
+    REAL :: foobar
+  CONTAINS
+    ! Non-scalar procedures should be assumed shape
+    FINAL :: fin1_scalar
+    FINAL :: fin1_shape_1
+    FINAL :: fin1_shape_2
+  END TYPE type_1
+
+  TYPE :: type_2 ! { dg-warning "Only array FINAL procedures" }
+    REAL :: x
+  CONTAINS
+    ! No scalar finalizer, only array ones
+    FINAL :: fin2_vector
+  END TYPE type_2
+
+CONTAINS
+
+  SUBROUTINE fin1_scalar (el)
+    IMPLICIT NONE
+    TYPE(type_1) :: el
+  END SUBROUTINE fin1_scalar
+
+  SUBROUTINE fin1_shape_1 (v) ! { dg-warning "assumed shape" }
+    IMPLICIT NONE
+    TYPE(type_1) :: v(*)
+  END SUBROUTINE fin1_shape_1
+
+  SUBROUTINE fin1_shape_2 (v) ! { dg-warning "assumed shape" }
+    IMPLICIT NONE
+    TYPE(type_1) :: v(42, 5)
+  END SUBROUTINE fin1_shape_2
+
+  SUBROUTINE fin2_vector (v)
+    IMPLICIT NONE
+    TYPE(type_2) :: v(:)
+  END SUBROUTINE fin2_vector
+
+END MODULE final_type
+
+PROGRAM finalizer
+  IMPLICIT NONE
+  ! Nothing here
+END PROGRAM finalizer
+
+! TODO: Remove this once finalization is implemented.
+! { dg-excess-errors "not yet implemented" }
+
+! { dg-final { cleanup-modules "final_type" } }
diff --git a/gcc/testsuite/gfortran.dg/finalize_8.f03 b/gcc/testsuite/gfortran.dg/finalize_8.f03
new file mode 100644
index 000000000..6a4a135e0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_8.f03
@@ -0,0 +1,37 @@
+! { dg-do compile }
+
+! Parsing of finalizer procedure definitions.
+! Check that FINAL-declarations are only allowed on types defined in the
+! specification part of a module.
+
+MODULE final_type
+  IMPLICIT NONE
+
+CONTAINS
+
+  SUBROUTINE bar
+    IMPLICIT NONE
+
+    TYPE :: mytype
+      INTEGER, ALLOCATABLE :: fooarr(:)
+      REAL :: foobar
+    CONTAINS
+      FINAL :: myfinal ! { dg-error "in the specification part of a MODULE" }
+    END TYPE mytype
+
+  CONTAINS
+
+    SUBROUTINE myfinal (el)
+      TYPE(mytype) :: el
+    END SUBROUTINE myfinal
+
+  END SUBROUTINE bar
+
+END MODULE final_type
+
+PROGRAM finalizer
+  IMPLICIT NONE
+  ! Do nothing here
+END PROGRAM finalizer
+
+! { dg-final { cleanup-modules "final_type" } }
diff --git a/gcc/testsuite/gfortran.dg/finalize_9.f90 b/gcc/testsuite/gfortran.dg/finalize_9.f90
new file mode 100644
index 000000000..a113026ed
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_9.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+!
+! PR 43244: Invalid statement misinterpreted as FINAL declaration
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+implicit none         
+type particle
+  integer :: ID
+end type
+type(particle), dimension(1,1:3)  :: finalState
+finalstate(1,(/1:2/))%ID = (/1,103/)  ! { dg-error "Syntax error in array constructor" }
+end
diff --git a/gcc/testsuite/gfortran.dg/float_1.f90 b/gcc/testsuite/gfortran.dg/float_1.f90
new file mode 100644
index 000000000..0f3c0626c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/float_1.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! PR fortran/26816
+program test_float
+   integer(1) :: i1 = 1
+   integer(2) :: i2 = 1
+   integer(4) :: i4 = 1
+   integer(8) :: i8 = 1
+   if (float(i1) /= 1.) call abort                ! { dg-warning "non-default INTEGER" }
+   if (float(i2) /= 1.) call abort                ! { dg-warning "non-default INTEGER" }
+   if (float(i4) /= 1.) call abort
+   if (float(i8) /= 1.) call abort                ! { dg-warning "non-default INTEGER" }
+
+   if (kind(float(i4)) /= kind(1.0)) call abort
+   if (kind(float(i8)) /= kind(1.0)) call abort   ! { dg-warning "non-default INTEGER" }
+end program test_float
diff --git a/gcc/testsuite/gfortran.dg/flush_1.f90 b/gcc/testsuite/gfortran.dg/flush_1.f90
new file mode 100644
index 000000000..90875dc65
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/flush_1.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! PR 22390 Implement flush statement
+program flush_1
+
+   character(len=256) msg
+   integer ios
+
+   open (unit=10, access='SEQUENTIAL', status='SCRATCH')
+
+   write (10, *) 42
+   flush 10
+
+   write (10, *) 42
+   flush(10)
+
+   write (10, *) 42
+   flush(unit=10, iostat=ios)
+   if (ios /= 0) call abort
+
+   write (10, *) 42
+   flush (unit=10, err=20)
+   goto 30
+20 call abort
+30 continue
+
+   call flush(10)
+
+end program flush_1
diff --git a/gcc/testsuite/gfortran.dg/fmt_bz_bn.f b/gcc/testsuite/gfortran.dg/fmt_bz_bn.f
new file mode 100644
index 000000000..b24ebab5e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_bz_bn.f
@@ -0,0 +1,27 @@
+c     { dg-do run }
+c     PR38097 I/O with blanks in exponent fails; BN edit descriptor
+c     Test case derived from reporter.
+      character(11)  :: a = ' 2.  3 e+ 3'
+      character(11)  :: b = ' 2.003 e+ 3'
+      character(11)  :: c = ' 2.002 e+1 '
+      real :: f
+
+      f = 0.0
+      read (a,'(BZ,E11.0)') f
+      if (f .ne. 2003.0) call abort
+      f = 0.0
+      read (a,'(BN,E11.0)') f
+      if (f .ne. 2300.0) call abort
+      f = 0.0
+      read (b,'(BN,E11.0)') f
+      if (f .ne. 2003.0) call abort
+      f = 0.0
+      read (c,'(E11.0)') f
+      if (f .ne. 20.020) call abort
+      f = 0.0
+      read (c,'(BZ,E11.0)') f
+      if (f .ne. 2.002e10) call abort
+
+      end
+c     end of program
+
diff --git a/gcc/testsuite/gfortran.dg/fmt_bz_bn_err.f b/gcc/testsuite/gfortran.dg/fmt_bz_bn_err.f
new file mode 100644
index 000000000..579ab26f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_bz_bn_err.f
@@ -0,0 +1,17 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR38772 r143102 reveals missed error checking on floating point reads.
+! Test case contributed by Jack Howarth.
+      program badread
+      implicit none
+      double precision r
+      character*20 temp
+      logical ok
+      temp='             end'
+      r = 3.14159d0
+      ok=.true.
+      read(temp,'(f20.0)',err=8888) r
+      call abort
+8888  continue
+      end
diff --git a/gcc/testsuite/gfortran.dg/fmt_cache_1.f b/gcc/testsuite/gfortran.dg/fmt_cache_1.f
new file mode 100644
index 000000000..41de3f0d7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_cache_1.f
@@ -0,0 +1,33 @@
+! { dg-do run }
+! pr40662 segfaults when specific format is invoked twice.
+! pr40330  incorrect io.
+! test case derived from pr40662, <jvdelisle@gcc.gnu.org>
+      program astap
+      character(40) teststring
+      arlxca = 0.0
+      open(10, status="scratch")
+      write(10,40) arlxca
+      write(10,40) arlxca
+40    format(t4,"arlxca = ",1pg13.6,t27,"arlxcc = ",g13.6,t53,
+     .            "atmpca = ",g13.6,t79,"atmpcc = ",g13.6,t105,
+     .            "backup = ",g13.6,/,
+     .         t4,"csgfac = ",g13.6,t27,"csgmax = ",g13.6,t53,
+     .            "csgmin = ",g13.6,t79,"drlxca = ",g13.6,t105,
+     .            "drlxcc = ",g13.6,/,
+     .         t4,"dtimeh = ",g13.6,t27,"dtimei = ",g13.6,t53,
+     .            "dtimel = ",g13.6,t79,"dtimeu = ",g13.6,t105,
+     .            "dtmpca = ",g13.6,/,
+     .         t4,"dtmpcc = ",g13.6,t27,"ebalna = ",g13.6,t53,
+     .            "ebalnc = ",g13.6,t79,"ebalsa = ",g13.6,t105,
+     .            "ebalsc = ",g13.6)
+      rewind 10
+      rewind 10
+      teststring = ""
+      read(10,'(a)') teststring
+      if (teststring.ne."   arlxca =   0.00000     arlxcc = ")call abort
+      teststring = ""
+      read(10,'(a)') teststring
+      if (teststring.ne."   arlxca =   0.00000     arlxcc = ")call abort
+      end program astap
+
+
diff --git a/gcc/testsuite/gfortran.dg/fmt_cache_2.f b/gcc/testsuite/gfortran.dg/fmt_cache_2.f
new file mode 100644
index 000000000..f557a166c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_cache_2.f
@@ -0,0 +1,36 @@
+! { dg-do run }
+! PR42742 Handle very large format strings correctly
+! Test derived from example developed by Manfred Schwarb.
+      character(12) bufarr(74)
+      character(74*13+30) fmtstr,fmtstr2
+      character(1) delim
+      integer i,j,dat(5),pindx, loopcounter
+      character(983) big_string ! any less and this test fails.
+
+      do i=1,74
+        write(bufarr(i),'(i12)') i
+      enddo
+
+      delim=" "
+      dat(1)=2009
+      dat(2)=10
+      dat(3)=31
+      dat(4)=3
+      dat(5)=0
+      fmtstr="(i2,i6,4(a1,i2.2)"
+      open(10, status="scratch")
+      do j=1,74
+        fmtstr=fmtstr(1:len_trim(fmtstr))//",a1,a12"
+        fmtstr2=fmtstr(1:len_trim(fmtstr))//")"
+c        write(0,*) "interation ",j,": ",len_trim(fmtstr2)
+        do i=1,10
+          write(10,fmtstr2)
+     &           i,dat(1),"-",dat(2),"-",dat(3),
+     &           delim,dat(4),":",dat(5),
+     &           (delim,bufarr(pindx),pindx=1,j)
+        enddo
+        loopcounter = j
+      enddo
+      close(10)
+      if (loopcounter /= 74) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/fmt_cache_3.f90 b/gcc/testsuite/gfortran.dg/fmt_cache_3.f90
new file mode 100644
index 000000000..ec8e1b389
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_cache_3.f90
@@ -0,0 +1,80 @@
+! { dg-do run }
+!
+! PR fortran/56737
+!
+! Contributed by Jonathan Hogg
+!
+module hsl_mc73_single
+   implicit none
+   integer, parameter, private :: wp = kind(0.0)
+contains
+   subroutine mc73_fiedler(n,lirn,irn,ip,list)
+      integer,  intent (in) :: n
+      integer,  intent (in) :: lirn
+      integer,  intent (in) :: irn(*)
+      integer,  intent (in) :: ip(*)
+      integer, intent (out) :: list(*)
+
+      integer :: icntl(10)
+
+      call fiedler_graph(icntl)
+   end subroutine mc73_fiedler
+
+   subroutine mc73_order
+      integer :: icntl(10)
+
+      call fiedler_graph(icntl)
+   end subroutine mc73_order
+
+   subroutine fiedler_graph(icntl)
+      integer,  intent (in) :: icntl(10)
+
+      real (kind = wp)  :: tol
+      real (kind = wp)  :: tol1
+      real (kind = wp)  :: rtol
+
+      call multilevel_eig(tol,tol1,rtol,icntl)
+   end subroutine fiedler_graph
+
+   subroutine multilevel_eig(tol,tol1,rtol,icntl)
+      real (kind = wp), intent (in) :: tol,tol1,rtol
+      integer,  intent(in) :: icntl(10)
+
+      call level_print(6,'end of level ',1)
+   end subroutine multilevel_eig
+
+   subroutine level_print(mp,title1,level)
+      character (len = *), intent(in) :: title1
+      integer,  intent(in) :: mp,level
+      character(len=80) fmt
+      integer :: char_len1,char_len2
+
+      char_len1=len_trim(title1)
+
+      write (fmt,"('(',i4,'(1H ),6h===== ,a',i4,',i4,6h =====)')") &
+           level*3, char_len1
+!      print *, "fmt = ", fmt
+!      print *, "title1= ", title1
+!      print *, "level = ", level
+      write (66,fmt) title1,level
+   end subroutine level_print
+end module hsl_mc73_single
+
+program test
+   use hsl_mc73_single
+   implicit none
+   character(len=200) :: str(2)
+   integer, parameter :: wp = kind(0.0)
+
+   integer :: n, lirn
+   integer :: irn(1), ip(1), list(1)
+
+   str = ""
+   open (66, status='scratch')
+   call mc73_order
+   call mc73_fiedler(n,lirn,irn,ip,list)
+   rewind (66)
+   read (66, '(a)') str
+   close (66)
+   if (any (str /= "   ===== end of level   1 =====")) call abort()
+end program test
diff --git a/gcc/testsuite/gfortran.dg/fmt_colon.f90 b/gcc/testsuite/gfortran.dg/fmt_colon.f90
new file mode 100644
index 000000000..03d31f870
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_colon.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! PR31395 Colon edit descriptor is ignored.
+! Test case derived from PR. Prepared by Jerry DeLisle
+! <jvdelisle@gcc.gnu.org>
+PROGRAM test
+    INTEGER :: i = 1
+    character(30) :: astring
+    WRITE(astring, 10) i
+ 10 FORMAT('i =',I2:' this should not print')
+    if (astring.ne."i = 1") call abort
+    write(astring, 20) i, i
+ 20 format('i =',I2:' this should print',I2)
+    if (astring.ne."i = 1 this should print 1") call abort
+END PROGRAM test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/fmt_error.f90 b/gcc/testsuite/gfortran.dg/fmt_error.f90
new file mode 100644
index 000000000..7dc2ab6a5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_error.f90
@@ -0,0 +1,4 @@
+! { dg-do compile }
+! PR32545 Give compile error not warning for wrong edit format statements.
+read (5,'(i0)') i ! { dg-error "Positive width required in format" }
+end
diff --git a/gcc/testsuite/gfortran.dg/fmt_error_10.f b/gcc/testsuite/gfortran.dg/fmt_error_10.f
new file mode 100644
index 000000000..c2a9117bb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_error_10.f
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+! PR38439 I/O PD edit descriptor inconsistency
+! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+      character(len=25) :: str
+      character(len=132) :: msg, line
+      str = '(1pd24.15e6)'
+      line = "initial string"
+      x = 555.25
+      
+      write (line,str,iostat=istat, iomsg=msg) 1.0d0, 1.234
+      if (istat.ne.0) call abort
+      if (line.ne."   1.000000000000000D+001.E+00") call abort
+      
+      write (line,'(1pd24.15e6)',iostat=istat, iomsg=msg) 1.0d0, 1.234 ! { dg-warning "Period required" }
+      if (istat.ne.0) call abort
+      if (line.ne."   1.000000000000000D+001.E+00") call abort
+
+      str = '(1pd0.15)'
+      write (line,str,iostat=istat, iomsg=msg) 1.0d0
+      if (istat.ne.5006 .or. msg(1:15).ne."Positive width ") call abort
+      read (*,str,iostat=istat, iomsg=msg) x
+      if (istat.ne.5006 .or. msg(1:15).ne."Positive width ") call abort
+      if (x.ne.555.25) call abort
+      
+      write (line,'(1pd24.15e11.3)') 1.0d0, 1.234
+      if (line.ne."   1.000000000000000D+00  1.234E+00") call abort
+      
+      end
diff --git a/gcc/testsuite/gfortran.dg/fmt_error_11.f03 b/gcc/testsuite/gfortran.dg/fmt_error_11.f03
new file mode 100644
index 000000000..24c3fb591
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_error_11.f03
@@ -0,0 +1,8 @@
+! { dg-do run }
+! PR45143  Endless loop with unlimited edit descriptor
+    print 20, "1234", "abcd", "14rfa5"
+ 20 format ( *('start',('ahdh',('dhdhhow',a),'ndlownd  ')))
+    print 30, "1234", "abcd", "14rfa5"
+ 30 format ( *('start',('ahdh',('dhdhhow'),'ndlownd  ')))
+end
+! { dg-shouldfail "Fortran runtime error: '*' requires at least one associated data descriptor" }
diff --git a/gcc/testsuite/gfortran.dg/fmt_error_2.f90 b/gcc/testsuite/gfortran.dg/fmt_error_2.f90
new file mode 100644
index 000000000..ae818da7f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_error_2.f90
@@ -0,0 +1,37 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! PR 33269: we used to not simplify format strings before checking if
+! they were valid, leading to a missed error.
+
+IMPLICIT CHARACTER*5 (h-z)
+
+CHARACTER*5 f
+CHARACTER*5 bad, good
+parameter(bad="a", good="(a)")
+
+PRINT ('a'), "hello" ! { dg-error "Missing leading left parenthesis in format string" }
+WRITE (*, ("a")) "error"  ! { dg-error "Missing leading left parenthesis in format string" }
+
+PRINT 'a', "hello" ! { dg-error "Missing leading left parenthesis in format string" }
+WRITE (*, "a") "error"  ! { dg-error "Missing leading left parenthesis in format string" }
+WRITE (*, bad) "error"  ! { dg-error "Missing leading left parenthesis in format string" }
+
+PRINT 'a' // ', a', "err", "or"   ! { dg-error "Missing leading left parenthesis in format string" }
+
+PRINT '(' // 'a'  ! { dg-error "Unexpected end of format string in format string" }
+
+! the following are ok
+PRINT "(2f5.3)", bar, foo
+PRINT ' (a)', "hello"
+WRITE (*, " ((a))") "hello"
+print "(a" // ")", "all is fine"
+print good, "great"
+
+! verify that we haven't broken non-constant expressions
+f = "(f5.3)"
+print f, 3.14159
+print (f), 2.71813
+print implicitly_typed, "something"
+write (*, implicitly_typed_as_well) "something else"
+END
diff --git a/gcc/testsuite/gfortran.dg/fmt_error_3.f90 b/gcc/testsuite/gfortran.dg/fmt_error_3.f90
new file mode 100644
index 000000000..257f876ed
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_error_3.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+
+! PR fortran/29835
+! Check for improved format error messages with correct locus and more detailed
+! "unexpected element" messages.
+
+SUBROUTINE format_labels
+  IMPLICIT NONE
+
+1 FORMAT (A, &
+          A, &
+          Q, & ! { dg-error "Unexpected element 'Q'" }
+          A)
+
+2 FORMAT (A, &
+          I, & ! { dg-error "Nonnegative width" }
+          A)
+
+END SUBROUTINE format_labels
+
+SUBROUTINE format_strings
+  IMPLICIT NONE
+  CHARACTER(len=32), PARAMETER :: str = "hello"
+  INTEGER :: x
+
+  PRINT '(A, Q, A)', & ! { dg-error "Unexpected element 'Q'" }
+        str, str, str ! { dg-bogus "Unexpected element" }
+
+  PRINT '(A, ' // & ! { dg-error "Nonnegative width" }
+        ' I, ' // &
+        ' A)', str, str, str ! { dg-bogus "Nonnegative width" }
+
+  READ '(Q)', & ! { dg-error "Unexpected element 'Q'" }
+       x ! { dg-bogus "Unexpected element" }
+
+END SUBROUTINE format_strings
diff --git a/gcc/testsuite/gfortran.dg/fmt_error_4.f90 b/gcc/testsuite/gfortran.dg/fmt_error_4.f90
new file mode 100644
index 000000000..2310573bd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_error_4.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-shouldfail "runtime error" }
+
+! PR fortran/29835
+! Check for improved format error messages with correct locus and more detailed
+! "unexpected element" messages.
+
+! Now with runtime supplied format strings
+SUBROUTINE format_runtime (fmtstr)
+  IMPLICIT NONE
+  CHARACTER(len=*) :: fmtstr
+  CHARACTER(len=32), PARAMETER :: str = "hello"
+
+  PRINT fmtstr, str, str, str
+END SUBROUTINE format_runtime
+
+PROGRAM main
+  IMPLICIT NONE
+  CALL format_runtime ('(A, Q, A)')
+END PROGRAM main
+
+! { dg-output "Unexpected element 'Q'.*(\n|\r\n|\r)\\(A, Q, A\\)(\n|\r\n|\r)    \\^" }
diff --git a/gcc/testsuite/gfortran.dg/fmt_error_5.f90 b/gcc/testsuite/gfortran.dg/fmt_error_5.f90
new file mode 100644
index 000000000..18de68e07
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_error_5.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-shouldfail "runtime error" }
+
+! PR fortran/29835
+! Check for improved format error messages with correct locus and more detailed
+! "unexpected element" messages.
+
+! Now with runtime supplied format strings
+SUBROUTINE format_runtime (fmtstr)
+  IMPLICIT NONE
+  CHARACTER(len=*) :: fmtstr
+  INTEGER :: x
+
+  PRINT fmtstr, x
+END SUBROUTINE format_runtime
+
+PROGRAM main
+  IMPLICIT NONE
+  CALL format_runtime ('(Q)')
+END PROGRAM main
+
+! { dg-output "Unexpected element 'Q'.*(\n|\r\n|\r)\\(Q\\)(\n|\r\n|\r) \\^" }
diff --git a/gcc/testsuite/gfortran.dg/fmt_error_6.f90 b/gcc/testsuite/gfortran.dg/fmt_error_6.f90
new file mode 100644
index 000000000..a974c04f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_error_6.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! { dg-options }
+! PR37988 Edit descriptor checking (compile time) for "<Holerith>T)"
+! Test case derived from the reporter.
+ 8001 FORMAT(//,'     SIGNIFICANCE LEVEL =',F7.4, 21H ONE-SIDED AT THE LEFT) ! { dg-error "required with T descriptor" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/fmt_error_7.f b/gcc/testsuite/gfortran.dg/fmt_error_7.f
new file mode 100644
index 000000000..9b5fba97e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_error_7.f
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! PR37446 Diagnostic of edit descriptors, esp. EN
+      character(40) :: fmt_string
+      write(*, '(1P,2E12.4)') 1.0
+      write(*,'(EN)') 5.0 ! { dg-error "Positive width required" }
+      write(*,'("abcdefg",EN6,"hjjklmnop")') 5.0 ! { dg-error "Period required" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/fmt_error_8.f b/gcc/testsuite/gfortran.dg/fmt_error_8.f
new file mode 100644
index 000000000..1d630b7db
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_error_8.f
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! PR35754 -std=f95: Reject "1P2E12.4" w/o a comma after the "P" 
+! PR
+! Test case provided by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+      character(40) :: fmt_string
+      write(*, '(1P2E12.4)') 1.0 ! { dg-error "Comma required" }
+      write(*, '(1PT12,F12.4)') 1.0 ! { dg-error "Comma required" }
+      write(*, '(1PE12.4)') 1.0 ! This is OK by the standard 10.1.1
+      write (*,'(1PD24.15,F4.2,0P)') 1.0d0 ! This OK too.
+      end
diff --git a/gcc/testsuite/gfortran.dg/fmt_error_9.f b/gcc/testsuite/gfortran.dg/fmt_error_9.f
new file mode 100644
index 000000000..d8abb8512
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_error_9.f
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+! PR38439 I/O PD edit descriptor inconsistency
+! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+      character(len=25) :: str
+      character(len=132) :: msg, line
+      str = '(1pd24.15e6)'
+      line = "initial string"
+      x = 555.25
+      
+      write (line,str,iostat=istat, iomsg=msg) 1.0d0, 1.234
+      if (istat.ne.5006 .or. msg(1:15).ne."Period required") call abort
+      if (line.ne."initial string") call abort
+
+      str = '(1pf0.15)'
+      write (line,str,iostat=istat, iomsg=msg) 1.0d0
+      if (istat.ne.0) call abort
+      read (*,str,iostat=istat, iomsg=msg) x
+      if (istat.ne.5006 .or. msg(1:15).ne."Positive width ") call abort
+      if (x.ne.555.25) call abort
+      
+      write (line,'(1pd24.15e11.3)') 1.0d0, 1.234
+      if (line.ne."   1.000000000000000D+00  1.234E+00") call abort
+      
+      str = '(1p2d24.15)'
+      msg = "   1.000000000000000D+00   1.233999967575073D+00That's it!"
+      write (line,'(1p2d24.15a)') 1.0d0, 1.234, "That's it!"
+      if (line.ne.msg) print *, msg
+      end
diff --git a/gcc/testsuite/gfortran.dg/fmt_exhaust.f90 b/gcc/testsuite/gfortran.dg/fmt_exhaust.f90
new file mode 100644
index 000000000..bd9c8bcfb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_exhaust.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! PR27304 Test running out of data descriptors with data remaining.
+! Derived from case in PR.  Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>.
+      program test
+      implicit none
+      integer :: n
+      n = 1
+      open(10, status="scratch")
+      write(10,"(i7,(' abcd'))", err=10) n, n
+      call abort()
+ 10   close(10)
+      end program test
diff --git a/gcc/testsuite/gfortran.dg/fmt_f0_1.f90 b/gcc/testsuite/gfortran.dg/fmt_f0_1.f90
new file mode 100644
index 000000000..dd66f6557
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_f0_1.f90
@@ -0,0 +1,64 @@
+! { dg-do run }
+! PR39304 write of  0.0 with F0.3 gives  **
+! PR47567 Small absolute values.
+! Test case developed from case provided by reporter.
+ REAL :: x
+ CHARACTER(80) :: str
+ x = 0.0
+ write (str,'(f0.0)') x
+ if (str.ne."0.") call abort
+ write (str,'(f0.1)') x
+ if (str.ne.".0") call abort
+ write (str,'(f0.2)') x
+ if (str.ne.".00") call abort
+ write (str,'(f0.3)') x
+ if (str.ne.".000") call abort
+ write (str,'(f0.4)') x
+ if (str.ne.".0000") call abort
+ write (str,'(F0.0)') 0.0
+ if (str.ne."0.") call abort
+ write (str,'(F0.0)') 0.001
+ if (str.ne."0.") call abort
+ write (str,'(F0.0)') 0.01
+ if (str.ne."0.") call abort
+ write (str,'(F0.0)') 0.1
+ if (str.ne."0.") call abort
+ write (str,'(F1.0)') -0.0
+ if (str.ne."*") call abort
+ write (str,'(F1.0)') 0.001
+ if (str.ne."*") call abort
+ write (str,'(F1.0)') 0.01
+ if (str.ne."*") call abort
+ write (str,'(F1.0)') 0.1
+ if (str.ne."*") call abort
+ write (str,'(F2.0)') -0.001
+ if (str.ne."**") call abort
+ write (str,'(F2.0)') -0.01
+ if (str.ne."**") call abort
+ write (str,'(F2.0)') -0.1
+ if (str.ne."**") call abort
+ write (str,'(F0.2)') 0.0
+ if (str.ne.".00") call abort
+ write (str,'(F0.0)') -0.0
+ if (str.ne."-0.") call abort
+ write (str,'(F0.1)') -0.0
+ if (str.ne."-.0") call abort
+ write (str,'(F0.2)') -0.0
+ if (str.ne."-.00") call abort
+ write (str,'(F0.3)') -0.0
+ if (str.ne."-.000") call abort
+ write (str,'(F3.0)') -0.0
+ if (str.ne."-0.") call abort
+ write (str,'(F2.0)') -0.0
+ if (str.ne."**") call abort
+ write (str,'(F1.0)') -0.0
+ if (str.ne."*") call abort
+ write (str,'(F0.1)') -0.0
+ if (str.ne."-.0") call abort
+ write (str,'(F3.1)') -0.0
+ if (str.ne."-.0") call abort
+ write (str,'(F2.1)') -0.0
+ if (str.ne."**") call abort
+ write (str,'(F1.1)') -0.0
+ if (str.ne."*") call abort
+ END  
diff --git a/gcc/testsuite/gfortran.dg/fmt_f_an_p.f b/gcc/testsuite/gfortran.dg/fmt_f_an_p.f
new file mode 100644
index 000000000..e492cec38
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_f_an_p.f
@@ -0,0 +1,10 @@
+! { dg-do run }
+! PR38285 wrong i/o output: interaction between f and p for output
+! Special case of kPFw.d when d = 0
+      program f_and_p
+      character(28) string
+      write(string,1) 3742. , 0.3742
+    1 format ( f14.0, 4pf14.0 )
+      if (string.ne."         3742.         3742.") call abort
+      end program f_and_p
+
diff --git a/gcc/testsuite/gfortran.dg/fmt_float.f90 b/gcc/testsuite/gfortran.dg/fmt_float.f90
new file mode 100644
index 000000000..3ff1833c7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_float.f90
@@ -0,0 +1,43 @@
+! { dg-do run }
+! PR33225 Missing last digit in some formatted output (on 32bit targets)
+! related to per kind write_float patch
+! Test case from PR.
+real x
+x = 1.0
+print '(3E20.2e2)', x, x/10.0, x/100.0
+print '(3E20.2e3)', x, x/10.0, x/100.0
+print '(3E20.2e4)', x, x/10.0, x/100.0
+print '(3E20.2e5)', x, x/10.0, x/100.0
+print '(3E20.2e6)', x, x/10.0, x/100.0
+print '(3E20.2e7)', x, x/10.0, x/100.0
+print '(3E20.3e2)', x, x/10.0, x/100.0
+print '(3E20.3e3)', x, x/10.0, x/100.0
+print '(3E20.3e4)', x, x/10.0, x/100.0
+print '(3E20.3e5)', x, x/10.0, x/100.0
+print '(3E20.3e6)', x, x/10.0, x/100.0
+print '(3E20.3e7)', x, x/10.0, x/100.0
+print '(3E20.4e2)', x, x/10.0, x/100.0
+print '(3E20.4e3)', x, x/10.0, x/100.0
+print '(3E20.4e4)', x, x/10.0, x/100.0
+print '(3E20.4e5)', x, x/10.0, x/100.0
+print '(3E20.4e6)', x, x/10.0, x/100.0
+print '(3E20.4e7)', x, x/10.0, x/100.0
+end
+! { dg-output "            0.10E\\+01            0.10E\\+00            0.10E-01(\n|\r\n|\r)" }
+! { dg-output "           0.10E\\+001           0.10E\\+000           0.10E-001(\n|\r\n|\r)" }
+! { dg-output "          0.10E\\+0001          0.10E\\+0000          0.10E-0001(\n|\r\n|\r)" }
+! { dg-output "         0.10E\\+00001         0.10E\\+00000         0.10E-00001(\n|\r\n|\r)" }
+! { dg-output "        0.10E\\+000001        0.10E\\+000000        0.10E-000001(\n|\r\n|\r)" }
+! { dg-output "       0.10E\\+0000001       0.10E\\+0000000       0.10E-0000001(\n|\r\n|\r)" }
+! { dg-output "           0.100E\\+01           0.100E\\+00           0.100E-01(\n|\r\n|\r)" }
+! { dg-output "          0.100E\\+001          0.100E\\+000          0.100E-001(\n|\r\n|\r)" }
+! { dg-output "         0.100E\\+0001         0.100E\\+0000         0.100E-0001(\n|\r\n|\r)" }
+! { dg-output "        0.100E\\+00001        0.100E\\+00000        0.100E-00001(\n|\r\n|\r)" }
+! { dg-output "       0.100E\\+000001       0.100E\\+000000       0.100E-000001(\n|\r\n|\r)" }
+! { dg-output "      0.100E\\+0000001      0.100E\\+0000000      0.100E-0000001(\n|\r\n|\r)" }
+! { dg-output "          0.1000E\\+01          0.1000E\\+00          0.1000E-01(\n|\r\n|\r)" }
+! { dg-output "         0.1000E\\+001         0.1000E\\+000         0.1000E-001(\n|\r\n|\r)" }
+! { dg-output "        0.1000E\\+0001        0.1000E\\+0000        0.1000E-0001(\n|\r\n|\r)" }
+! { dg-output "       0.1000E\\+00001       0.1000E\\+00000       0.1000E-00001(\n|\r\n|\r)" }
+! { dg-output "      0.1000E\\+000001      0.1000E\\+000000      0.1000E-000001(\n|\r\n|\r)" }
+! { dg-output "     0.1000E\\+0000001     0.1000E\\+0000000     0.1000E-0000001(\n|\r\n|\r)" }
diff --git a/gcc/testsuite/gfortran.dg/fmt_fw_d.f90 b/gcc/testsuite/gfortran.dg/fmt_fw_d.f90
new file mode 100644
index 000000000..1af3bda55
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_fw_d.f90
@@ -0,0 +1,131 @@
+! { dg-do run }

+! { dg-options "-std=gnu" }

+! PR47567 Wrong output for small absolute values with F editing

+! Test case provided by Thomas Henlich 

+call verify_fmt(1.2)

+call verify_fmt(-0.1)

+call verify_fmt(1e-7)

+call verify_fmt(1e-6)

+call verify_fmt(1e-5)

+call verify_fmt(1e-4)

+call verify_fmt(1e-3)

+call verify_fmt(1e-2)

+call verify_fmt(-1e-7)

+call verify_fmt(-1e-6)

+call verify_fmt(-1e-5)

+call verify_fmt(-1e-4)

+call verify_fmt(-1e-3)

+call verify_fmt(-1e-2)

+call verify_fmt(tiny(0.0))

+call verify_fmt(-tiny(0.0))

+call verify_fmt(0.0)

+call verify_fmt(-0.0)

+call verify_fmt(100.0)

+call verify_fmt(.12345)

+call verify_fmt(1.2345)

+call verify_fmt(12.345)

+call verify_fmt(123.45)

+call verify_fmt(1234.5)

+call verify_fmt(12345.6)

+call verify_fmt(123456.7)

+call verify_fmt(99.999)

+call verify_fmt(-100.0)

+call verify_fmt(-99.999)

+end

+

+! loop through values for w, d

+subroutine verify_fmt(x)

+    real, intent(in) :: x

+    integer :: w, d

+    character(len=80) :: str, str0

+    integer :: len, len0

+    character(len=80) :: fmt_w_d

+    logical :: result, have_num, verify_fmt_w_d

+    

+    do d = 0, 10

+        have_num = .false.

+        do w = 1, 20

+            str = fmt_w_d(x, w, d)

+            len = len_trim(str)

+            

+            result = verify_fmt_w_d(x, str, len, w, d)

+            if (.not. have_num .and. result) then

+                have_num = .true.

+                str0 = fmt_w_d(x, 0, d)

+                len0 = len_trim(str0)

+                if (len /= len0) then

+                    call errormsg(x, str0, len0, 0, d, "selected width is wrong")

+                else

+                    if (str(:len) /= str0(:len0)) call errormsg(x, str0, len0, 0, d, "output is wrong")

+                end if

+            end if

+        end do

+    end do

+

+end subroutine

+

+! checks for standard-compliance, returns .true. if field contains number, .false. on overflow

+function verify_fmt_w_d(x, str, len, w, d)

+    real, intent(in) :: x

+    character(len=80), intent(in) :: str

+    integer, intent(in) :: len

+    integer, intent(in) :: w, d

+    logical :: verify_fmt_w_d

+    integer :: pos

+    character :: decimal_sep = "."

+

+    verify_fmt_w_d = .false.

+    

+    ! check if string is all asterisks

+    pos = verify(str(:len), "*")

+    if (pos == 0) return

+    

+    ! check if string contains a digit

+    pos = scan(str(:len), "0123456789")

+    if (pos == 0) call errormsg(x, str, len, w, d, "no digits")

+

+    ! contains decimal separator?

+    pos = index(str(:len), decimal_sep)

+    if (pos == 0) call errormsg(x, str, len, w, d, "no decimal separator")

+    

+    ! negative and starts with minus?

+    if (sign(1., x) < 0.) then

+        pos = verify(str, " ")

+        if (pos == 0) call errormsg(x, str, len, w, d, "only spaces")

+        if (str(pos:pos) /= "-") call errormsg(x, str, len, w, d, "no minus sign")

+    end if

+    

+    verify_fmt_w_d = .true.

+end function

+

+function fmt_w_d(x, w, d)

+    real, intent(in) :: x

+    integer, intent(in) :: w, d

+    character(len=*) :: fmt_w_d

+    character(len=10) :: fmt, make_fmt

+    

+    fmt = make_fmt(w, d)

+    write (fmt_w_d, fmt) x

+end function

+

+function make_fmt(w, d)

+    integer, intent(in) :: w, d

+    character(len=10) :: make_fmt

+    

+    write (make_fmt,'("(f",i0,".",i0,")")') w, d

+end function

+

+subroutine errormsg(x, str, len, w, d, reason)

+    real, intent(in) :: x

+    character(len=80), intent(in) :: str

+    integer, intent(in) :: len, w, d

+    character(len=*), intent(in) :: reason

+    integer :: fmt_len

+    character(len=10) :: fmt, make_fmt

+    

+    fmt = make_fmt(w, d)

+    fmt_len = len_trim(fmt)

+    

+    !print *, "print '", fmt(:fmt_len), "', ", x, " ! => ", str(:len), ": ", reason

+    call abort

+end subroutine

diff --git a/gcc/testsuite/gfortran.dg/fmt_g.f b/gcc/testsuite/gfortran.dg/fmt_g.f
new file mode 100644
index 000000000..55b094ae0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_g.f
@@ -0,0 +1,43 @@
+! { dg-do run }
+! PR47285 G format outputs wrong number of characters.
+! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+       PROGRAM FOO
+       character(len=50) :: buffer
+
+       WRITE(buffer,"(G0.5,'<')") -10000.
+       if (buffer.ne."-10000.<") call abort
+       WRITE(buffer,"(G1.5E5,'<')") -10000.
+       if (buffer.ne."*<") call abort
+       WRITE(buffer,"(G2.5E5,'<')") -10000.
+       if (buffer.ne."**<") call abort
+       WRITE(buffer,"(G3.5E5,'<')") -10000.
+       if (buffer.ne."***<") call abort
+       WRITE(buffer,"(G4.5E5,'<')") -10000.
+       if (buffer.ne."****<") call abort
+       WRITE(buffer,"(G5.5E5,'<')") -10000.
+       if (buffer.ne."*****<") call abort
+       WRITE(buffer,"(G6.5E5,'<')") -10000.
+       if (buffer.ne."******<") call abort
+       WRITE(buffer,"(G7.5E5,'<')") -10000.
+       if (buffer.ne."*******<") call abort
+       WRITE(buffer,"(G8.5E5,'<')") -10000.
+       if (buffer.ne."********<") call abort
+       WRITE(buffer,"(G9.5E5,'<')") -10000.
+       if (buffer.ne."*********<") call abort
+       WRITE(buffer,"(G10.5E5,'<')") -10000.
+       if (buffer.ne."**********<") call abort
+       WRITE(buffer,"(G11.5E5,'<')") -10000.
+       if (buffer.ne."***********<") call abort
+       WRITE(buffer,"(G12.5E5,'<')") -10000.
+       if (buffer.ne."************<") call abort
+       WRITE(buffer,"(G13.5E5,'<')") -10000.
+       if (buffer.ne."-10000.      <") call abort
+       WRITE(buffer,"(G14.5E5,'<')") -10000.
+       if (buffer.ne." -10000.      <") call abort
+       WRITE(buffer,"(G15.5E5,'<')") -10000.
+       if (buffer.ne."  -10000.      <") call abort
+       WRITE(buffer,"(G16.5E5,'<')") -10000.
+       if (buffer.ne."   -10000.      <") call abort
+
+       STOP
+       END
diff --git a/gcc/testsuite/gfortran.dg/fmt_g0_1.f08 b/gcc/testsuite/gfortran.dg/fmt_g0_1.f08
new file mode 100644
index 000000000..2e7fc1877
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_g0_1.f08
@@ -0,0 +1,20 @@
+! { dg-do run }
+! PR36420 Fortran 2008: g0 edit descriptor 
+! Test case provided by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+    character(25) :: string = "(g0,g0,g0)" 
+    character(33) :: buffer
+    write(buffer, '(g0,g0,g0)') ':',12340,':'
+    if (buffer.ne.":12340:") call abort
+    write(buffer, string) ':',0,':'
+    if (buffer.ne.":0:") call abort
+    write(buffer, string) ':',1.0/3.0,':'
+    if (buffer.ne.":.33333334:") call abort
+    write(buffer, '(1x,a,g0,a)') ':',1.0/3.0,':'
+    if (buffer.ne." :.33333334:") call abort
+    write(buffer, string) ':',"hello",':'
+    if (buffer.ne.":hello:") call abort
+    write(buffer, "(g0,g0,g0,g0)") ':',.true.,.false.,':'
+    if (buffer.ne.":TF:") call abort
+    write(buffer, "(g0,g0,',',g0,g0)") '(',( 1.2345, 2.4567 ),')'
+    if (buffer.ne."(1.2345001,2.4567001)") call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/fmt_g0_2.f08 b/gcc/testsuite/gfortran.dg/fmt_g0_2.f08
new file mode 100644
index 000000000..356756180
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_g0_2.f08
@@ -0,0 +1,11 @@
+! { dg-do run }
+! { dg-options "-std=f95 -pedantic -fall-intrinsics" }
+! { dg-shouldfail "Zero width in format descriptor" }
+! PR36420 Fortran 2008: g0 edit descriptor 
+! Test case provided by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+    character(25) :: string = "(g0,g0,g0)" 
+    character(33) :: buffer
+    write(buffer, string) ':',0,':'
+    if (buffer.ne.":0:") call abort
+end
+! { dg-output "Fortran runtime error: Zero width in format descriptor(\n|\r\n|\r)" }
diff --git a/gcc/testsuite/gfortran.dg/fmt_g0_3.f08 b/gcc/testsuite/gfortran.dg/fmt_g0_3.f08
new file mode 100644
index 000000000..b0b8139a3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_g0_3.f08
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }! PR36420 Fortran 2008: g0 edit descriptor 
+! Test case provided by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+    character(25) :: string = "(g0,g0,g0)" 
+    character(33) :: buffer
+    write(buffer, '(g0,g0,g0)') ':',12340,':' ! { dg-error "Fortran 2008:" }
+end
diff --git a/gcc/testsuite/gfortran.dg/fmt_g0_4.f08 b/gcc/testsuite/gfortran.dg/fmt_g0_4.f08
new file mode 100644
index 000000000..500117ec8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_g0_4.f08
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+! PR36725 Compile time error for g0 edit descriptor
+character(30) :: line
+write(line, '(g0.3)') 0.1
+if (line.ne."      1.000E-01") call abort
+write(line, '(g0.9)') 1.0
+if (line.ne."1.000000000E+00") call abort
+write(line, '(g0.5)') 29.23
+if (line.ne."    2.92300E+01") call abort
+write(line, '(g0.8)') -28.4
+if (line.ne."-2.83999996E+01") call abort
+write(line, '(g0.8)') -0.0001
+if (line.ne."-9.99999975E-05") call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/fmt_huge.f90 b/gcc/testsuite/gfortran.dg/fmt_huge.f90
new file mode 100644
index 000000000..43c4e2ac2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_huge.f90
@@ -0,0 +1,6 @@
+! { dg-do run }
+! PR32446 printing big numbers in F0.1 format.
+! This segfaulted before the patch.
+      open (10, status="scratch")
+      write (10,'(F0.1)') huge(1.0)
+      END
diff --git a/gcc/testsuite/gfortran.dg/fmt_int_sign.f90 b/gcc/testsuite/gfortran.dg/fmt_int_sign.f90
new file mode 100644
index 000000000..2257fd829
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_int_sign.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options -fno-range-check }
+! PR38504 double minus sign when printing integer
+! Test case derived from example by Jos de Kloe
+program IntAdtest
+
+  integer, parameter :: i8_ = Selected_Int_Kind(18)  ! = integer*8
+  character(len=22) :: str_value
+  integer(i8_) :: value
+  character(len=*), parameter :: format_IntAd  = "(i22)"
+
+  value = -9223372036854775807_i8_ -1
+  write(str_value, format_IntAd) value
+  if (str_value.ne."  -9223372036854775808") call abort
+
+end program IntAdtest
diff --git a/gcc/testsuite/gfortran.dg/fmt_l.f90 b/gcc/testsuite/gfortran.dg/fmt_l.f90
new file mode 100644
index 000000000..9dc4f5704
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_l.f90
@@ -0,0 +1,85 @@
+! { dg-do run }
+! { dg-options "-std=gnu -pedantic -ffree-line-length-none" }
+! Test the GNU extension of a L format descriptor without width
+! PR libfortran/21303
+program test_l
+  logical(kind=1) :: l1
+  logical(kind=2) :: l2
+  logical(kind=4) :: l4
+  logical(kind=8) :: l8
+
+  character(len=20) :: str
+
+  l1 = .true.
+  write (str,"(L)") l1 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  read (str,"(L)") l1 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  if (l1 .neqv. .true.) call abort
+
+  l2 = .true.
+  write (str,"(L)") l2 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  read (str,"(L)") l2 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  if (l2 .neqv. .true.) call abort
+
+  l4 = .true.
+  write (str,"(L)") l4 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  read (str,"(L)") l4 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  if (l4 .neqv. .true.) call abort
+
+  l8 = .true.
+  write (str,"(L)") l8 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  read (str,"(L)") l8 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  if (l8 .neqv. .true.) call abort
+
+  l1 = .false.
+  write (str,"(L)") l1 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  read (str,"(L)") l1 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  if (l1 .neqv. .false.) call abort
+
+  l2 = .false.
+  write (str,"(L)") l2 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  read (str,"(L)") l2 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  if (l2 .neqv. .false.) call abort
+
+  l4 = .false.
+  write (str,"(L)") l4 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  read (str,"(L)") l4 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  if (l4 .neqv. .false.) call abort
+
+  l8 = .false.
+  write (str,"(L)") l8 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  read (str,"(L)") l8 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  if (l8 .neqv. .false.) call abort
+
+end program test_l
+! { dg-output "At line 14 of file.*" }
+! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "At line 15 of file.*" }
+! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "At line 19 of file.*" }
+! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "At line 20 of file.*" }
+! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "At line 24 of file.*" }
+! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "At line 25 of file.*" }
+! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "At line 29 of file.*" }
+! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "At line 30 of file.*" }
+! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "At line 34 of file.*" }
+! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "At line 35 of file.*" }
+! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "At line 39 of file.*" }
+! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "At line 40 of file.*" }
+! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "At line 44 of file.*" }
+! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "At line 45 of file.*" }
+! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "At line 49 of file.*" }
+! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "At line 50 of file.*" }
+! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
diff --git a/gcc/testsuite/gfortran.dg/fmt_label_1.f90 b/gcc/testsuite/gfortran.dg/fmt_label_1.f90
new file mode 100644
index 000000000..eb11b790d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_label_1.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+!
+! Check for diagnostics (PR 34108)
+  write (*,0) 'xxx' ! { dg-error "Statement label .* is zero" }
+  write (*,1) 'xxx' ! { dg-error "FORMAT label .* not defined" }
+  write (*,123456) 'xxx' ! { dg-error "Too many digits in statement label" }
+  write (*,-1) 'xxx' ! { dg-error "" }
+  end
diff --git a/gcc/testsuite/gfortran.dg/fmt_missing_period_1.f b/gcc/testsuite/gfortran.dg/fmt_missing_period_1.f
new file mode 100644
index 000000000..d1b607682
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_missing_period_1.f
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! PR27634 Missing period in format specifier. Test case derived from case given
+! in PR.  Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+      real      aval
+      character(6)  :: str
+      character(12) :: input = "1234abcdef"
+      read(input,'(f4,a6)') aval, str  !{ dg-error "Period required" }
+      read(input,'(d10,a6)') aval, str !{ dg-error "Period required" }
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/fmt_missing_period_2.f b/gcc/testsuite/gfortran.dg/fmt_missing_period_2.f
new file mode 100644
index 000000000..a8f584921
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_missing_period_2.f
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-w -std=legacy" }
+! PR27634 Missing period in format specifier. Test case derived from case given
+! in PR.  Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+      real          :: aval = 3.14
+      character(6)  :: str = "xyz"
+      character(12) :: input = "1234abcdef"
+      read(input,'(f4,a6)') aval, str
+      if (aval.ne.1234.0) call abort()
+      if (str.ne."abcdef") call abort()
+      aval = 0.0
+      str = "xyz"
+      read(input,'(d4,a6)') aval, str
+      if (aval.ne.1234.0) call abort()
+      if (str.ne."abcdef") call abort()
+      end
diff --git a/gcc/testsuite/gfortran.dg/fmt_missing_period_3.f b/gcc/testsuite/gfortran.dg/fmt_missing_period_3.f
new file mode 100644
index 000000000..71a6c70f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_missing_period_3.f
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+! PR27634 Missing period in format specifier. Test case derived from case given
+! in PR.  Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+      real          :: aval = 3.14
+      character(6)  :: str = "xyz"
+      character(12) :: input = "1234abcdef"
+      character(8)  :: fmtstr = "(f4,a6)"
+      aval = 0.0
+      str = "xyz"
+      read(input,fmtstr) aval, str
+      if (aval.ne.1234.0) call abort()
+      if (str.ne."abcdef") call abort()
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/fmt_p_1.f90 b/gcc/testsuite/gfortran.dg/fmt_p_1.f90
new file mode 100644
index 000000000..2f3c66289
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_p_1.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! PR32554 Bug in P formatting
+! Test case from the bug reporter
+program gfcbug66
+  real(8) :: x = 1.0e-100_8
+  character(50) :: outstr
+  write (outstr,'(1X,2E12.3)')    x, 2 * x
+  if (outstr.ne."    0.100E-99   0.200E-99") call abort
+  ! Before patch 2 * x was put out wrong
+  write (outstr,'(1X,1P,2E12.3)') x, 2 * x
+  if (outstr.ne."    1.000-100   2.000-100") call abort
+end program gfcbug66
+
diff --git a/gcc/testsuite/gfortran.dg/fmt_read.f90 b/gcc/testsuite/gfortran.dg/fmt_read.f90
new file mode 100644
index 000000000..3b33946a5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_read.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! pr18398, missing data on sequential formatted reads
+! test contributed by Thomas.Koenig@online.de
+      open(7,status='scratch')
+      write (7,'(F12.5)') 1.0, 2.0, 3.0
+      rewind(7)
+      read(7,'(F15.5)') a,b
+!   note the read format is wider than the write
+      if (abs(a-1.0) .gt. 1e-5) call abort
+      if (abs(b-2.0) .gt. 1e-5) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/fmt_read_2.f90 b/gcc/testsuite/gfortran.dg/fmt_read_2.f90
new file mode 100644
index 000000000..316f737b6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_read_2.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! PR fortran/32483
+      implicit none
+      integer :: r
+      real :: a
+      write (*,'(i0)') r
+      read (*,'(i0)') r ! { dg-error "Positive width required" }
+      read (*,'(f0.2)') a ! { dg-error "Positive width required" }
+      print *, r,a
+      END
diff --git a/gcc/testsuite/gfortran.dg/fmt_read_bz_bn.f90 b/gcc/testsuite/gfortran.dg/fmt_read_bz_bn.f90
new file mode 100644
index 000000000..5eea29a6c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_read_bz_bn.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! Test various uses of BZ and BN format specifiers.
+! Portions inspired by NIST F77 testsuite FM711.f
+! Contributed by jvdelisle@verizon.net
+program test_bn
+        
+integer I1(2,2), I2(2,2,2)
+real A1(5)
+real(kind=8) A2(0:3)
+character*80 :: IDATA1="111 2 2 3 3. 3E-1  44 5 5 6 . 67 . 78 8. 8E-1"
+character*80 :: IDATA2="2345 1 34512 45123 51234 2345 1 34512 45123 5"
+character*80 :: IDATA3="-8.0D0  1.0D-4  0.50D0  0.250D0"
+character*80 :: ODATA=""
+character*80 :: CORRECT1=" 1110 2020 .30303E-07   44   55   6.6 70.07 .888E+01"
+character*80 :: CORRECT2="23450 10345. 12.45 1235 1234 2345  1345. 12.45 1235"
+character*80 :: CORRECT3="   -0.8000000000D+01    0.1000000000D-03&
+                         &    0.5000000000D+00    0.2500000000D+00"
+READ(IDATA1, 10) I1(1,2), IVI, A1(3), JVI, KVI, A1(2), AVS, A1(1)
+10 FORMAT (BZ,(2I4, E10.1, BN, 2I4, F5.2, BZ, F5.2, BN, E10.1))
+
+WRITE(ODATA, 20) I1(1,2), IVI, A1(3), JVI, KVI, A1(2), AVS, A1(1)
+20 FORMAT (2I5, 1X, E10.5, BN, 2I5, F6.1, BZ, F6.2, BN, 1X, E8.3, I5)
+
+if (ODATA /= CORRECT1) call abort
+ODATA=""
+
+READ(IDATA2, 30) I2(1,2,1), A1(3), AVS, IVI, I1(1,1), JVI, BVS, A1(2), I2(1,1,1)
+30 FORMAT (BZ, (I5, F5.0, BN, F5.2, 2I5, I5, F5.0, BN, F5.2, I5))
+
+WRITE(ODATA, 40) I2(1,2,1), A1(3), AVS, IVI, I1(1,1), JVI, BVS, A1(2), I2(1,1,1)
+40 FORMAT (I5, F7.0, BZ, 1X, F5.2, 2(1X,I4),I5, F7.0, BZ, 1X, F5.2, 1X, I4)
+
+if (ODATA /= CORRECT2) call abort
+ODATA=""
+
+READ(IDATA3, 50) A2
+50 FORMAT (4D8.0)
+
+WRITE(ODATA,60) A2
+60 FORMAT (4D20.10)
+
+if (ODATA /= CORRECT3) call abort
+
+end program test_bn
diff --git a/gcc/testsuite/gfortran.dg/fmt_t_1.f90 b/gcc/testsuite/gfortran.dg/fmt_t_1.f90
new file mode 100644
index 000000000..157ba131e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_t_1.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+      integer nrow, vec(15)
+      open (10, status="scratch")
+      write (10, fmt='(a)') '001    1 2 3 4 5 6'
+      write (10, fmt='(a)') '000000 7 8 9101112'
+      write (10, fmt='(a)') '000000131415'
+      rewind (10)
+      read (10, fmt='(i6, (t7, 6i2))') nrow, (vec(i), i=1,15)
+      close (10)
+      if (nrow.ne.1) call abort
+      if (any (vec.ne.(/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15/))) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/fmt_t_2.f90 b/gcc/testsuite/gfortran.dg/fmt_t_2.f90
new file mode 100644
index 000000000..c2b869481
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_t_2.f90
@@ -0,0 +1,27 @@
+! { dg-options "" }
+! { dg-do run }
+! pr24699, handle end-of-record on READ with T format
+! test contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+      character*132 :: foost1, foost2, foost3
+      open (11, status="scratch", action="readwrite")
+      write(11, '(a)') "ab cdefghijkl mnop qrst"
+      write(11, '(a)') "123456789 123456789 123456789"
+      write(11, '(a)') "  Now is the time for all good."
+      rewind(11)
+      
+      read (11, '(a040,t1,040a)', end = 999)  foost1 , foost2
+      if (foost1.ne.foost2) call abort()
+
+      read (11, '(a032,t2,a032t3,a032)', end = 999)  foost1 , foost2, foost3
+      if (foost1(1:32).ne."123456789 123456789 123456789   ") call abort()
+      if (foost2(1:32).ne."23456789 123456789 123456789    ") call abort()
+      if (foost3(1:32).ne."3456789 123456789 123456789     ") call abort()
+         
+      read (11, '(a017,t1,a0017)', end = 999)  foost1 , foost2
+      if (foost1.ne.foost2) call abort()
+      if (foost2(1:17).ne."  Now is the time ") call abort()
+      goto 1000
+ 999  call abort()
+ 1000 continue
+      close(11)
+      end
diff --git a/gcc/testsuite/gfortran.dg/fmt_t_3.f90 b/gcc/testsuite/gfortran.dg/fmt_t_3.f90
new file mode 100644
index 000000000..1ec67e118
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_t_3.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! PR31051 bug with x and t format descriptors.
+! Test case prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org> from PR.
+program t
+   integer, parameter :: n = 9
+   character(len=40) :: fmt
+   character(len=2), dimension(n) :: y
+   open(unit=10, status="scratch")
+   y = 'a '
+   fmt = '(a,1x,(t7, 3a))'
+   write(10, fmt) 'xxxx', (y(i), i = 1,n)
+   rewind(10)
+   read(10, '(a)') fmt
+   if (fmt.ne."xxxx  a a a") call abort()
+end program t
diff --git a/gcc/testsuite/gfortran.dg/fmt_t_4.f90 b/gcc/testsuite/gfortran.dg/fmt_t_4.f90
new file mode 100644
index 000000000..6c96f7ba8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_t_4.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR31199, test case from PR report.
+       program write_write
+       character(len=20) :: a,b,c
+       open(10, status="scratch")
+       write (10,"(a,t1,a,a)") "xxxxxxxxx", "abc", "def"
+       write (10,"(a,t1,a)",advance='no') "xxxxxxxxx", "abc"
+       write (10,"(a)") "def"
+       write (10,"(a)") "abcdefxxx"
+       rewind(10)
+       read(10,*) a
+       read(10,*) b
+       read(10,*) c
+       close(10)
+       if (a.ne.b) call abort()
+       IF (b.ne.c) call abort()
+       end
+
diff --git a/gcc/testsuite/gfortran.dg/fmt_t_5.f90 b/gcc/testsuite/gfortran.dg/fmt_t_5.f90
new file mode 100644
index 000000000..e3c69319b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_t_5.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR32678 GFortan works incorrectly when writing with FORMAT Tx
+! Before patch, NULLs were inserted in output.
+! Test case from reporter enhanced to detect this problem.
+      character(25) :: output
+      character(1)  :: c
+      output = ""
+      open (unit=10, file="pr32678testfile", status="replace")
+      write (10,10) '12','a','b'
+      close (10, status="keep")
+      open (unit=10, file="pr32678testfile", access="stream")
+      read(10, pos=1) output(1:21)
+      if (output(1:21).ne."ab                  x") call abort
+      read(10) c
+      if ((c.ne.achar(10)) .and. (c.ne.achar(13))) call abort
+      close (10, status="delete")
+ 10   format (a2,t1,a1,t2,a1,t20,' x')
+      end
diff --git a/gcc/testsuite/gfortran.dg/fmt_t_6.f b/gcc/testsuite/gfortran.dg/fmt_t_6.f
new file mode 100644
index 000000000..04141a155
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_t_6.f
@@ -0,0 +1,10 @@
+! { dg-do run }
+! PR34782 tab format failure to display properly (regression vs. g77)
+      character a(6)
+      character(22)  :: output
+      data a / 'a', 'b', 'c', 'd', 'e', 'f' /
+      !write(*,'(a)') "123456789012345678901234567890"
+      write(output,'(T20,A3,  T1,A4,  T5,A2,  T7,A2,  T9,A4, T17,A2)')
+     1 'a', 'b', 'c', 'd', 'e', 'f' 
+      if (output .ne. "   b c d   e     f   a") call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/fmt_t_7.f b/gcc/testsuite/gfortran.dg/fmt_t_7.f
new file mode 100644
index 000000000..718668ff4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_t_7.f
@@ -0,0 +1,16 @@
+! { dg-do run { target fd_truncate } }
+! PR34974 null bytes when reverse-tabbing long records
+! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+       program test
+       character(1) :: a, b, c
+       write (10,'(t50000,a,t1,a)') 'b', 'a'
+       close (10)
+       open (10, access="stream")
+       read (10, pos=1) a
+       read (10, pos=50000) b
+       read (10, pos=25474) c
+       close (10, status="delete")
+       if (a /= "a") call abort
+       if (b /= "b") call abort
+       if (c /= " ") call abort
+       end
diff --git a/gcc/testsuite/gfortran.dg/fmt_tab_1.f90 b/gcc/testsuite/gfortran.dg/fmt_tab_1.f90
new file mode 100644
index 000000000..cd95da203
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_tab_1.f90
@@ -0,0 +1,6 @@
+! { dg-do run }
+! PR fortran/32987
+      program TestFormat
+        write (*, 10)
+ 10     format ('Hello ',	'bug!') ! { dg-warning "Extension: Tab character in format" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/fmt_tab_2.f90 b/gcc/testsuite/gfortran.dg/fmt_tab_2.f90
new file mode 100644
index 000000000..17acf86fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_tab_2.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! PR fortran/32987
+      program TestFormat
+        write (*, 10) ! { dg-error "FORMAT label 10 at .1. not defined" }
+ 10     format ('Hello ',	'bug!') ! { dg-error "Extension: Tab character in format" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/fmt_tl.f b/gcc/testsuite/gfortran.dg/fmt_tl.f
new file mode 100644
index 000000000..656499ed0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_tl.f
@@ -0,0 +1,27 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR25631 Check that TL editing works for special case of no bytes written yet.
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+      real x
+      character*15 line
+      x = 12.34
+      write(line,10) x
+ 10   format(tr2,tl2,g11.4)
+      if (line.ne.'  12.34        ') call abort()
+      write(line,20) x
+ 20   format(tr5,tl3,g11.4)
+      if (line.ne.'    12.34      ') call abort()
+      write(line,30) x
+ 30   format(tr5,tl3,tl3,g11.4)
+      if (line.ne.'  12.34        ') call abort()
+      write(line,40) x
+ 40   format(tr25,tl35,f11.4)
+      if (line.ne.'    12.3400    ') call abort()
+      write(line,50) x
+ 50   format(tl5,tr3,f11.4)
+      if (line.ne.'       12.3400 ') call abort()
+      write(line,60) x
+ 60   format(t5,tl3,f11.4)
+      if (line.ne.'     12.3400   ') call abort()
+      end
diff --git a/gcc/testsuite/gfortran.dg/fmt_white.f b/gcc/testsuite/gfortran.dg/fmt_white.f
new file mode 100644
index 000000000..6921a722f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_white.f
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR24268 Test case derived from example given by Iwan Kawrakow
+! Embedded spaces in format strings should be ignored.
+! Prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+      program pr24268
+      real x
+      character*13 line
+      line = "12.34"
+      read(line,*) x
+      write(line,10) x
+ 10                                                            format(g1
+     *      1.4)
+      if (line.ne."  12.34") call abort()
+      line = ""
+      write(line,20) x
+ 20   format(t r 2 , g 1 1 . 4)
+      if (line.ne."    12.34") call abort()
+      end
diff --git a/gcc/testsuite/gfortran.dg/fmt_with_extra.f b/gcc/testsuite/gfortran.dg/fmt_with_extra.f
new file mode 100644
index 000000000..679728221
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_with_extra.f
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! test case contributed by tobias.burnus@physik.fu-berlin.de
+! PR28039 Warn when ignoring extra characters in the format specification
+       implicit none
+       real :: r
+       r = 1.0
+       write(*,'(a),f)') 'Hello', r   ! { dg-warning "Extraneous characters in format at" }
+       end
+! Below routine was also submitted by tobias.burnus@physik.fu-berlin.de
+! It showed up some problems with the initial implementation of this
+! feature.
+! This routine should compile without complaint or warning.
+      SUBROUTINE rw_inp()
+      CHARACTER(len=100) :: line
+      integer :: i5
+      character(100), parameter :: subchapter =
+     &        '(79("-"),/,5("-")," ",A,/,79("-"),/)'
+      i5 = 1
+
+      READ(*,FMT="(4x,a)") line
+ 7182 FORMAT (a3)
+ 7130 FORMAT (i3)
+
+      WRITE (6,'(//'' icorr is not correctly transferred.  icorr='',i5)
+     &    ') 42
+
+      write(*,subchapter) 'test'
+      END SUBROUTINE rw_inp
diff --git a/gcc/testsuite/gfortran.dg/fmt_zero_check.f90 b/gcc/testsuite/gfortran.dg/fmt_zero_check.f90
new file mode 100644
index 000000000..d8b6c5dfe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_zero_check.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! PR fortran/32555
+!
+2050  FORMAT(0PF9.4)
+2050  FORMAT(0F9.4) ! { dg-error "Expected P edit descriptor" }
+end
diff --git a/gcc/testsuite/gfortran.dg/fmt_zero_digits.f90 b/gcc/testsuite/gfortran.dg/fmt_zero_digits.f90
new file mode 100644
index 000000000..e7342397a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_zero_digits.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! Verify that when decimal precision is zero, error error given except with 1P.
+! Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+! Modified for fix to PR35036
+program test
+  implicit none
+  character(20) :: astr
+  integer       :: istat
+  50 FORMAT (1PD20.0)
+  astr = ""
+  write(astr,50) -8.0D0
+  if (astr.ne."             -8.D+00") call abort
+  write(astr,50) 8.0D0
+  if (astr.ne."              8.D+00") call abort
+  write(astr, '(E15.0)', iostat=istat) 1e5
+  if (istat /= 5006) call abort
+  write(astr, '(D15.0)', iostat=istat) 1e5
+  if (istat /= 5006) call abort
+  write(astr, '(G15.0)', iostat=istat) 1e5
+  if (istat /= 5006) call abort
+  write(astr, '(2PE15.0)', iostat=istat) 1e5
+  if (istat /= 5006) call abort
+  write(astr, '(0PE15.0)', iostat=istat) 1e5
+  if (istat /= 5006) call abort
+  write(astr, '(1PE15.0)', iostat=istat) 1e5
+  if (istat /= 0) call abort
+  write(astr, '(F15.0)', iostat=istat) 1e5
+  if (astr.ne."        100000.") call abort
+  if (istat /= 0) call abort
+end program test
diff --git a/gcc/testsuite/gfortran.dg/fmt_zero_precision.f90 b/gcc/testsuite/gfortran.dg/fmt_zero_precision.f90
new file mode 100644
index 000000000..459bca448
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_zero_precision.f90
@@ -0,0 +1,85 @@
+! { dg-do run }
+! PR28354 Incorrect rounding of .99999 with f3.0 format specifier
+! PR30910 ES format not quite right...
+! Test case derived from PR. Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+  write(*,50) 0.99999
+  write(*,50) -0.99999
+  write(*,50) -9.0
+  write(*,50) -0.99
+  write(*,50) -0.999
+  write(*,50) -0.999
+  write(*,50) -0.59
+  write(*,50) -0.49
+  write(*,100) 37.99999
+  write(*,100) 10345.0
+  write(*,100) 333.678
+  write(*,100) 333.499
+  50   format(f3.0,"<")
+ 100   format(f8.0,"<")
+  write(6,'(es6.0)') 1.0e-1
+  write(*,150) -0.99999
+  write(*,150) 0.99999
+  write(*,150) -9.0
+  write(*,150) -0.99
+  write(*,150) -0.999
+  write(*,150) -0.999
+  write(*,150) -0.59
+  write(*,150) -0.49
+  write(*,200) 37.99999
+  write(*,200) 10345.0
+  write(*,200) 333.678
+  write(*,200) 333.499
+ 150   format(es7.0,"<")
+ 200   format(es8.0,"<")
+  write(*,250) -0.99999
+  write(*,250) 0.99999
+  write(*,250) -9.0
+  write(*,250) -0.99
+  write(*,250) -0.999
+  write(*,250) -0.999
+  write(*,250) -0.59
+  write(*,250) -0.49
+  write(*,300) 37.99999
+  write(*,300) 10345.0
+  write(*,300) 333.678
+  write(*,300) 333.499
+ 250   format(1pe7.0,"<")
+ 300   format(1pe6.0,"<")
+  end
+! { dg-output " 1\\.<(\n|\r\n|\r)" }
+! { dg-output "-1\\.<(\n|\r\n|\r)" }
+! { dg-output "-9\\.<(\n|\r\n|\r)" }
+! { dg-output "-1\\.<(\n|\r\n|\r)" }
+! { dg-output "-1\\.<(\n|\r\n|\r)" }
+! { dg-output "-1\\.<(\n|\r\n|\r)" }
+! { dg-output "-1\\.<(\n|\r\n|\r)" }
+! { dg-output "-0\\.<(\n|\r\n|\r)" }
+! { dg-output "     38\\.<(\n|\r\n|\r)" }
+! { dg-output "  10345\\.<(\n|\r\n|\r)" }
+! { dg-output "    334\\.<(\n|\r\n|\r)" }
+! { dg-output "    333\\.<(\n|\r\n|\r)" }
+! { dg-output "1\\.E-01(\n|\r\n|\r)" }
+! { dg-output "-1\\.E\\+00<(\n|\r\n|\r)" }
+! { dg-output " 1\\.E\\+00<(\n|\r\n|\r)" }
+! { dg-output "-9\\.E\\+00<(\n|\r\n|\r)" }
+! { dg-output "-1\\.E\\+00<(\n|\r\n|\r)" }
+! { dg-output "-1\\.E\\+00<(\n|\r\n|\r)" }
+! { dg-output "-1\\.E\\+00<(\n|\r\n|\r)" }
+! { dg-output "-6\\.E-01<(\n|\r\n|\r)" }
+! { dg-output "-5\\.E-01<(\n|\r\n|\r)" }
+! { dg-output "  4\\.E\\+01<(\n|\r\n|\r)" }
+! { dg-output "  1\\.E\\+04<(\n|\r\n|\r)" }
+! { dg-output "  3\\.E\\+02<(\n|\r\n|\r)" }
+! { dg-output "  3\\.E\\+02<(\n|\r\n|\r)" }
+! { dg-output "-1\\.E\\+00<(\n|\r\n|\r)" }
+! { dg-output " 1\\.E\\+00<(\n|\r\n|\r)" }
+! { dg-output "-9\\.E\\+00<(\n|\r\n|\r)" }
+! { dg-output "-1\\.E\\+00<(\n|\r\n|\r)" }
+! { dg-output "-1\\.E\\+00<(\n|\r\n|\r)" }
+! { dg-output "-1\\.E\\+00<(\n|\r\n|\r)" }
+! { dg-output "-6\\.E-01<(\n|\r\n|\r)" }
+! { dg-output "-5\\.E-01<(\n|\r\n|\r)" }
+! { dg-output "4\\.E\\+01<(\n|\r\n|\r)" }
+! { dg-output "1\\.E\\+04<(\n|\r\n|\r)" }
+! { dg-output "3\\.E\\+02<(\n|\r\n|\r)" }
+! { dg-output "3\\.E\\+02<(\n|\r\n|\r)" }
diff --git a/gcc/testsuite/gfortran.dg/fold_nearest.f90 b/gcc/testsuite/gfortran.dg/fold_nearest.f90
new file mode 100644
index 000000000..743e2023a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fold_nearest.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! Tests for the constant folding of the NEAREST intrinsic
+! We compare against the results of the runtime implementation,
+! thereby making sure that they remain consistent
+REAL, PARAMETER :: x(10) = (/ 1., 0.49999997, 0.5, 8388609.0, -1., &
+                                      -0.49999997, -0.5, -8388609.0, &
+                                      0., 0. /), &
+                 dir(10) = (/ -1.,       +1., -1.,       -1., +1., &
+                                             -1.,  +1.,        +1., &
+                                     +1.,-1./)
+REAL :: a(10)
+
+a = x
+if (nearest (x(1), dir(1)) /= nearest (a(1), dir(1))) call abort ()
+if (nearest (x(2), dir(2)) /= nearest (a(2), dir(2))) call abort ()
+if (nearest (x(3), dir(3)) /= nearest (a(3), dir(3))) call abort ()
+if (nearest (x(4), dir(4)) /= nearest (a(4), dir(4))) call abort ()
+if (nearest (x(5), dir(5)) /= nearest (a(5), dir(5))) call abort ()
+if (nearest (x(6), dir(6)) /= nearest (a(6), dir(6))) call abort ()
+if (nearest (x(7), dir(7)) /= nearest (a(7), dir(7))) call abort ()
+if (nearest (x(8), dir(8)) /= nearest (a(8), dir(8))) call abort ()
+! These last two tests are commented out because mpfr provides no support
+! for denormals, and therefore we get TINY instead of the correct result.
+!if (nearest (x(9), dir(9)) /= nearest (a(9), dir(9))) call abort ()
+!if (nearest (x(10), dir(10)) /= nearest (a(10), dir(10))) call abort ()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/forall_1.f90 b/gcc/testsuite/gfortran.dg/forall_1.f90
new file mode 100644
index 000000000..35fcfdd7f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_1.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! tests FORALL statements with a mask
+dimension i2(15,10), i1(15)
+type a
+   sequence
+   integer k
+end type a
+type(a) :: a1(10), a2(5,5)
+
+i1 = (/ 0, 1, 2, 3, 4, 0, 6, 7, 8, 9, 10, 0, 0, 13, 14 /)
+forall (i=1:15, i1(i) /= 0)
+   i1(i) = 0
+end forall
+if (any(i1 /= 0)) call abort
+
+a1(:)%k = i1(1:10)
+forall (i=1:10, a1(i)%k == 0)
+   a1(i)%k = i
+end forall
+if (any (a1(:)%k /= (/ (i, i=1,10) /))) call abort
+
+forall (i=1:15, j=1:10, a1(j)%k <= j)
+   i2(i,j) = j + i*11
+end forall
+do i=1,15
+   if (any (i2(i,:) /= (/ (i*11 + j, j=1,10) /))) call abort
+end do
+end
diff --git a/gcc/testsuite/gfortran.dg/forall_10.f90 b/gcc/testsuite/gfortran.dg/forall_10.f90
new file mode 100644
index 000000000..1b16840e6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_10.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-O" }
+! Tests the fix for PR30400, in which the use of ANY in the
+! FORALL mask was rejected.
+!
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+!
+program pr30400_1
+  real, dimension (5, 5, 5, 5) :: a
+
+  a (:, :, :,  :)  = 4
+  a (:, 2, :, 4) = 10
+  a (:, 2, :, 1) = 0
+
+  forall (i = 1:5, j = 1:5, k = 1:5, any (a (i, j, k,  :)  .gt. 6))
+    forall (l = 1:5, any (a (:, :, :, l) .lt. 2))
+      a (i, j, k, l) = i - j + k - l
+    end forall
+  end forall
+  if (sum (a) .ne. 2625.0) call abort ()
+
+ ! Check that the fix has not broken the treatment of the '=='
+  forall (i = 1:5, i == 3) a(i, i, i, i) = -5
+  if (sum (a) .ne. 2616.0) call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/forall_11.f90 b/gcc/testsuite/gfortran.dg/forall_11.f90
new file mode 100644
index 000000000..4c556951c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_11.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! PR 25076
+! We erroneously accepted it when a FORALL index was used in a triplet
+! specification within the same FORALL header
+INTEGER :: A(10,10)
+FORALL(I=1:10,J=I:10) ! { dg-error "FORALL index 'i' may not appear in triplet specification" }
+  A(I,J)=I+J
+ENDFORALL
+
+forall (i=1:10, j=1:i)  ! { dg-error "FORALL index 'i' may not appear in triplet specification" }
+   a(i,j) = 5
+end forall
+
+forall (i=1:10, j=1:10:i)  ! { dg-error "FORALL index 'i' may not appear in triplet specification" }
+   a(i,j) = i - j
+end forall
+
+forall (i=i:10) ! { dg-error "FORALL index 'i' may not appear in triplet specification" }
+   forall (j=1:j:i)  !  { dg-error "FORALL index 'j' may not appear in triplet specification" }
+      a(i,j) = i*j
+   end forall
+end forall
+
+forall (i=1:10:i) ! { dg-error "FORALL index 'i' may not appear in triplet specification" }
+   a(1,i) = 2
+end forall
+
+forall (i=1:10)
+   forall (j=i:10)
+      a(i,j) = i*j
+   end forall
+end forall
+END
diff --git a/gcc/testsuite/gfortran.dg/forall_12.f90 b/gcc/testsuite/gfortran.dg/forall_12.f90
new file mode 100644
index 000000000..207977c51
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_12.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! Tests the fix for PR31217 and PR33811 , in which dependencies were not
+! correctly handled for the assignments below and, when this was fixed,
+! the last two ICEd on trying to create the temorary.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!              Dominique d'Humieres <dominiq@lps.ens.fr>
+!                   and Paul Thomas <pault@gcc.gnu.org>
+!
+  character(len=1) :: a = "1"
+  character(len=1) :: b(4) = (/"1","2","3","4"/), c(4)
+  c = b
+  forall(i=1:1) a(i:i) = a(i:i)         ! This was the original PR31217
+  forall(i=1:1) b(i:i) = b(i:i)         ! The rest were found to be broken
+  forall(i=1:1) b(:)(i:i) = b(:)(i:i)
+  forall(i=1:1) b(1:3)(i:i) = b(2:4)(i:i)
+  if (any (b .ne. (/"2","3","4","4"/))) call abort ()
+  b = c
+  forall(i=1:1) b(2:4)(i:i) = b(1:3)(i:i)
+  if (any (b .ne. (/"1","1","2","3"/))) call abort ()
+  b = c
+  do i = 1, 1
+    b(2:4)(i:i) = b(1:3)(i:i)           ! This was PR33811 and Paul's bit
+  end do
+  if (any (b .ne. (/"1","1","2","3"/))) call abort ()
+  call foo
+contains
+  subroutine foo
+    character(LEN=12) :: a(2) = "123456789012"
+    character(LEN=12) :: b = "123456789012"
+! These are Dominique's
+    forall (i = 3:10) a(:)(i:i+2) = a(:)(i-2:i)
+    IF (a(1) .ne. "121234567890") CALL abort ()
+    forall (i = 3:10) a(2)(i:i+2) = a(1)(i-2:i)
+    IF (a(2) .ne. "121212345678") call abort ()
+    forall (i = 3:10) b(i:i+2) = b(i-2:i)
+    IF (b .ne. "121234567890") CALL abort ()
+  end subroutine
+end
+
diff --git a/gcc/testsuite/gfortran.dg/forall_13.f90 b/gcc/testsuite/gfortran.dg/forall_13.f90
new file mode 100644
index 000000000..c7819f101
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_13.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! Tests the fix for PR33686, in which dependencies were not
+! correctly handled for the assignments below.
+!
+! Contributed by Dick Hendrickson on comp.lang.fortran,
+! " Most elegant syntax for inverting a permutation?" 20071006
+!
+! Test the fix for PR36091 as well...
+! { dg-options "-fbounds-check" }
+!
+  integer :: p(4) = (/2,4,1,3/)
+  forall (i = 1:4) p(p(i)) = i                ! This was the original
+  if (any (p .ne. (/3,1,4,2/))) call abort ()
+
+  forall (i = 1:4) p(5 - p(i)) = p(5 - i)     ! This is a more complicated version
+  if (any (p .ne. (/1,2,3,4/))) call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/forall_14.f90 b/gcc/testsuite/gfortran.dg/forall_14.f90
new file mode 100644
index 000000000..a3fb3921d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_14.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+!
+! PR fortran/46205
+!
+! Contributed by Jonathan Stott
+!
+
+program forallBug
+  logical :: valid(4) = (/ .true., .true., .false., .true. /)
+  real    :: vec(4)
+  integer :: j
+
+  ! This is an illegal statement.  It should read valid(j), not valid.
+  forall (j = 1:4, valid) ! { dg-error "requires a scalar LOGICAL expression" }
+     vec(j) = sin(2*3.14159/j)
+  end forall
+end program forallBug
diff --git a/gcc/testsuite/gfortran.dg/forall_2.f90 b/gcc/testsuite/gfortran.dg/forall_2.f90
new file mode 100644
index 000000000..223c2cea7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_2.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR fortran/25101  -- Stride must be nonzero.
+program forall_2
+   integer :: a(10),j(2),i
+   forall(i=1:2:0)  ! { dg-error "stride expression at" }
+     a(i)=1
+   end forall
+end program forall_2
+
diff --git a/gcc/testsuite/gfortran.dg/forall_3.f90 b/gcc/testsuite/gfortran.dg/forall_3.f90
new file mode 100644
index 000000000..bc5e58c80
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_3.f90
@@ -0,0 +1,18 @@
+! the problem here was that we had forgot to call
+! fold_convert in gfc_trans_pointer_assign_need_temp
+! so that we got a pointer to char instead of a 
+! pointer to an array
+! we really don't need a temp here.
+! { dg-do compile }
+
+      program test_forall
+         type element
+            character(32), pointer :: name
+         end type element
+         type(element)     :: charts(50)
+         character(32), target :: names(50)
+         forall(i=1:50)
+            charts(i)%name => names(i)
+         end forall
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/forall_4.f90 b/gcc/testsuite/gfortran.dg/forall_4.f90
new file mode 100644
index 000000000..e71e0b847
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_4.f90
@@ -0,0 +1,67 @@
+! { dg-do run }
+! Tests the fix for PR25072, in which mask expressions
+! that start with an internal or intrinsic function 
+! reference would give a syntax error.
+!
+! The fix for PR28119 is tested as well; here, the forall
+! statement could not be followed by another statement on
+! the same line.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module foo
+  integer, parameter :: n = 4
+contains
+  pure logical function foot (i)
+    integer, intent(in) :: i
+    foot = (i == 2) .or. (i == 3)
+  end function foot
+end module foo
+
+  use foo
+  integer :: i, a(n)
+  logical :: s(n)
+  s = (/(foot (i), i=1, n)/)
+
+! Check that non-mask case is still OK and the fix for PR28119
+  a = 0
+  forall (i=1:n) a(i) = i ; if (any (a .ne. (/1,2,3,4/))) call abort ()
+
+! Now a mask using a function with an explicit interface
+! via use association.
+  a = 0
+  forall (i=1:n, foot (i)) a(i) = i
+  if (any (a .ne. (/0,2,3,0/))) call abort ()
+
+! Now an array variable mask
+  a = 0
+  forall (i=1:n, .not. s(i)) a(i) = i
+  if (any (a .ne. (/1,0,0,4/))) call abort ()
+
+! This was the PR - an internal function mask
+  a = 0
+  forall (i=1:n, t (i)) a(i) = i
+  if (any (a .ne. (/0,2,0,4/))) call abort ()
+
+! Check that an expression is OK - this also gave a syntax
+! error
+  a = 0
+  forall (i=1:n, mod (i, 2) == 0) a(i) = i
+  if (any (a .ne. (/0,2,0,4/))) call abort ()
+
+! And that an expression that used to work is OK
+  a = 0
+  forall (i=1:n, s (i) .or. t(i)) a(i) = w (i)
+  if (any (a .ne. (/0,3,2,1/))) call abort ()
+
+contains
+  pure logical function t(i)
+    integer, intent(in) :: i
+    t = (mod (i, 2) == 0)
+  end function t
+  pure integer function w(i)
+    integer, intent(in) :: i
+    w = 5 - i
+  end function w
+end
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/forall_5.f90 b/gcc/testsuite/gfortran.dg/forall_5.f90
new file mode 100644
index 000000000..1d9efb904
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_5.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+! Tests the fix for PR25072, in which non-PURE functions could
+! be referenced inside a FORALL mask.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module foo
+  integer, parameter :: n = 4
+contains
+  logical function foot (i)
+    integer, intent(in) :: i
+    foot = (i == 2) .or. (i == 3)
+  end function foot
+end module foo
+
+  use foo
+  integer :: i, a(n)
+  logical :: s(n)
+
+  a = 0
+  forall (i=1:n, foot (i)) a(i) = i  ! { dg-error "non-PURE" }
+  if (any (a .ne. (/0,2,3,0/))) call abort ()
+
+  forall (i=1:n, s (i) .or. t(i)) a(i) = i  ! { dg-error "non-PURE|LOGICAL" }
+  if (any (a .ne. (/0,3,2,1/))) call abort ()
+
+  a = 0
+  forall (i=1:n, mod (i, 2) == 0) a(i) = w (i)  ! { dg-error "non-PURE" }
+  if (any (a .ne. (/0,2,0,4/))) call abort ()
+
+contains
+  logical function t(i)
+    integer, intent(in) :: i
+    t = (mod (i, 2) == 0)
+  end function t
+  integer function w(i)
+    integer, intent(in) :: i
+    w = 5 - i
+  end function w
+end
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/forall_6.f90 b/gcc/testsuite/gfortran.dg/forall_6.f90
new file mode 100644
index 000000000..158c549cc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_6.f90
@@ -0,0 +1,18 @@
+! PR fortran/30404
+! Checks that we correctly handle nested masks in nested FORALL blocks.
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+! { dg-do run }
+  logical :: l1(2,2)
+  integer :: it(2,2)
+  l1(:,:) = reshape ((/.false.,.true.,.true.,.false./), (/2,2/))
+  it(:,:) = reshape ((/1,2,3,4/), (/2,2/))
+  forall (i = 1:2, i < 3)
+    forall (j = 1:2, l1(i,j))
+      it(i, j) = 0
+    end forall
+  end forall
+!  print *, l1
+!  print '(4i2)', it
+  if (any (it .ne. reshape ((/1, 0, 0, 4/), (/2, 2/)))) call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/forall_7.f90 b/gcc/testsuite/gfortran.dg/forall_7.f90
new file mode 100644
index 000000000..bea437f3b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_7.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+  integer :: a(10,10)
+  integer :: tot
+  a(:,:) = 0
+  forall (i = 1:10)
+    forall (j = 1:10)
+      a(i,j) = 1
+    end forall
+    forall (k = 1:10)
+      a(i,k) = a(i,k) + 1
+    end forall
+  end forall
+  tot = sum(a(:,:))
+! print *, tot
+  if (tot .ne. 200) call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/forall_8.f90 b/gcc/testsuite/gfortran.dg/forall_8.f90
new file mode 100644
index 000000000..b06f3028a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_8.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+  integer a(100)
+  forall (i=1:100,.true.)
+      a(i) = 0
+  end forall
+  end
+! { dg-final { scan-tree-dump-times "temp" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/forall_9.f90 b/gcc/testsuite/gfortran.dg/forall_9.f90
new file mode 100644
index 000000000..12084b167
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_9.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+  integer a(100)
+  forall (i=1:100,.false.)
+      a(i) = 0
+  end forall
+  end
+! { dg-final { scan-tree-dump-times "temp" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/forall_char_dependencies_1.f90 b/gcc/testsuite/gfortran.dg/forall_char_dependencies_1.f90
new file mode 100644
index 000000000..cad85fb26
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_char_dependencies_1.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! Tests fix for PR29211, in which an ICE would be produced by FORALL assignments
+! with dependencies.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+  character(12), dimension(2) :: a, b
+  a= (/"abcdefghijkl","mnopqrstuvwx"/)
+! OK because it uses gfc_trans_assignment
+  forall (i=1:2) b(i) = a(i)
+! Was broken - gfc_trans_assign_need_temp had no handling of string lengths
+  forall (i=1:2) a(3-i) = a(i)
+end
diff --git a/gcc/testsuite/gfortran.dg/fseek.f90 b/gcc/testsuite/gfortran.dg/fseek.f90
new file mode 100644
index 000000000..9e3c7195a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fseek.f90
@@ -0,0 +1,52 @@
+! { dg-do run }
+
+PROGRAM test_fseek
+  INTEGER, PARAMETER :: SEEK_SET = 0, SEEK_CUR = 1, SEEK_END = 2, fd=10
+  INTEGER :: ierr = 0
+  INTEGER :: newline_length
+
+  ! We first need to determine if a newline is one or two characters
+  open (911,status="scratch")
+  write(911,"()")
+  newline_length = ftell(911)
+  close (911)
+  if (newline_length < 1 .or. newline_length > 2) call abort()
+
+  open(fd, status="scratch")
+  ! expected position: one leading blank + 10 + newline
+  WRITE(fd, *) "1234567890"
+  IF (FTELL(fd) /= 11 + newline_length) CALL abort()
+
+  ! move backward from current position
+  CALL FSEEK(fd, -11 - newline_length, SEEK_CUR, ierr)
+  IF (ierr /= 0 .OR. FTELL(fd) /= 0) CALL abort()
+
+  ! move to negative position (error)
+  CALL FSEEK(fd, -1, SEEK_SET, ierr)
+  IF (ierr == 0 .OR. FTELL(fd) /= 0) CALL abort()
+
+  ! move forward from end (11 + 10 + newline)
+  CALL FSEEK(fd, 10, SEEK_END, ierr)
+  IF (ierr /= 0 .OR. FTELL(fd) /= 21 + newline_length) CALL abort()
+
+  ! set position (0)
+  CALL FSEEK(fd, 0, SEEK_SET, ierr)
+  IF (ierr /= 0 .OR. FTELL(fd) /= 0) CALL abort()
+
+  ! move forward from current position
+  CALL FSEEK(fd, 5, SEEK_CUR, ierr)
+  IF (ierr /= 0 .OR. FTELL(fd) /= 5) CALL abort()
+
+  CALL FSEEK(fd, HUGE(0_1), SEEK_SET, ierr)
+  IF (ierr /= 0 .OR. FTELL(fd) /= HUGE(0_1)) CALL abort()
+
+  CALL FSEEK(fd, HUGE(0_2), SEEK_SET, ierr)
+  IF (ierr /= 0 .OR. FTELL(fd) /= HUGE(0_2)) CALL abort()
+
+  CALL FSEEK(fd, HUGE(0_4), SEEK_SET, ierr)
+  IF (ierr /= 0 .OR. FTELL(fd) /= HUGE(0_4)) CALL abort()
+  
+  CALL FSEEK(fd, -HUGE(0_4), SEEK_CUR, ierr)
+  IF (ierr /= 0 .OR. FTELL(fd) /= 0) CALL abort()
+END PROGRAM
+
diff --git a/gcc/testsuite/gfortran.dg/ftell_1.f90 b/gcc/testsuite/gfortran.dg/ftell_1.f90
new file mode 100644
index 000000000..4f617acb0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ftell_1.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+  integer(kind=8) o, o2
+
+  open (10, status="scratch")
+  call ftell (10, o)
+  if (o /= 0) call abort
+  write (10,"(A)") "1234567"
+  call ftell (10, o)
+  if (o /= 8 .and. o /= 9) call abort
+  write (10,"(A)") "1234567"
+  call ftell (10, o2)
+  if (o2 /= 2 * o) call abort
+  close (10)
+  call ftell (10, o)
+  if (o /= -1) call abort
+  end
diff --git a/gcc/testsuite/gfortran.dg/ftell_2.f90 b/gcc/testsuite/gfortran.dg/ftell_2.f90
new file mode 100644
index 000000000..ec7c96c3d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ftell_2.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+  integer(kind=8) o
+  open (10, status="scratch")
+  if (ftell(10) /= 0) call abort
+  write (10,"(A)") "1234567"
+  if (ftell(10) /= 8 .and. ftell(10) /= 9) call abort
+  o = ftell(10)
+  write (10,"(A)") "1234567"
+  if (ftell(10) /= 2 * o) call abort
+  close (10)
+  if (ftell(10) /= -1) call abort
+  end
diff --git a/gcc/testsuite/gfortran.dg/ftell_3.f90 b/gcc/testsuite/gfortran.dg/ftell_3.f90
new file mode 100644
index 000000000..16875d812
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ftell_3.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+! PR43605 FTELL intrinsic returns incorrect position
+! Contributed by Janne Blomqvist, Manfred Schwarb
+! and Dominique d'Humieres.
+program ftell_3
+  integer :: i, j
+  character(1) :: ch
+  character(len=99) :: buffer
+  open(10, form='formatted', position='rewind')
+  write(10, '(a)') '123456'
+  write(10, '(a)') '789'
+  write(10, '(a)') 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC'
+  write(10, '(a)') 'DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD'
+  rewind(10)
+  read(10, '(a)') buffer
+  call ftell(10, i)
+! Expected: On '\n' systems: 7, on \r\n systems: 8
+  if(i /= 7 .and. i /= 8) then
+    call abort
+  end if
+  read(10,'(a)') buffer
+  if (trim(buffer) /= "789") then
+     call abort()
+  end if
+  call ftell(10,j)
+  close(10)
+  open(10, access="stream")
+! Expected: On '\n' systems: 11, on \r\n systems: 13
+  if (i == 7) then
+    read(10, pos=7) ch
+    if (ch /= char(10)) call abort
+    if (j /= 11) call abort
+  end if
+  if (i == 8) then
+    read(10, pos=7) ch
+    if (ch /= char(13)) call abort
+    read(10) ch
+    if (ch /= char(10)) call abort
+    if (j /= 13) call abort
+  end if
+  close(10, status="delete")
+end program ftell_3
diff --git a/gcc/testsuite/gfortran.dg/func_assign.f90 b/gcc/testsuite/gfortran.dg/func_assign.f90
new file mode 100644
index 000000000..7ecf32941
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_assign.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+!
+! PR fortran/31559
+! Do not allow assigning to external functions
+!
+! Contributed by Steve Kargl <sgk@troutmask.apl.washington.edu>
+!
+module mod
+  implicit none
+contains
+  integer function bar()
+    bar = 4
+  end function bar
+
+  subroutine a() 
+   implicit none
+   real :: fun
+   external fun
+   interface
+     function funget(a)
+       integer :: a
+     end function
+     subroutine sub()
+     end subroutine sub
+   end interface
+   sub = 'a'  ! { dg-error "is not a variable" }
+   fun = 4.4  ! { dg-error "is not a variable" }
+   funget = 4 ! { dg-error "is not a variable" }
+   bar = 5    ! { dg-error "is not a variable" }
+  end subroutine a
+end module mod
+
+end
diff --git a/gcc/testsuite/gfortran.dg/func_assign_2.f90 b/gcc/testsuite/gfortran.dg/func_assign_2.f90
new file mode 100644
index 000000000..e308375ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_assign_2.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! Test the fix for PR40551 in which the assignment
+! was not dealing correctly with non-contiguous lhs
+! references; eg. a(1,:)
+!
+! Reported by by Maciej Zwierzycki
+! at http://gcc.gnu.org/ml/fortran/2009-06/msg00254.html
+! and by Tobias Burnus <burnus@gcc.gnu.org> on Bugzilla
+!
+integer :: a(2,2)
+a = -42
+a(1,:) = func()
+if (any (reshape (a, [4]) /= [1, -42, 2, -42])) call abort 
+a = -42
+a(2,:) = func()
+if (any (reshape (a, [4]) /= [-42, 1, -42, 2])) call abort 
+a = -42
+a(:,1) = func()
+if (any (reshape (a, [4]) /= [1, 2, -42, -42])) call abort 
+a = -42
+a(:,2) = func()
+if (any (reshape (a, [4]) /= [-42, -42, 1, 2])) call abort 
+contains
+ function func()
+   integer :: func(2)
+   call sub(func)
+ end function func
+ subroutine sub(a)
+   integer :: a(2)
+   a = [1,2]
+ end subroutine
+end
+
diff --git a/gcc/testsuite/gfortran.dg/func_assign_3.f90 b/gcc/testsuite/gfortran.dg/func_assign_3.f90
new file mode 100644
index 000000000..174cbc57a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_assign_3.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! Tests the fix for PR40646 in which the assignment would cause an ICE.
+!
+! Contributed by Charlie Sharpsteen  <chuck@sharpsteen.net>
+! http://gcc.gnu.org/ml/fortran/2009-07/msg00010.html
+! and reported by Tobias Burnus  <burnus@gcc,gnu.org>
+!
+module bugTestMod
+  implicit none
+  type:: boundTest
+  contains
+    procedure, nopass:: test => returnMat
+  end type boundTest
+contains
+  function returnMat( a, b ) result( mat )
+    integer:: a, b, i
+    double precision, dimension(a,b):: mat
+    mat = dble (reshape ([(i, i = 1, a * b)],[a,b])) 
+    return
+  end function returnMat
+end module bugTestMod
+
+program bugTest
+  use bugTestMod
+  implicit none
+  integer i
+  double precision, dimension(2,2):: testCatch
+  type( boundTest ):: testObj
+  testCatch = testObj%test(2,2)  ! This would cause an ICE
+  if (any (testCatch .ne. dble (reshape ([(i, i = 1, 4)],[2,2])))) call abort
+end program bugTest
+! { dg-final { cleanup-modules "bugTestMod" } }
diff --git a/gcc/testsuite/gfortran.dg/func_decl_1.f90 b/gcc/testsuite/gfortran.dg/func_decl_1.f90
new file mode 100644
index 000000000..c5576ef48
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_decl_1.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! we didn't correctly reject function declarations without argument lists
+! note that there are no end statements for syntactically wrong function
+! declarations
+  interface
+     function f1     ! { dg-error "Expected formal argument list" }
+     function f3()
+     end function f3
+     function f4 result (x) ! { dg-error "Expected formal argument list" }
+     function f5() result (x)
+     end function f5
+   end interface
+  f1 = 1.
+end
+
+FUNCTION f1          ! { dg-error "Expected formal argument list" }
+
+function f2()
+  f2 = 1.
+end function f2
+
+function f3 result (x) ! { dg-error "Expected formal argument list" }
+
+function f4 () result (x)
+  x = 4.
+end function f4
diff --git a/gcc/testsuite/gfortran.dg/func_decl_2.f90 b/gcc/testsuite/gfortran.dg/func_decl_2.f90
new file mode 100644
index 000000000..658883e65
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_decl_2.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! Test fix for PR16943 in which the double typing of
+! N caused an error.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+  program bug8 
+    implicit none 
+    stop " OK. " 
+
+  contains 
+
+    integer function bugf(M) result (N) 
+      integer, intent (in) :: M 
+      integer :: N ! { dg-error "already has basic type of INTEGER" }
+      N = M 
+      return 
+    end function bugf
+  end program bug8
diff --git a/gcc/testsuite/gfortran.dg/func_decl_3.f90 b/gcc/testsuite/gfortran.dg/func_decl_3.f90
new file mode 100644
index 000000000..4e458f47d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_decl_3.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! Tests the fix for PR24325 in which the lack of any declaration
+! that foo is a function or even a procedure was not detected.
+!
+! Contributed by Jakub Jelinek <jakub@gcc.gnu.org>
+!
+  integer foo
+  call test
+contains
+  subroutine test
+    integer :: i
+    i = foo () ! { dg-error "is not a function" }
+  end subroutine test
+end
+
diff --git a/gcc/testsuite/gfortran.dg/func_decl_4.f90 b/gcc/testsuite/gfortran.dg/func_decl_4.f90
new file mode 100644
index 000000000..edc6c7e25
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_decl_4.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-c" }
+!
+! Functions shall not have an initializer.
+!
+! Due to -fwhole-file, the function declaration
+! warnings come before the init warnings; thus
+! the warning for the WRONG lines have been moved to
+! func_decl_5.f90
+!
+
+function f1()
+  integer :: f1 = 42 ! WRONG, see  func_decl_5.f90
+end function
+
+function f2() RESULT (r)
+  integer :: r = 42 ! WRONG, see func_decl_5.f90
+end function
+
+function f3() RESULT (f3)          ! { dg-error "must be different than function name" }
+  integer :: f3 = 42
+end function                       ! { dg-error "Expecting END PROGRAM" }
+! { dg-error "Unexpected end of file" "" { target "*-*-*" } 0 }
diff --git a/gcc/testsuite/gfortran.dg/func_decl_5.f90 b/gcc/testsuite/gfortran.dg/func_decl_5.f90
new file mode 100644
index 000000000..9cd473537
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_decl_5.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-c" }
+!
+! Functions shall not have an initializer.
+!
+! Some tests were moved from func_decl_4.f90 to here.
+!
+
+function f1()                      ! { dg-error "cannot have an initializer" }
+  integer :: f1 = 42
+end function
+
+function f2() RESULT (r)           ! { dg-error "cannot have an initializer" }
+  integer :: r = 42
+end function
diff --git a/gcc/testsuite/gfortran.dg/func_derived_1.f90 b/gcc/testsuite/gfortran.dg/func_derived_1.f90
new file mode 100644
index 000000000..2cf8e449c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_derived_1.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR 17244
+! verifies that functions returning derived type work
+module m
+  type t
+     integer i
+     real x
+     character*5 c
+     integer arr(5,5)
+  end type t
+end module m
+
+use m
+type(t) :: r
+integer arr(5,5), vect(25), vect2(25)
+do i=1,25
+   vect = 0
+   vect(i) = i
+   arr = reshape (vect, shape(arr))
+   r = f(i,real(i),"HALLO",arr)
+
+   if (r%i .ne. i) call abort()
+   if (r%x .ne. real(i)) call abort()
+   if (r%c .ne. "HALLO") call abort()
+   vect2 = reshape (r%arr, shape(vect2))
+   if (any(vect2.ne.vect)) call abort()
+end do
+contains
+
+function f(i,x,c,arr)
+  type(t) :: f
+  character*5 c
+  integer arr(5,5)
+  
+  f = t(i,x,c,arr)
+end function f
+
+end
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/func_derived_2.f90 b/gcc/testsuite/gfortran.dg/func_derived_2.f90
new file mode 100644
index 000000000..35860182a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_derived_2.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+! This tests the "virtual fix" for PR19561, where functions returning
+! pointers to derived types were not generating correct code.  This
+! testcase is based on a simplified example in the PR discussion.
+!
+! Submitted by Paul Thomas  pault@gcc.gnu.org
+! Slightly extended by Tobias Schlüter
+module mpoint
+  type           ::       mytype
+    integer      ::       i
+  end type mytype
+
+contains
+
+  function get (a) result (b)
+    type (mytype), target   ::      a
+    type (mytype), pointer  ::      b
+    b => a
+  end function get
+
+  function get2 (a)
+    type (mytype), target   ::      a
+    type (mytype), pointer  ::      get2
+    get2 => a
+  end function get2
+
+end module mpoint
+
+program func_derived_2
+  use mpoint
+  type (mytype), target  ::       x
+  type (mytype), pointer ::       y
+  x = mytype (42)
+  y => get (x)
+  if (y%i.ne.42) call abort ()
+
+  x = mytype (112)
+  y => get2 (x)
+  if (y%i.ne.112) call abort ()
+end program func_derived_2
+
+! { dg-final { cleanup-modules "mpoint" } }
diff --git a/gcc/testsuite/gfortran.dg/func_derived_3.f90 b/gcc/testsuite/gfortran.dg/func_derived_3.f90
new file mode 100644
index 000000000..6facf218e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_derived_3.f90
@@ -0,0 +1,127 @@
+! { dg-do run }
+! This tests the "virtual fix" for PR19561, where pointers to derived
+! types were not generating correct code.  This testcase is based on
+! the original PR example.  This example not only tests the
+! original problem but throughly tests derived types in modules,
+! module interfaces and compound derived types.
+!
+! Original by Martin Reinecke  martin@mpa-garching.mpg.de  
+! Submitted by Paul Thomas  pault@gcc.gnu.org
+! Slightly modified by Tobias Schlüter
+module func_derived_3
+  implicit none
+  type objA
+    private
+    integer :: i
+  end type objA
+
+  interface new
+    module procedure oaInit
+  end interface
+
+  interface print
+    module procedure oaPrint
+  end interface
+
+  private
+  public objA,new,print
+
+contains
+
+  subroutine oaInit(oa,i)
+    integer :: i
+    type(objA) :: oa
+    oa%i=i
+  end subroutine oaInit
+
+  subroutine oaPrint (oa)
+    type (objA) :: oa
+    write (10, '("simple  = ",i5)') oa%i
+    end subroutine oaPrint
+
+end module func_derived_3
+
+module func_derived_3a
+  use func_derived_3
+  implicit none
+
+  type objB
+    private
+    integer :: i
+    type(objA), pointer :: oa
+  end type objB
+
+  interface new
+    module procedure obInit
+  end interface
+
+  interface print
+    module procedure obPrint
+  end interface
+
+  private
+  public objB, new, print, getOa, getOa2
+
+contains
+
+  subroutine obInit (ob,oa,i)
+    integer :: i
+    type(objA), target :: oa
+    type(objB) :: ob
+
+    ob%i=i
+    ob%oa=>oa
+  end subroutine obInit
+
+  subroutine obPrint (ob)
+    type (objB) :: ob
+    write (10, '("derived = ",i5)') ob%i
+    call print (ob%oa)
+  end subroutine obPrint
+
+  function getOa (ob) result (oa)
+    type (objB),target :: ob
+    type (objA), pointer :: oa
+
+    oa=>ob%oa
+  end function getOa
+
+! without a result clause 
+  function getOa2 (ob)
+    type (objB),target :: ob
+    type (objA), pointer :: getOa2
+
+    getOa2=>ob%oa
+  end function getOa2
+    
+end module func_derived_3a
+
+  use func_derived_3
+  use func_derived_3a
+  implicit none
+  type (objA),target :: oa
+  type (objB),target :: ob
+  character (len=80) :: line
+
+  open (10, status='scratch')
+
+  call new (oa,1)
+  call new (ob, oa, 2)
+
+  call print (ob)
+  call print (getOa (ob))
+  call print (getOa2 (ob))
+  
+  rewind (10)
+  read (10, '(80a)') line
+  if (trim (line).ne."derived =     2") call abort ()
+  read (10,  '(80a)') line
+  if (trim (line).ne."simple  =     1") call abort ()
+  read (10,  '(80a)') line
+  if (trim (line).ne."simple  =     1") call abort ()
+  read (10,  '(80a)') line
+  if (trim (line).ne."simple  =     1") call abort ()
+  close (10)
+end program
+
+! { dg-final { cleanup-modules "func_derived_3 func_derived_3a" } }
diff --git a/gcc/testsuite/gfortran.dg/func_derived_4.f90 b/gcc/testsuite/gfortran.dg/func_derived_4.f90
new file mode 100644
index 000000000..532d821de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_derived_4.f90
@@ -0,0 +1,105 @@
+! { dg-do run }
+! PR fortran/30793
+! Check that pointer-returing functions
+! work derived types.
+!
+! Contributed by Salvatore Filippone.
+!
+module class_mesh
+  type mesh
+    real(kind(1.d0)), allocatable :: area(:) 
+  end type mesh
+contains 
+  subroutine create_mesh(msh)
+    type(mesh), intent(out) :: msh
+    allocate(msh%area(10))
+    return
+  end subroutine create_mesh
+end module class_mesh
+
+module class_field
+  use class_mesh
+  implicit none
+  private ! Default
+  public :: create_field, field
+  public :: msh_
+
+  type field
+     private
+     type(mesh),     pointer :: msh   => null()
+     integer                 :: isize(2)
+  end type field
+
+  interface msh_
+    module procedure msh_
+  end interface
+  interface create_field
+    module procedure create_field
+  end interface
+contains
+  subroutine create_field(fld,msh)
+    type(field),      intent(out)        :: fld
+    type(mesh),       intent(in), target :: msh
+    fld%msh => msh
+    fld%isize = 1
+  end subroutine create_field
+
+  function msh_(fld)
+    type(mesh), pointer :: msh_
+    type(field), intent(in) :: fld
+    msh_ => fld%msh
+  end function msh_
+end module class_field
+
+module class_scalar_field
+  use class_field
+  implicit none
+  private
+  public :: create_field, scalar_field
+  public :: msh_
+
+  type scalar_field
+    private
+    type(field) :: base
+    real(kind(1.d0)), allocatable :: x(:)  
+    real(kind(1.d0)), allocatable :: bx(:) 
+    real(kind(1.d0)), allocatable :: x_old(:) 
+  end type scalar_field
+
+  interface create_field
+    module procedure create_scalar_field
+  end interface
+  interface msh_
+    module procedure get_scalar_field_msh
+  end interface
+contains
+  subroutine create_scalar_field(fld,msh)
+    use class_mesh
+    type(scalar_field), intent(out)          :: fld
+    type(mesh),         intent(in), target   :: msh
+    call create_field(fld%base,msh)
+    allocate(fld%x(10),fld%bx(20))
+  end subroutine create_scalar_field
+
+  function get_scalar_field_msh(fld)
+    use class_mesh
+    type(mesh), pointer :: get_scalar_field_msh
+    type(scalar_field), intent(in), target  :: fld
+
+    get_scalar_field_msh => msh_(fld%base)
+  end function get_scalar_field_msh
+end module class_scalar_field
+
+program test_pnt
+  use class_mesh
+  use class_scalar_field
+  implicit none
+  type(mesh) :: msh
+  type(mesh), pointer  :: mshp
+  type(scalar_field) :: quality
+  call create_mesh(msh)
+  call create_field(quality,msh)
+  mshp => msh_(quality)
+end program test_pnt
+
+! { dg-final { cleanup-modules "class_mesh class_field class_scalar_field" } }
diff --git a/gcc/testsuite/gfortran.dg/func_derived_5.f90 b/gcc/testsuite/gfortran.dg/func_derived_5.f90
new file mode 100644
index 000000000..76d45a883
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_derived_5.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! PR fortran/41369 - rejected empty type in function return values
+
+module m
+ type t
+ end type t
+end module
+
+type(t) function foo()
+  use m
+  foo = t()
+end function foo
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/func_result_1.f90 b/gcc/testsuite/gfortran.dg/func_result_1.f90
new file mode 100644
index 000000000..ce3c2e4e6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_result_1.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! From PR 19673 : We didn't dereference the the result from POINTER
+! functions with a RESULT clause
+program ret_ptr
+  if (foo(99) /= bar(99)) call abort ()
+contains
+  function foo (arg) result(ptr)
+    integer :: arg
+    integer, pointer :: ptr
+    allocate (ptr)
+    ptr = arg
+  end function foo
+  function bar (arg)
+    integer :: arg
+    integer, pointer :: bar
+    allocate (bar)
+    bar = arg
+  end function bar
+end  program ret_ptr
diff --git a/gcc/testsuite/gfortran.dg/func_result_2.f90 b/gcc/testsuite/gfortran.dg/func_result_2.f90
new file mode 100644
index 000000000..6b91653ed
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_result_2.f90
@@ -0,0 +1,10 @@
+! { dg-do run }
+! Character functions with a result clause were broken
+program testch
+  if (ch().ne."hello     ") call abort()
+contains
+  function ch () result(str)
+    character(len = 10)  :: str
+    str ="hello"
+  end function ch
+end program testch
diff --git a/gcc/testsuite/gfortran.dg/func_result_3.f90 b/gcc/testsuite/gfortran.dg/func_result_3.f90
new file mode 100644
index 000000000..d0f8c7192
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_result_3.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! PR fortran/32088
+!
+! Test implicitly defined result variables
+!
+subroutine dummy
+contains
+  function quadric(a,b) result(c)
+  intent(in) a,b; dimension a(0:3),b(0:3),c(0:9)
+    c(0)=a(0)*b(0); c(1:3)=a(1:)*b(0)+a(0)*b(1:); c(4:6)=a(1:)*b(1:)
+    c(7:9)=(/a(1)*b(2)+b(1)*a(2),a(1)*b(3)+b(1)*a(3),a(2)*b(3)+b(2)*a(3)/)
+  end function
+end subroutine dummy
+
+subroutine dummy2
+implicit none
+contains
+  function quadric(a,b) result(c) ! { dg-error "no IMPLICIT type" }
+  real :: a, b
+  intent(in) a,b; dimension a(0:3),b(0:3),c(0:9)
+    c(0)=a(0)*b(0); c(1:3)=a(1:)*b(0)+a(0)*b(1:); c(4:6)=a(1:)*b(1:)
+    c(7:9)=(/a(1)*b(2)+b(1)*a(2),a(1)*b(3)+b(1)*a(3),a(2)*b(3)+b(2)*a(3)/)
+  end function
+end subroutine dummy2
+end
diff --git a/gcc/testsuite/gfortran.dg/func_result_4.f90 b/gcc/testsuite/gfortran.dg/func_result_4.f90
new file mode 100644
index 000000000..c3da2d60f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_result_4.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-c" }
+!
+! Do not apply the SAVE attribute to function results.
+!
+FUNCTION f() RESULT (g)
+  INTEGER :: g
+  SAVE
+  g = 42
+END FUNCTION
diff --git a/gcc/testsuite/gfortran.dg/func_result_5.f90 b/gcc/testsuite/gfortran.dg/func_result_5.f90
new file mode 100644
index 000000000..5faff3950
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_result_5.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+!
+! PR fortran/42650
+!
+! Result type was not working
+!
+
+type(t) function func2() result(res)
+  type t
+    sequence
+    integer :: i = 5
+  end type t
+  res%i = 2
+end function func2
diff --git a/gcc/testsuite/gfortran.dg/func_result_6.f90 b/gcc/testsuite/gfortran.dg/func_result_6.f90
new file mode 100644
index 000000000..e8347be58
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/func_result_6.f90
@@ -0,0 +1,73 @@
+! { dg-do run }
+!
+! PR fortran/47775
+!
+! Contributed by Fran Martinez Fadrique
+!
+! Before, a temporary was missing for generic procedured (cf. test())
+! as the allocatable attribute was ignored for the check whether a
+! temporary is required
+!
+module m
+type t
+contains
+  procedure, NOPASS :: foo => foo
+  generic :: gen => foo
+end type t
+contains
+  function foo(i)
+    integer, allocatable :: foo(:)
+    integer :: i
+    allocate(foo(2))
+    foo(1) = i
+    foo(2) = i + 10
+  end function foo
+end module m
+
+use m
+type(t) :: x
+integer, pointer :: ptr1, ptr2
+integer, target              :: bar1(2)
+integer, target, allocatable :: bar2(:)
+
+allocate(bar2(2))
+ptr1 => bar1(2)
+ptr2 => bar2(2)
+
+bar1 = x%gen(1)
+if (ptr1 /= 11) call abort()
+bar1 = x%foo(2)
+if (ptr1 /= 12) call abort()
+bar2 = x%gen(3)
+if (ptr2 /= 13) call abort()
+bar2 = x%foo(4)
+if (ptr2 /= 14) call abort()
+bar2(:) = x%gen(5)
+if (ptr2 /= 15) call abort()
+bar2(:) = x%foo(6)
+if (ptr2 /= 16) call abort()
+
+call test()
+end
+
+subroutine test
+interface gen
+  procedure foo
+end interface gen
+
+integer, target :: bar(2)
+integer, pointer :: ptr
+bar = [1,2]
+ptr => bar(2)
+if (ptr /= 2) call abort()
+bar = gen()
+if (ptr /= 77) call abort()
+contains
+  function foo() ! { dg-warning "Extension: Internal procedure .foo. in generic interface" }
+    integer, allocatable :: foo(:)
+    allocate(foo(2))
+    foo = [33, 77]
+  end function foo
+end subroutine test
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/function_charlen_1.f90 b/gcc/testsuite/gfortran.dg/function_charlen_1.f90
new file mode 100644
index 000000000..e0ecc63b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/function_charlen_1.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! Tests the fix for PR34429 in which function charlens that were
+! USE associated would cause an error.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module m
+  integer, parameter :: strlen = 5
+end module m
+
+character(strlen) function test()
+  use m
+  test = 'A'
+end function test
+
+  interface
+    character(strlen) function test()
+      use m
+    end function test
+  end interface
+  print *, test()
+end
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/function_charlen_2.f90 b/gcc/testsuite/gfortran.dg/function_charlen_2.f90
new file mode 100644
index 000000000..84d3d7e95
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/function_charlen_2.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! Tests the fix for PR34429 in which function charlens that were
+! USE associated would cause an error.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module m
+  integer, parameter :: l = 2
+  character(2) :: cl
+end module m
+
+program test
+  implicit none
+  integer, parameter :: l = 5
+  character(len = 10) :: c
+  character(4) :: cl
+  c = f ()
+  if (g () /= "2") call abort
+contains
+  character(len = l) function f ()
+    use m
+    if (len (f) /= 2) call abort
+    f = "a"
+  end function f
+  character(len = len (cl)) function g ()
+    use m
+    g = "4"
+    if (len (g) == 2) g= "2"
+  end function g
+end program test
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/function_charlen_3.f b/gcc/testsuite/gfortran.dg/function_charlen_3.f
new file mode 100644
index 000000000..dd4417aba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/function_charlen_3.f
@@ -0,0 +1,18 @@
+C { dg-do compile }
+C Tests the fix for the regression PR34872, in which the re-matching of
+C the function declaration made a mess if the first executable statement
+C had a label.
+      CHARACTER FUNCTION s()
+   10 CONTINUE
+      GOTO 10
+      s = ' '
+      END FUNCTION s
+
+      CHARACTER FUNCTION t()
+   10 format ("q")
+      write (t, 10)
+      END FUNCTION t
+
+      character t
+      if (t() .ne. "q") call abort ()
+      end
diff --git a/gcc/testsuite/gfortran.dg/function_kinds_1.f90 b/gcc/testsuite/gfortran.dg/function_kinds_1.f90
new file mode 100644
index 000000000..f0140df06
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/function_kinds_1.f90
@@ -0,0 +1,54 @@
+! { dg-do run }
+! Tests the fix for PR31229, PR31154 and PR33334, in which
+! the KIND and TYPE parameters in the function declarations
+! would cause errors.
+!
+! Contributed by Brooks Moses <brooks@gcc.gnu.org>
+!           and Tobias Burnus <burnus@gcc.gnu.org>
+!
+module kinds
+  implicit none
+  integer, parameter :: dp = selected_real_kind(6)
+  type t
+     integer :: i
+  end type t
+  interface
+    real(dp) function y()
+      import
+    end function
+  end interface
+end module kinds
+
+type(t) function func() ! The legal bit of PR33334
+  use kinds
+  func%i = 5
+end function func
+
+real(dp) function another_dp_before_defined ()
+  use kinds
+  another_dp_before_defined = real (kind (4.0_DP))
+end function
+
+module mymodule;
+contains
+  REAL(2*DP) function declared_dp_before_defined()
+    use kinds, only: dp
+    real (dp) :: x
+    declared_dp_before_defined = 1.0_dp
+    x = 1.0_dp
+    declared_dp_before_defined = real (kind (x))
+  end function
+end module mymodule
+
+  use kinds
+  use mymodule
+  type(t), external :: func
+  type(t) :: z
+  if (kind (y ()) .ne. 4) call abort ()
+  if (kind (declared_dp_before_defined ()) .ne. 8) call abort ()
+  if (int (declared_dp_before_defined ()) .ne. 4) call abort ()
+  if (int (another_dp_before_defined ()) .ne. 4) call abort ()
+  z = func()
+  if (z%i .ne. 5) call abort ()
+end
+! { dg-final { cleanup-modules "kinds mymodule" } }
diff --git a/gcc/testsuite/gfortran.dg/function_kinds_2.f90 b/gcc/testsuite/gfortran.dg/function_kinds_2.f90
new file mode 100644
index 000000000..f14453df9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/function_kinds_2.f90
@@ -0,0 +1,21 @@
+! Tests the fix for PR33334, in which the TYPE in the function
+! declaration cannot be legally accessed.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module types
+ implicit none
+ type t
+   integer :: i = 99
+ end type t
+end module
+
+module x
+ use types
+ interface
+   type(t) function bar() ! { dg-error "is not accessible" }
+   end function
+ end interface
+end module
+! { dg-final { cleanup-modules "types x" } }
+
diff --git a/gcc/testsuite/gfortran.dg/function_kinds_3.f90 b/gcc/testsuite/gfortran.dg/function_kinds_3.f90
new file mode 100644
index 000000000..b1dd2b4a2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/function_kinds_3.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+!
+! PR fortran/34254
+!
+! The character-kind parameter was not accepted.
+!
+module m
+  integer, parameter :: char_t = kind('a')
+end module m
+
+character(1,char_t) function test1()
+  use m
+  test1 = 'A'
+end function test1
+
+character(len=1,kind=char_t) function test2()
+  use m
+  test2 = 'A'
+end function test2
+
+character(kind=char_t,len=1) function test3()
+  use m
+  test3 = 'A'
+end function test3
+
+character(1,kind=char_t) function test4()
+  use m
+  test4 = 'A'
+end function test4
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/function_kinds_4.f90 b/gcc/testsuite/gfortran.dg/function_kinds_4.f90
new file mode 100644
index 000000000..bcde1e447
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/function_kinds_4.f90
@@ -0,0 +1,56 @@
+! { dg-do run }
+! Tests the fix for PR34471 in which function KINDs that were
+! USE associated would cause an error.
+!
+! This only needs to be run once.
+! { dg-options "-O2" }
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module m1
+  integer, parameter :: i1 = 1, i2 = 2
+end module m1
+
+module m2
+  integer, parameter :: i1 = 8
+end module m2
+
+integer(i1) function three()
+  use m1, only: i2
+  use m2                ! This provides the function kind
+  three = i1
+  if(three /= kind(three)) call abort()
+end function three
+
+! At one stage during the development of the patch, this started failing
+! but was not tested in gfortran.dg.  */
+real (kind(0d0)) function foo ()
+  foo = real (kind (foo))
+end function
+
+program main
+implicit none
+ interface
+    integer(8) function three()
+    end function three
+ end interface
+ integer, parameter :: i1 = 4
+ integer :: i
+ real (kind(0d0)) foo
+ i = one()
+ i = two()
+ if(three() /= 8) call abort()
+ if (int(foo()) /= 8) call abort ()
+contains
+ integer(i1) function one()  ! Host associated kind
+   if (kind(one) /= 4) call abort()
+   one = 1
+ end function one
+ integer(i1) function two()  ! Use associated kind
+   use m1, only: i2
+   use m2
+   if (kind(two) /= 8) call abort()
+   two = 1
+ end function two
+end program main
+! { dg-final { cleanup-modules "m1 m2" } }
diff --git a/gcc/testsuite/gfortran.dg/function_kinds_5.f90 b/gcc/testsuite/gfortran.dg/function_kinds_5.f90
new file mode 100644
index 000000000..e48484ec3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/function_kinds_5.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! Tests the fix for PR34471 in which function KINDs that were
+! USE associated would cause an error.  This checks a regression
+! caused by an intermediate version of the patch.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+real (bad_kind(0d0)) function foo () ! { dg-error "must be an intrinsic function" }
+  foo = real (kind (foo))
+end function
diff --git a/gcc/testsuite/gfortran.dg/function_types_1.f90 b/gcc/testsuite/gfortran.dg/function_types_1.f90
new file mode 100644
index 000000000..fb18d2f0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/function_types_1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! Tests the fix for PR34431 in which function TYPEs that were
+! USE associated would cause an error.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module bar
+contains
+  type(non_exist) function func2() ! { dg-error "not accessible" }
+  end function func2
+end module bar
+! { dg-final { cleanup-modules "bar" } }
diff --git a/gcc/testsuite/gfortran.dg/function_types_2.f90 b/gcc/testsuite/gfortran.dg/function_types_2.f90
new file mode 100644
index 000000000..b3b5a0aee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/function_types_2.f90
@@ -0,0 +1,104 @@
+! { dg-do compile }
+! Tests the fix for PR34431 in which function TYPEs that were
+! USE associated would cause an error.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module m1
+  integer :: hh
+  type t
+    real :: r
+  end type t
+end module m1
+
+module m2
+  type t
+    integer :: k
+  end type t
+end module m2
+
+module m3
+contains
+  type(t) function func()
+    use m2
+    func%k = 77
+  end function func
+end module m3
+
+type(t) function a()
+  use m1, only: hh
+  type t2
+    integer :: j
+  end type t2
+  type t
+    logical :: b
+  end type t
+
+  a%b = .true.
+end function a
+
+type(t) function b()
+  use m1, only: hh
+  use m2
+  use m3
+  b = func ()
+  b%k = 5
+end function b
+
+type(t) function c()
+  use m1, only: hh
+  type t2
+    integer :: j
+  end type t2
+  type t
+    logical :: b
+  end type t
+
+  c%b = .true.
+end function c
+
+program main
+  type t
+    integer :: m
+  end type t
+contains
+  type(t) function a1()
+    use m1, only: hh
+    type t2
+      integer :: j
+    end type t2
+    type t
+      logical :: b
+    end type t
+
+    a1%b = .true.
+  end function a1
+
+  type(t) function b1()
+    use m1, only: hh
+    use m2, only: t
+! NAG f95 believes that the host-associated type(t)
+! should be used:
+!   b1%m = 5
+! However, I (Tobias Burnus) believe that the use-associated one should
+! be used:
+    b1%k = 5
+  end function b1
+
+  type(t) function c1()
+    use m1, only: hh
+    type t2
+      integer :: j
+    end type t2
+    type t
+      logical :: b
+    end type t
+
+    c1%b = .true.
+  end function c1
+
+  type(t) function d1()
+    d1%m = 55
+  end function d1
+end program main
+! { dg-final { cleanup-modules "m1 m2 m3" } }
diff --git a/gcc/testsuite/gfortran.dg/g77/12002.f b/gcc/testsuite/gfortran.dg/g77/12002.f
new file mode 100644
index 000000000..0cb29c754
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/12002.f
@@ -0,0 +1,6 @@
+C      PR middle-end/12002
+C { dg-do compile }
+       COMPLEX TE1
+       TE1=-2.
+       TE1=TE1+TE1
+       END
diff --git a/gcc/testsuite/gfortran.dg/g77/12632.f b/gcc/testsuite/gfortran.dg/g77/12632.f
new file mode 100644
index 000000000..398333926
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/12632.f
@@ -0,0 +1,6 @@
+C { dg-do compile }
+C { dg-options "-fbounds-check" }
+       INTEGER I(1)
+       I(2) = 0  ! { dg-warning "out of bounds" "out of bounds" }
+       END
+
diff --git a/gcc/testsuite/gfortran.dg/g77/13037.f b/gcc/testsuite/gfortran.dg/g77/13037.f
new file mode 100644
index 000000000..01c2bab19
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/13037.f
@@ -0,0 +1,59 @@
+c { dg-do run }
+c      PR optimization/13037
+c      Contributed by Kirill Smelkov
+c      bug symptom: zeta(kkzc) seems to reference to zeta(kkzc-1) instead
+c      with gcc-3.2.2 it is OK, so it is a regression.
+c
+      subroutine bug1(expnt)
+      implicit none
+
+      double precision zeta
+      common /bug1_area/zeta(3)
+
+      double precision expnt(3)
+
+
+      integer k, kkzc
+
+      kkzc=0
+      do k=1,3
+         kkzc = kkzc + 1
+         zeta(kkzc) = expnt(k)
+      enddo
+
+c     the following line activates the bug
+      call bug1_activator(kkzc)
+      end
+
+
+c     dummy subroutine
+      subroutine bug1_activator(inum)
+      implicit none
+      integer inum
+      end
+
+
+c     test driver
+      program test_bug1
+      implicit none
+
+      double precision zeta
+      common /bug1_area/zeta(3)
+
+      double precision expnt(3)
+
+      zeta(1) = 0.0d0
+      zeta(2) = 0.0d0
+      zeta(3) = 0.0d0
+
+      expnt(1) = 1.0d0
+      expnt(2) = 2.0d0
+      expnt(3) = 3.0d0
+
+      call bug1(expnt)
+      if ((zeta(1).ne.1) .or. (zeta(2).ne.2) .or. (zeta(3).ne.3)) then
+        call abort
+      endif
+
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/g77/13060.f b/gcc/testsuite/gfortran.dg/g77/13060.f
new file mode 100644
index 000000000..4c1b3e723
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/13060.f
@@ -0,0 +1,14 @@
+c { dg-do compile }
+      subroutine geo2()
+      implicit none
+
+      integer ms,n,ne(2)
+
+      ne(1) = 1
+      ne(2) = 2
+      ms = 1
+
+      call call_me(ne(1)*ne(1))
+
+      n = ne(ms)
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/1832.f b/gcc/testsuite/gfortran.dg/g77/1832.f
new file mode 100644
index 000000000..6b7617d62
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/1832.f
@@ -0,0 +1,9 @@
+c { dg-do run }
+! { dg-options "-std=legacy" }
+!
+      character*5   string
+      write(string, *) "a "
+      if (string .ne. ' a') call abort
+C-- The leading space is normal for list-directed output
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/19981119-0.f b/gcc/testsuite/gfortran.dg/g77/19981119-0.f
new file mode 100644
index 000000000..17c6e0640
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19981119-0.f
@@ -0,0 +1,41 @@
+c { dg-do run }
+* X-Delivered: at request of burley on mescaline.gnu.org
+* Date: Sat, 31 Oct 1998 18:26:29 +0200 (EET)
+* From: "B. Yanchitsky" <yan@im.imag.kiev.ua>
+* To: fortran@gnu.org
+* Subject: Bug report
+* MIME-Version: 1.0
+* Content-Type: TEXT/PLAIN; charset=US-ASCII
+* 
+* There is a trouble with g77 on Alpha.
+* My configuration: 
+* Digital Personal Workstation 433au,
+* Digital Unix 4.0D,
+* GNU Fortran 0.5.23 and GNU C 2.8.1.
+* 
+* The following program treated successfully but crashed when running. 
+* 
+* C --- PROGRAM BEGIN -------
+* 
+      subroutine sub(N,u)
+      integer N
+      double precision u(-N:N,-N:N)
+
+C vvvv    CRASH HERE   vvvvv   
+      u(-N,N)=0d0
+      return
+      end
+
+
+      program bug
+      integer N
+      double precision a(-10:10,-10:10)
+      data a/441*1d0/
+      N=10
+      call sub(N,a)
+      if (a(-N,N) .ne. 0d0) call abort
+      end
+* 
+* C --- PROGRAM END -------
+* 
+* Good luck!
diff --git a/gcc/testsuite/gfortran.dg/g77/19981216-0.f b/gcc/testsuite/gfortran.dg/g77/19981216-0.f
new file mode 100644
index 000000000..82d259d3c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19981216-0.f
@@ -0,0 +1,92 @@
+c { dg-do compile }
+c { dg-options "-std=legacy" }
+c
+* Resent-From: Craig Burley <burley@gnu.org>
+* Resent-To: craig@jcb-sc.com
+* X-Delivered: at request of burley on mescaline.gnu.org
+* Date: Wed, 16 Dec 1998 18:31:24 +0100
+* From: Dieter Stueken <stueken@conterra.de>
+* Organization: con terra GmbH
+* To: fortran@gnu.org
+* Subject: possible bug
+* Content-Type: text/plain; charset=iso-8859-1
+* X-Mime-Autoconverted: from 8bit to quoted-printable by mescaline.gnu.org id KAA09085
+* X-UIDL: 72293bf7f9fac8378ec7feca2bccbce2
+* 
+* Hi,
+* 
+* I'm about to compile a very old, very ugly Fortran program.
+* For one part I got:
+* 
+* f77: Internal compiler error: program f771 got fatal signal 6
+* 
+* instead of any detailed error message. I was able to break down the
+* problem to the following source fragment:
+* 
+* -------------------------------------------
+        PROGRAM WAP
+
+        integer(kind=8)  ios
+        character*80  name
+
+        name = 'blah'
+        open(unit=8,status='unknown',file=name,form='formatted',
+     F       iostat=ios)
+
+      END
+* -------------------------------------------
+* 
+* The problem seems to be caused by the "integer(kind=2) ios" declaration.
+* So far I solved it by simply using a plain integer instead.
+* 
+* I'm running gcc on a Linux system compiled/installed
+* with no special options:
+* 
+* -> g77 -v
+* g77 version 0.5.23
+* Driving: g77 -v -c -xf77-version /dev/null -xnone
+* Reading specs from /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/specs
+* gcc version 2.8.1
+*  /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/cpp -lang-c -v -undef
+* -D__GNUC__=2 -D__GNUC_MINOR__=8 -D__ELF__ -D__unix__ -D__linux__
+* -D__unix -D__linux -Asystem(posix) -D_LANGUAGE_FORTRAN -traditional
+* -Di386 -Di686 -Asystem(unix) -Acpu(i386) -Amachine(i386) -D__i386__
+* -D__i686__ -Asystem(unix) -Acpu(i386) -Amachine(i386) /dev/null
+* /dev/null
+* GNU CPP version 2.8.1 (i386 GNU/Linux with ELF)
+* #include "..." search starts here:
+* #include <...> search starts here:
+*  /usr/local/include
+*  /usr/i686-pc-linux-gnulibc1/include
+*  /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/include
+*  /usr/include
+* End of search list.
+*  /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/f771 -fnull-version
+* -quiet -dumpbase g77-version.f -version -fversion -o /tmp/cca24911.s
+* /dev/null
+* GNU F77 version 2.8.1 (i686-pc-linux-gnulibc1) compiled by GNU C version
+* 2.8.1.
+* GNU Fortran Front End version 0.5.23
+*  as -V -Qy -o /tmp/cca24911.o /tmp/cca24911.s
+* GNU assembler version 2.8.1 (i486-linux), using BFD version 2.8.1
+*  ld -m elf_i386 -dynamic-linker /lib/ld-linux.so.1 -o /tmp/cca24911
+* /tmp/cca24911.o /usr/lib/crt1.o /usr/lib/crti.o
+* /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/crtbegin.o
+* -L/usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1 -L/usr -lg2c -lm -lgcc
+* -lc -lgcc /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/crtend.o
+* /usr/lib/crtn.o
+*  /tmp/cca24911
+* __G77_LIBF77_VERSION__: 0.5.23
+* @(#)LIBF77 VERSION 19970919
+* __G77_LIBI77_VERSION__: 0.5.23
+* @(#) LIBI77 VERSION pjw,dmg-mods 19980405
+* __G77_LIBU77_VERSION__: 0.5.23
+* @(#) LIBU77 VERSION 19970919
+* 
+* 
+* Regards, Dieter.
+* -- 
+* Dieter Stüken, con terra GmbH, Münster
+*     stueken@conterra.de         stueken@qgp.uni-muenster.de
+*     http://www.conterra.de/     http://qgp.uni-muenster.de/~stueken
+*     (0)251-980-2027             (0)251-83-334974
diff --git a/gcc/testsuite/gfortran.dg/g77/19990218-0.f b/gcc/testsuite/gfortran.dg/g77/19990218-0.f
new file mode 100644
index 000000000..57bb63841
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990218-0.f
@@ -0,0 +1,14 @@
+c { dg-do compile }
+        program test
+        double precision a,b,c
+        data a,b/1.0d-46,1.0d0/
+        c=fun(a,b) ! { dg-error "Return type mismatch of function" }
+        print*,'in main: fun=',c
+        end
+        double precision function fun(a,b)
+        double precision a,b
+        print*,'in sub: a,b=',a,b
+        fun=a*b
+        print*,'in sub: fun=',fun
+        return
+        end
diff --git a/gcc/testsuite/gfortran.dg/g77/19990218-1.f b/gcc/testsuite/gfortran.dg/g77/19990218-1.f
new file mode 100644
index 000000000..8506e4fe1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990218-1.f
@@ -0,0 +1,25 @@
+c { dg-do compile }
+c
+c  g77 used to warn for this case
+c 19990218-1.f: In program `test':
+c 19990218-1.f:13: 
+c             double precision function fun(a,b)
+c                                       1
+c  19990218-1.f:23: (continued):
+c             c=fun(a,b)
+c               2
+c  Global name `fun' at (2) has different type at (1) [info -f g77 M GLOBALS]
+c
+        double precision function fun(a,b)
+        double precision a,b
+        print*,'in sub: a,b=',a,b
+        fun=a*b
+        print*,'in sub: fun=',fun
+        return
+        end
+        program test
+        double precision a,b,c
+        data a,b/1.0d-46,1.0d0/
+        c=fun(a,b) ! { dg-error "Return type mismatch of function" }
+        print*,'in main: fun=',c
+        end
diff --git a/gcc/testsuite/gfortran.dg/g77/19990305-0.f b/gcc/testsuite/gfortran.dg/g77/19990305-0.f
new file mode 100644
index 000000000..056d2b7a3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990305-0.f
@@ -0,0 +1,56 @@
+c { dg-do compile }
+* Date: Fri, 5 Mar 1999 00:35:44 -0500 (EST)
+* From: Denes Molnar <molnard@phys.columbia.edu>
+* To: fortran@gnu.org
+* Subject: f771 gets fatal signal 6
+* Content-Type: TEXT/PLAIN; charset=US-ASCII
+* X-UIDL: 8d81e9cbdcc96209c6e9b298d966ba7f
+*
+* Hi,
+*
+*
+* Comiling object from the source code below WORKS FINE with
+*   'g77 -o hwuci2 -c hwuci2.F'
+* but FAILS with fatal signal 6
+*   'g77 -o hwuci2 -O -c hwuci2.F'
+*
+* Any explanations?
+*
+* I am running GNU Fortran 0.5.23 with GCC 2.8.1 (glibc1).
+*
+*
+* Denes Molnar
+*
+* %%%%%%%%%%%%%%%%%%%%%%%%%
+* %the source:
+* %%%%%%%%%%%%%%%%%%%%%%%%%
+*
+CDECK  ID>, HWUCI2.
+*CMZ :-        -23/08/94  13.22.29  by  Mike Seymour
+*-- Author :    Ulrich Baur & Nigel Glover, adapted by Ian Knowles
+C-----------------------------------------------------------------------
+      FUNCTION HWUCI2(A,B,Y0)
+C-----------------------------------------------------------------------
+C     Integral  LOG(A-EPSI-BY(1-Y))/(Y-Y0)
+C-----------------------------------------------------------------------
+      IMPLICIT NONE
+      complex(kind=8) HWUCI2,HWULI2,EPSI,Y1,Y2,Z1,Z2,Z3,Z4
+      DOUBLE PRECISION A,B,Y0,ZERO,ONE,FOUR,HALF
+      EXTERNAL HWULI2
+      COMMON/SMALL/EPSI
+      PARAMETER (ZERO=0.D0, ONE =1.D0, FOUR= 4.D0, HALF=0.5D0)
+      IF(B.EQ.ZERO)THEN
+         HWUCI2=CMPLX(ZERO,ZERO)
+      ELSE
+         Y1=HALF*(ONE+SQRT(ONE-FOUR*(A+EPSI)/B))
+         Y2=ONE-Y1
+         Z1=Y0/(Y0-Y1)
+         Z2=(Y0-ONE)/(Y0-Y1)
+         Z3=Y0/(Y0-Y2)
+         Z4=(Y0-ONE)/(Y0-Y2)
+         HWUCI2=HWULI2(Z1)-HWULI2(Z2)+HWULI2(Z3)-HWULI2(Z4)
+      ENDIF
+      RETURN
+      END
+*
+* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/gcc/testsuite/gfortran.dg/g77/19990313-0.f b/gcc/testsuite/gfortran.dg/g77/19990313-0.f
new file mode 100644
index 000000000..fd74351d2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990313-0.f
@@ -0,0 +1,34 @@
+c { dg-do run }
+* To: craig@jcb-sc.com
+* Subject: Re: G77 and KIND=2
+* Content-Type: text/plain; charset=us-ascii
+* From: Dave Love <d.love@dl.ac.uk>
+* Date: 03 Mar 1999 18:20:11 +0000
+* In-Reply-To: craig@jcb-sc.com's message of "1 Mar 1999 21:04:38 -0000"
+* User-Agent: Gnus/5.07007 (Pterodactyl Gnus v0.70) Emacs/20.3
+* X-UIDL: d442bafe961c2a6ec6904f492e05d7b0
+* 
+* ISTM that there is a real problem printing integer(kind=8) (on x86):
+* 
+* $ cat x.f
+*[modified for test suite]
+        integer(kind=8) foo, bar
+        data r/4e10/
+        foo = 4e10
+        bar = r
+        if (foo .ne. bar) call abort
+        end
+* $ g77 x.f && ./a.out
+*  1345294336
+*  123
+* $ f2c x.f && g77 x.c && ./a.out
+* x.f:
+*    MAIN:
+*  40000000000
+*  123
+* $
+* 
+* Gdb shows the upper half of the buffer passed to do_lio is zeroed in
+* the g77 case.
+* 
+* I've forgotten how the code generation happens.
diff --git a/gcc/testsuite/gfortran.dg/g77/19990313-1.f b/gcc/testsuite/gfortran.dg/g77/19990313-1.f
new file mode 100644
index 000000000..a73ec4ea7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990313-1.f
@@ -0,0 +1,8 @@
+c { dg-do run }
+        integer(kind=8) foo, bar
+        double precision r
+        data r/4d10/
+        foo = 4d10
+        bar = r
+        if (foo .ne. bar) call abort
+        end
diff --git a/gcc/testsuite/gfortran.dg/g77/19990313-2.f b/gcc/testsuite/gfortran.dg/g77/19990313-2.f
new file mode 100644
index 000000000..51f16685e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990313-2.f
@@ -0,0 +1,8 @@
+c { dg-do run }
+       integer(kind=8) foo, bar
+       complex c
+        data c/(4e10,0)/
+        foo = 4e10
+        bar = c
+        if (foo .ne. bar) call abort
+        end
diff --git a/gcc/testsuite/gfortran.dg/g77/19990313-3.f b/gcc/testsuite/gfortran.dg/g77/19990313-3.f
new file mode 100644
index 000000000..782f39568
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990313-3.f
@@ -0,0 +1,8 @@
+c { dg-do run }
+        integer(kind=8) foo, bar
+        complex(kind=8) c
+        data c/(4d10,0)/
+        foo = 4d10
+        bar = c
+        if (foo .ne. bar) call abort
+        end
diff --git a/gcc/testsuite/gfortran.dg/g77/19990419-0.f b/gcc/testsuite/gfortran.dg/g77/19990419-0.f
new file mode 100644
index 000000000..68f4ddabe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990419-0.f
@@ -0,0 +1,8 @@
+c { dg-do compile }
+* Test case Toon submitted, cut down to expose the one bug.
+* Belongs in compile/.
+      SUBROUTINE INIERS1
+      IMPLICIT   LOGICAL(L)
+      COMMON/COMIOD/ NHIERS1, LERS1
+      inquire(nhiers1, exist=lers1)
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/19990419-1.f b/gcc/testsuite/gfortran.dg/g77/19990419-1.f
new file mode 100644
index 000000000..e6a4a9bc0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990419-1.f
@@ -0,0 +1,22 @@
+c { dg-do run }
+* Test DO WHILE, to make sure it fully reevaluates its expression.
+* Belongs in execute/.
+      common /x/ ival
+      j = 0
+      do while (i() .eq. 1)
+         j = j + 1
+         if (j .gt. 5) call abort
+      end do
+      if (j .ne. 4) call abort
+      if (ival .ne. 5) call abort
+      end
+      function i()
+      common /x/ ival
+      ival = ival + 1
+      i = 10
+      if (ival .lt. 5) i = 1
+      end
+      block data
+      common /x/ ival
+      data ival/0/
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/19990502-0.f b/gcc/testsuite/gfortran.dg/g77/19990502-0.f
new file mode 100644
index 000000000..a82f8838d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990502-0.f
@@ -0,0 +1,67 @@
+c { dg-do compile }
+* Mailing-List: contact egcs-bugs-help@egcs.cygnus.com; run by ezmlm
+* Precedence: bulk
+* Sender: owner-egcs-bugs@egcs.cygnus.com
+* From: Norbert Conrad <Norbert.Conrad@hrz.uni-giessen.de>
+* Subject: egcs g77 19990524pre Internal compiler error in `print_operand'
+* To: egcs-bugs@egcs.cygnus.com
+* Date: Mon, 31 May 1999 11:46:52 +0200 (CET)
+* Content-Type: text/plain; charset=US-ASCII
+* X-UIDL: 9a00095a5fe4d774b7223de071157374
+* 
+* Hi,
+* 
+* I ./configure --prefix=/opt and bootstrapped egcs g77 snapshot 19990524
+* on an i686-pc-linux-gnu. The program below gives an internal compiler error.
+* 
+* 
+* Script started on Mon May 31 11:30:01 1999
+* lx{g010}:/tmp>/opt/bin/g77 -v -O3 -malign-double -c e3.f
+* g77 version gcc-2.95 19990524 (prerelease) (from FSF-g77 version 0.5.24-19990515)
+* Reading specs from /opt/lib/gcc-lib/i686-pc-linux-gnu/gcc-2.95/specs
+* gcc version gcc-2.95 19990524 (prerelease)
+*  /opt/lib/gcc-lib/i686-pc-linux-gnu/gcc-2.95/f771 e3.f -quiet -dumpbase e3.f -malign-double -O3 -version -fversion -o /tmp/ccQgeaaa.s
+* GNU F77 version gcc-2.95 19990524 (prerelease) (i686-pc-linux-gnu) compiled by GNU C version gcc-2.95 19990524 (prerelease).
+* GNU Fortran Front End version 0.5.24-19990515
+* e3.f:25: Internal compiler error in `print_operand', at ./config/i386/i386.c:3405
+* Please submit a full bug report to `egcs-bugs@egcs.cygnus.com'.
+* See <URL:http://egcs.cygnus.com/faq.html#bugreport> for details.
+* lx{g010}:/tmp>cat e3.f
+      SUBROUTINE DLASQ2( QQ, EE,  TOL2, SMALL2 )
+      DOUBLE PRECISION   SMALL2, TOL2
+      DOUBLE PRECISION   EE( * ), QQ( * )
+      INTEGER            ICONV,  N, OFF
+      DOUBLE PRECISION   QEMAX, XINF
+      EXTERNAL           DLASQ3
+      INTRINSIC          MAX, SQRT
+      XINF = 0.0D0
+      ICONV = 0
+      IF( EE( N ).LE.MAX( QQ( N ), XINF, SMALL2 )*TOL2 ) THEN
+      END IF
+      IF( EE( N-2 ).LE.MAX( XINF, SMALL2,
+     $    ( QQ( N ) / ( QQ( N )+EE( N-1 ) ) )* QQ( N-1 ))*TOL2 ) THEN
+         QEMAX = MAX( QQ( N ), QQ( N-1 ), EE( N-1 ) )
+      END IF
+      IF( N.EQ.0 ) THEN
+         IF( OFF.EQ.0 ) THEN
+            RETURN
+         ELSE
+            XINF =0.0D0 
+         END IF
+      ELSE IF( N.EQ.2 ) THEN
+      END IF
+      CALL DLASQ3(ICONV)
+      END
+* lx{g010}:/tmp>exit
+* 
+* Script done on Mon May 31 11:30:23 1999
+* 
+* Best regards,
+* 
+* Norbert.
+* -- 
+* Norbert Conrad                             phone: ++49 641 9913021
+* Hochschulrechenzentrum                     email: conrad@hrz.uni-giessen.de
+* Heinrich-Buff-Ring 44
+* 35392 Giessen
+* Germany
diff --git a/gcc/testsuite/gfortran.dg/g77/19990502-1.f b/gcc/testsuite/gfortran.dg/g77/19990502-1.f
new file mode 100644
index 000000000..dde2769f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990502-1.f
@@ -0,0 +1,7 @@
+c { dg-do compile }
+      SUBROUTINE G(IGAMS,IWRK,NADC,NCellsInY)
+      INTEGER(kind=2) IGAMS(2,NADC)
+      in = 1
+      do while (in.le.nadc.and.IGAMS(2,in).le.in)
+      enddo
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/19990525-0.f b/gcc/testsuite/gfortran.dg/g77/19990525-0.f
new file mode 100644
index 000000000..4eb104cdb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990525-0.f
@@ -0,0 +1,53 @@
+c { dg-do compile }
+c { dg-options "-std=legacy" }
+c
+* Mailing-List: contact egcs-bugs-help@egcs.cygnus.com; run by ezmlm
+* Precedence: bulk
+* Sender: owner-egcs-bugs@egcs.cygnus.com
+* From: "Bjorn R. Bjornsson" <brb@halo.hi.is>
+* Subject: g77 char expr. as arg to subroutine bug
+* To: egcs-bugs@egcs.cygnus.com
+* Date: Tue, 25 May 1999 14:45:56 +0000 (GMT)
+* Content-Type: text/plain; charset=US-ASCII
+* X-UIDL: 06000c94269ed6dfe826493e52a818b9
+* 
+* The following bug is in all snapshots starting
+* from April 18.  I have only tested this on Alpha linux,
+* and with FFECOM_FASTER_ARRAY_REFS set to 1.
+* 
+* Run the following through g77:
+* 
+      subroutine a
+      character*2 string1
+      character*2 string2
+      character*4 string3
+      string1 = 's1'
+      string2 = 's2'
+c
+c the next 2 lines are ok.
+      string3 = (string1 // string2)
+      call b(string1//string2)
+c
+c this line gives gcc/f/com.c:10660: failed assertion `hook'
+      call b((string1//string2))
+      end
+* 
+* the output from:
+* 
+* /usr/local/egcs-19990418/bin/g77 --verbose -c D.f
+* 
+* is:
+* 
+* on egcs-2.93.19 19990418 (gcc2 ss-980929 experimental) (from FSF-g77 version 0.5.24-19990418)
+* Reading specs from /usr/local/egcs-19990418/lib/gcc-lib/alphaev56-unknown-linux-gnu/egcs-2.93.19/specs
+* gcc version egcs-2.93.19 19990418 (gcc2 ss-980929 experimental)
+*  /usr/local/egcs-19990418/lib/gcc-lib/alphaev56-unknown-linux-gnu/egcs-2.93.19/f771 D.f -quiet -dumpbase D.f -version -fversion -o /tmp/ccNpaaaa.s
+* GNU F77 version egcs-2.93.19 19990418 (gcc2 ss-980929 experimental) (alphaev56-unknown-linux-gnu) compiled by GNU C version egcs-2.93.19 19990418 (gcc2 ss-980929 experimental).
+* GNU Fortran Front End version 0.5.24-19990418
+* ../../../egcs-19990418/gcc/f/com.c:10351: failed assertion `hook'
+* g77: Internal compiler error: program f771 got fatal signal 6
+* 
+* Yours,
+* 
+* Bjorn R. Bjornsson
+* brb@halo.hi.is
diff --git a/gcc/testsuite/gfortran.dg/g77/19990826-0.f b/gcc/testsuite/gfortran.dg/g77/19990826-0.f
new file mode 100644
index 000000000..bc471f0bf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990826-0.f
@@ -0,0 +1,20 @@
+c { dg-do run }
+* From: niles@fan745.gsfc.nasa.gov
+* To: fortran@gnu.org
+* Cc: niles@fan745.gsfc.nasa.gov
+* Subject: problem with DNINT() on Linux/Alpha.
+* Date: Sun, 06 Jun 1999 16:39:35 -0400
+* X-UIDL: 6aa9208d7bda8b6182a095dfd37016b7
+
+      IF (DNINT(0.0D0) .NE. 0.) CALL ABORT
+      STOP
+      END
+
+* Result on Linux/i386: " 0."  (and every other computer!)
+* Result on Linux/alpha: " 3.6028797E+16"
+
+* It seems to work fine if I change it to the generic NINT().  Probably
+* a name pollution problem in the new C library, but it seems bad. no?
+
+* Thanks,
+* Rick Niles.
diff --git a/gcc/testsuite/gfortran.dg/g77/19990826-1.f b/gcc/testsuite/gfortran.dg/g77/19990826-1.f
new file mode 100644
index 000000000..d9dd70b88
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990826-1.f
@@ -0,0 +1,287 @@
+c { dg-do compile }
+* Date: Tue, 24 Aug 1999 12:25:41 +1200 (NZST)
+* From: Jonathan Ravens <ravens@whio.gns.cri.nz>
+* To: gcc-bugs@gcc.gnu.org
+* Subject: g77 bug report
+* X-UIDL: a0bf5ecc21487cde48d9104983ab04d6
+
+! This fortran source will not compile - if the penultimate elseif block is 0
+! included then the message appears :
+!
+!   /usr/src/egcs//gcc-2.95.1/gcc/f/stw.c:308: failed assertion `b->uses_ > 0'
+!   g77: Internal compiler error: program f771 got fatal signal 6
+!
+! The command was : g77 -c <prog.f>
+!
+! The OS is Red Hat 6, and the output from uname -a is 
+!   Linux grfw1452.gns.cri.nz 2.2.5-15 #1 Mon Apr 19 23:00:46 EDT 1999 i686 unknown
+!
+! The configure script I used was 
+!   /usr/src/egcs/gcc/gcc-2.95.1/configure --enable-languages=f77 i585-unknown-linux
+!
+! I was installing 2.95 because under EGCS 2.1.1 none of my code was working
+! with optimisation turned on, and there were still bugs with no optimisation
+! (all of which code works fine under g77 0.5.21 and Sun/IBM/Dec/HP fortrans).
+!
+! The version of g77 is :
+!
+!g77 version 2.95.1 19990816 (release) (from FSF-g77 version 0.5.25 19990816 (release))
+
+        program main
+        if (i.eq.1) then
+            call abc(1)
+        else if (i.eq. 1) then
+            call abc( 1)
+        else if (i.eq. 2) then
+            call abc( 2)
+        else if (i.eq. 3) then
+            call abc( 3)
+        else if (i.eq. 4) then
+            call abc( 4)
+        else if (i.eq. 5) then
+            call abc( 5)
+        else if (i.eq. 6) then
+            call abc( 6)
+        else if (i.eq. 7) then
+            call abc( 7)
+        else if (i.eq. 8) then
+            call abc( 8)
+        else if (i.eq. 9) then
+            call abc( 9)
+        else if (i.eq. 10) then
+            call abc( 10)
+        else if (i.eq. 11) then
+            call abc( 11)
+        else if (i.eq. 12) then
+            call abc( 12)
+        else if (i.eq. 13) then
+            call abc( 13)
+        else if (i.eq. 14) then
+            call abc( 14)
+        else if (i.eq. 15) then
+            call abc( 15)
+        else if (i.eq. 16) then
+            call abc( 16)
+        else if (i.eq. 17) then
+            call abc( 17)
+        else if (i.eq. 18) then
+            call abc( 18)
+        else if (i.eq. 19) then
+            call abc( 19)
+        else if (i.eq. 20) then
+            call abc( 20)
+        else if (i.eq. 21) then
+            call abc( 21)
+        else if (i.eq. 22) then
+            call abc( 22)
+        else if (i.eq. 23) then
+            call abc( 23)
+        else if (i.eq. 24) then
+            call abc( 24)
+        else if (i.eq. 25) then
+            call abc( 25)
+        else if (i.eq. 26) then
+            call abc( 26)
+        else if (i.eq. 27) then
+            call abc( 27)
+        else if (i.eq. 28) then
+            call abc( 28)
+        else if (i.eq. 29) then
+            call abc( 29)
+        else if (i.eq. 30) then
+            call abc( 30)
+        else if (i.eq. 31) then
+            call abc( 31)
+        else if (i.eq. 32) then
+            call abc( 32)
+        else if (i.eq. 33) then
+            call abc( 33)
+        else if (i.eq. 34) then
+            call abc( 34)
+        else if (i.eq. 35) then
+            call abc( 35)
+        else if (i.eq. 36) then
+            call abc( 36)
+        else if (i.eq. 37) then
+            call abc( 37)
+        else if (i.eq. 38) then
+            call abc( 38)
+        else if (i.eq. 39) then
+            call abc( 39)
+        else if (i.eq. 40) then
+            call abc( 40)
+        else if (i.eq. 41) then
+            call abc( 41)
+        else if (i.eq. 42) then
+            call abc( 42)
+        else if (i.eq. 43) then
+            call abc( 43)
+        else if (i.eq. 44) then
+            call abc( 44)
+        else if (i.eq. 45) then
+            call abc( 45)
+        else if (i.eq. 46) then
+            call abc( 46)
+        else if (i.eq. 47) then
+            call abc( 47)
+        else if (i.eq. 48) then
+            call abc( 48)
+        else if (i.eq. 49) then
+            call abc( 49)
+        else if (i.eq. 50) then
+            call abc( 50)
+        else if (i.eq. 51) then
+            call abc( 51)
+        else if (i.eq. 52) then
+            call abc( 52)
+        else if (i.eq. 53) then
+            call abc( 53)
+        else if (i.eq. 54) then
+            call abc( 54)
+        else if (i.eq. 55) then
+            call abc( 55)
+        else if (i.eq. 56) then
+            call abc( 56)
+        else if (i.eq. 57) then
+            call abc( 57)
+        else if (i.eq. 58) then
+            call abc( 58)
+        else if (i.eq. 59) then
+            call abc( 59)
+        else if (i.eq. 60) then
+            call abc( 60)
+        else if (i.eq. 61) then
+            call abc( 61)
+        else if (i.eq. 62) then
+            call abc( 62)
+        else if (i.eq. 63) then
+            call abc( 63)
+        else if (i.eq. 64) then
+            call abc( 64)
+        else if (i.eq. 65) then
+            call abc( 65)
+        else if (i.eq. 66) then
+            call abc( 66)
+        else if (i.eq. 67) then
+            call abc( 67)
+        else if (i.eq. 68) then
+            call abc( 68)
+        else if (i.eq. 69) then
+            call abc( 69)
+        else if (i.eq. 70) then
+            call abc( 70)
+        else if (i.eq. 71) then
+            call abc( 71)
+        else if (i.eq. 72) then
+            call abc( 72)
+        else if (i.eq. 73) then
+            call abc( 73)
+        else if (i.eq. 74) then
+            call abc( 74)
+        else if (i.eq. 75) then
+            call abc( 75)
+        else if (i.eq. 76) then
+            call abc( 76)
+        else if (i.eq. 77) then
+            call abc( 77)
+        else if (i.eq. 78) then
+            call abc( 78)
+        else if (i.eq. 79) then
+            call abc( 79)
+        else if (i.eq. 80) then
+            call abc( 80)
+        else if (i.eq. 81) then
+            call abc( 81)
+        else if (i.eq. 82) then
+            call abc( 82)
+        else if (i.eq. 83) then
+            call abc( 83)
+        else if (i.eq. 84) then
+            call abc( 84)
+        else if (i.eq. 85) then
+            call abc( 85)
+        else if (i.eq. 86) then
+            call abc( 86)
+        else if (i.eq. 87) then
+            call abc( 87)
+        else if (i.eq. 88) then
+            call abc( 88)
+        else if (i.eq. 89) then
+            call abc( 89)
+        else if (i.eq. 90) then
+            call abc( 90)
+        else if (i.eq. 91) then
+            call abc( 91)
+        else if (i.eq. 92) then
+            call abc( 92)
+        else if (i.eq. 93) then
+            call abc( 93)
+        else if (i.eq. 94) then
+            call abc( 94)
+        else if (i.eq. 95) then
+            call abc( 95)
+        else if (i.eq. 96) then
+            call abc( 96)
+        else if (i.eq. 97) then
+            call abc( 97)
+        else if (i.eq. 98) then
+            call abc( 98)
+        else if (i.eq. 99) then
+            call abc( 99)
+        else if (i.eq. 100) then
+            call abc( 100)
+        else if (i.eq. 101) then
+            call abc( 101)
+        else if (i.eq. 102) then
+            call abc( 102)
+        else if (i.eq. 103) then
+            call abc( 103)
+        else if (i.eq. 104) then
+            call abc( 104)
+        else if (i.eq. 105) then
+            call abc( 105)
+        else if (i.eq. 106) then
+            call abc( 106)
+        else if (i.eq. 107) then
+            call abc( 107)
+        else if (i.eq. 108) then
+            call abc( 108)
+        else if (i.eq. 109) then
+            call abc( 109)
+        else if (i.eq. 110) then
+            call abc( 110)
+        else if (i.eq. 111) then
+            call abc( 111)
+        else if (i.eq. 112) then
+            call abc( 112)
+        else if (i.eq. 113) then
+            call abc( 113)
+        else if (i.eq. 114) then
+            call abc( 114)
+        else if (i.eq. 115) then
+            call abc( 115)
+        else if (i.eq. 116) then
+            call abc( 116)
+        else if (i.eq. 117) then
+            call abc( 117)
+        else if (i.eq. 118) then
+            call abc( 118)
+        else if (i.eq. 119) then
+            call abc( 119)
+        else if (i.eq. 120) then
+            call abc( 120)
+        else if (i.eq. 121) then
+            call abc( 121)
+        else if (i.eq. 122) then
+            call abc( 122)
+        else if (i.eq. 123) then
+            call abc( 123)
+        else if (i.eq. 124) then
+            call abc( 124)
+        else if (i.eq. 125) then           !< Miscompiles if present
+            call abc( 125)                 !<
+
+c        else if (i.eq. 126) then
+c            call abc( 126)
+        endif
+        end
diff --git a/gcc/testsuite/gfortran.dg/g77/19990826-2.f b/gcc/testsuite/gfortran.dg/g77/19990826-2.f
new file mode 100644
index 000000000..8870c2588
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990826-2.f
@@ -0,0 +1,36 @@
+c { dg-do run }
+c { dg-options "-std=legacy" }
+c
+* From: "Billinghurst, David (RTD)" <David.Billinghurst@riotinto.com.au>
+* Subject: RE: single precision complex bug in g77 - was Testing g77 with LA
+* PACK 3.0
+* Date: Thu, 8 Jul 1999 00:55:11 +0100 
+* X-UIDL: b00d9d8081a36fef561b827d255dd4a5
+
+* Here is a slightly simpler and neater test case
+
+      program labug3
+      implicit none
+
+*  This program gives the wrong answer on mips-sgi-irix6.5
+*  when compiled with g77 from egcs-19990629 (gcc 2.95 prerelease)
+*  Get a = 0.0 when it should be 1.0 
+*
+*  Works with:  -femulate-complex
+*               egcs-1.1.2 
+*
+*  Originally derived from LAPACK 3.0 test suite.
+*
+*  David Billinghurst, (David.Billinghurst@riotinto.com.au)
+*  8 July 1999
+* 
+      complex one, z
+      real    a, f1
+      f1(z) = real(z)
+      one = (1.,0.)
+      a = f1(one) 
+      if ( abs(a-1.0) .gt. 1.0e-5 ) then
+         write(6,*) 'A should be 1.0 but it is',a
+         call abort()
+      end if
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/19990826-3.f b/gcc/testsuite/gfortran.dg/g77/19990826-3.f
new file mode 100644
index 000000000..dba24becb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990826-3.f
@@ -0,0 +1,320 @@
+c { dg-do compile }
+* Date: Thu, 19 Aug 1999 10:02:32 +0200
+* From: Frederic Devernay <devernay@istar.fr>
+* Organization: ISTAR
+* X-Accept-Language: French, fr, en
+* To: gcc-bugs@gcc.gnu.org
+* Subject: g77 2.95 bug (Internal compiler error in `final_scan_insn')
+* X-UIDL: 08443f5c374ffa382a05573281482f4f
+
+* Here's a bug that happens only when I compile with -O (disappears with
+* -O2)
+
+* > g77 -v --save-temps -O -c  pcapop.f
+* g77 version 2.95 19990728 (release) (from FSF-g77 version 0.5.25
+* 19990728 (release))
+* Reading specs from
+* /usr/local/lib/gcc-lib/sparc-sun-solaris2.6/2.95/specs
+* gcc version 2.95 19990728 (release)
+*  /usr/local/lib/gcc-lib/sparc-sun-solaris2.6/2.95/f771 pcapop.f -quiet
+* -dumpbase pcapop.f -O -version -fversion -o pcapop.s
+* GNU F77 version 2.95 19990728 (release) (sparc-sun-solaris2.6) compiled
+* by GNU C version 2.95 19990728 (release).
+* GNU Fortran Front End version 0.5.25 19990728 (release)
+* pcapop.f: In subroutine `pcapop':
+* pcapop.f:291: Internal compiler error in `final_scan_insn', at
+* final.c:2920
+* Please submit a full bug report.
+* See <URL:http://egcs.cygnus.com/faq.html#bugreport> for instructions.
+
+C* PCAPOP
+      SUBROUTINE PCAPOP(M1,M2,L1,L2,NMEM,N1,N2,IB,IBB,K3,TF,TS,TC,TTO)
+      DIMENSION NVA(6),C(6),I(6)
+C
+C CALCUL DES PARAMETRES OPTIMAUX N1 N2 IB IBB
+C
+      TACC=.035
+      TTRANS=.000004
+      RAD=.000001
+      RMI=.000001
+      RMU=.0000015
+      RDI=.000003
+      RTE=.000003
+      REQ=.000005
+      VY1=3*RTE+RDI+8*REQ+3*(RAD+RMI+RMU)
+      VY2=REQ+2*RAD
+      AR2=M2*(2*(REQ+RMI)+3*RMU+M1*(2*RAD+REQ))
+C     VARIATION DE L1,L2,
+C
+      TTOTOP=1.E+10
+      N1CO=0
+      N2CO=0
+      IBCO=0
+      IBBCO=0
+      K3CO=0
+      TESOP=0.
+      TCOP=0.
+      TFOP=0.
+      INUN=7
+      INDE=7
+      IF(M1.LT.128)INUN=6
+      IF(M1.LT.64)INUN=5
+      IF(M1.LT.32)INUN=4
+      IF(M2.LT.128)INDE=6
+      IF(M2.LT.64)INDE=5
+      IF(M2.LT.32)INDE=4
+      DO 3 NUN =3,INUN
+      DO 3 NDE=3,INDE
+      N10=2**NUN
+      N20=2**NDE
+      NDIF=(N10-N20)
+      NDIF=IABS(NDIF)
+C POUR AVOIR CES RESULTATS FAIRE TOURNER LE PROGRAMME VEFFT1
+      TCFFTU=0.
+      IF(N10.EQ.128.AND.N20.EQ.128)TCFFTU=3.35
+      IF(N10.EQ.64.AND.N20.EQ.64)TCFFTU=.70
+      IF(N10.EQ.32.AND.N20.EQ.32)TCFFTU=.138
+      IF(N10.EQ.16.AND.N20.EQ.16)TCFFTU=.0332
+      IF(N10.EQ.8.AND.N20.EQ.8)TCFFTU=.00688
+      IF(NDIF.EQ.64)TCFFTU=1.566
+      IF(NDIF.EQ.96)TCFFTU=.709
+      IF(NDIF.EQ.112)TCFFTU=.349
+      IF(NDIF.EQ.120)TCFFTU=.160
+      IF(NDIF.EQ.32)TCFFTU=.315
+      IF(NDIF.EQ.48)TCFFTU=.154
+      IF(NDIF.EQ.56)TCFFTU=.07
+      IF(NDIF.EQ.16)TCFFTU=.067
+      IF(NDIF.EQ.24)TCFFTU=.030
+      IF(NDIF.EQ.8)TCFFTU=.016
+      N30=N10-L1+1
+      N40=N20-L2+1
+      WW=VY1+N30*VY2
+      NDOU=2*N10*N20
+      IF((N10.LT.L1).OR.(N20.LT.L2)) GOTO 3
+      NB=NMEM-NDOU-N20*(L1-1)
+      NVC=2*N10*(N20-1)+M1
+      IF(NB.LT.(NVC)) GOTO 3
+      CALL VALENT(M1,N30,K1)
+      CALL VALENT(M2,N40,K2)
+      IS=K1/2
+      IF((2*IS).NE.K1)K1=K1+1
+      TFF=TCFFTU*K1*K2
+      CALL VALENT(M2,N40,JOFI)
+      IF(NB.GE.(K1*N20*N30+2*N20*(L1-1))) GOTO 4
+      TIOOP=1.E+10
+      IC=1
+18    IB1=2*IC
+      MAX=(NB-2*N20*(L1-1))/(N20*N30)
+      IN=MAX/2
+      IF(MAX.NE.2*IN) MAX=MAX-1
+      K3=K1/IB1
+      IBB1=K1-K3*IB1
+      IOFI=M1/(IB1*N30)
+      IRZ=0
+      IF(IOFI*IB1*N30.EQ.M1) GOTO1234
+      IRZ=1
+      IOFI=IOFI+1
+      IF(IBB1.EQ.0) GOTO 1234
+      IF(M1.EQ.((IOFI-1)*IB1*N30+IBB1*N30)) GOTO 1233
+      IRZ=2
+      GOTO 1234
+1233  IRZ=3
+1234  IBX1=IBB1
+      IF(IBX1.EQ.0)IBX1=IB1
+      AR1=M2*(2*(RAD+RMI+RMU+REQ)+(M1-(IOFI-1)*IB1*N30)*2*(REQ+RAD))
+     %+M2*(3*(REQ+RMU+RAD)+4*RMI+(M1-(IOFI-1)*IB1*N30)*(2*RAD+REQ)
+     %+(IOFI-1)*IB1*N30*(2*RMI+REQ+RAD))
+      AR5=(JOFI-1)*(N20-L2)*(M1-(IOFI-1)*IB1*N30)*(2*(RAD+RMU)+REQ)
+     %*IOFI+(M2-(JOFI-1)*N40+L2-2)*(M1-(IOFI-1)*IB1*N30)*(2*(RAD+RMU
+     %)+REQ)*IOFI
+      WQ=((IOFI-1)*IB1+IBX1)*JOFI*WW
+      AT1=N20*WQ
+      AT2=N40*WQ
+      QW=JOFI*(VY1+VY2*IB1*N30)
+      AT3=IOFI*N40*QW
+      AT4=(IOFI-1)*N40*QW
+      AT5=JOFI*((IOFI-1)*N40*(IB1/IBX1)*(VY1+IBX1*N30*VY2)
+     %+N40*((IB1/IBX1)*(IOFI-1)+1)*(VY1+IBX1*N30*VY2))
+      AT6=JOFI*((IOFI-1)*N40*(IB1/2)*(VY1+2*N30*VY2)+N40*(
+     %IB1*(IOFI-1)/2+IBX1/2)*(VY1+2*N30*VY2))
+      T1=JOFI*N20*(L1-1)*REQ
+      T2=M1*(L2-1)*REQ
+      T3=JOFI*N20*IBX1*N30*(RAD+REQ)
+      T4=JOFI*((IOFI-1)*IB1*N30*N20*(2*RMI+REQ)+IBX1*N30*N20*(2*RMI+R
+     %EQ))
+      T5=JOFI*((IOFI-1)*IB1/2+IBX1/2)*N20*N30*(2*RAD+REQ)
+      T6=2*JOFI*(((IOFI-1)*IB1+IBX1)*N20)*((5*(RMI+RMU)+4*RAD
+     %)+(L1-1)*(2*RAD+REQ)+N30*(2*RAD+REQ))
+      T7=JOFI*2*((IOFI-1)*IB1+IBX1)*(L1-1)*(2*RAD+REQ)
+      T8=JOFI*N10*N20*((IOFI-1)*IB1/2+IBX1/2)*(3*REQ+9*RAD+4*RMU+RMI)
+      T9=N10*N20*JOFI*((IOFI-1)*IB1/2+IBX1/2)*(REQ+RMI)+M1*M2*(REQ+R
+     %DI+2*RAD)
+      T10=JOFI*((IOFI-1)*IB1/2+IBX1/2)*2*(3*RMU+2*(RMI+RAD)+N40*(3*RMI
+     %+4*RMU+3*(RAD+REQ)+N30*(2*RAD+REQ)))
+      POI=JOFI
+      IF(POI.LE.2)POI=2
+      TNRAN=(N40+(POI-2)*N20+(M2-(JOFI-1)*N40+L2-1))*(RMI+RMU+RAD
+     %+REQ+N30*(2*RAD+2*REQ)*(IB1*(IOFI-1)+IBX1))
+      IF(TNRAN.LT.0.)TNRAN=0.
+      TCPU=T1+T2+T3+T4+T5+T6+T7+T8+T9+T10+TNRAN
+      NVA(1)=N40
+      NVA(2)=N40
+      NVA(3)=N20
+      NVA(4)=N20
+      NVA(5)=M2-(JOFI-1)*N40
+      NVA(6)=NVA(5)
+      C(1)=FLOAT(IB1*N30)/FLOAT(M1)
+      C(2)=FLOAT(M1-(IOFI-1)*IB1*N30)/FLOAT(M1)
+      C(3)=C(1)
+      C(4)=C(2)
+      C(5)=C(1)
+      C(6)=C(2)
+      K=1
+      P1=FLOAT(NB)/FLOAT(M1)
+10    IP1=P1
+      I(K)=1
+      IF(IP1.GE.NVA(K)) GOTO 7
+      P2=P1
+      IP2=P2
+8     P2=P2-FLOAT(IP2)*C(K)
+      IP2=P2
+      IF(IP2.EQ.0) GOTO 3
+      IP1=IP1+IP2
+      I(K)=I(K)+1
+      IF(IP1.GE.NVA(K))GOTO 7
+      GOTO 8
+7     IF(K.EQ.6) GOTO 11
+      K=K+1
+      GOTO 10
+11    IP1=0
+      IP2=0
+      IP3=0
+      POFI=JOFI
+      IF(POFI.LE.2)POFI=2
+      TIOL=(I(2)+(IOFI-1)*I(1)+(POFI-2)*(IOFI-1)*I(3)+(POFI-
+     %2)*I(4)+(IOFI-1)*I(5)+I(6))*TACC+(IOFI*M1*N40+(POFI-2)*IOFI*
+     %M1*N20+(M2-(JOFI-1)*N40+L2-1)*M1*IOFI)*TTRANS
+      IF(IBB1.EQ.0) GOTO 33
+      IF(IB1.EQ.IBB1) GOTO 33
+      IF(IBB1.EQ.2)GOTO 34
+      IP3=1
+      INL=NMEM/((IOFI-1)*IB1*N30+IBB1*N30)
+55    IF(INL.GT.N40)INL=N40
+      GOTO 35
+33    IF(IB1.GT.2) GOTO 36
+      IF((M1-(IOFI-1)*IB1*N30).GE.N30) GOTO 36
+34    IP1=1
+      INL=NMEM/(2*M1-(IOFI-1)*IB1*N30)
+      GOTO 55
+36    IP2=1
+      INL=NMEM/(IOFI*IB1*N30)
+      IF(INL.GT.N40)INL=N40
+35    CALL VALENT(N40,INL,KN1)
+      CALL VALENT(M2-(JOFI-1)*N40,INL,KN2)
+      CALL VALENT(INL*IBB1,IB1,KN3)
+      CALL VALENT((N40-(KN1-1)*INL)*IBB1,IB1,KN4)
+      IF((IP1+IP2+IP3).NE.1) CALL ERMESF(14)
+      TIO1=0.
+      IF(IP3.EQ.1)TIO1=N30*M2*TTRANS*(IB1*(IOFI-1)+IBB1)
+      IF(IP1.EQ.1)TIO1=M1*M2*TTRANS
+      IF(IP2.EQ.1) TIO1=(IB1*N30*M2*IOFI*TTRANS)
+      TTIO=2.*TIO1+(KN1*IOFI*(JOFI-1)+KN2*IOFI+(KN1-1)*(
+     %JOFI-1)+IOFI*(JOFI-1)+KN2-1.+IOFI+(KN1*(JOFI-1)+KN2))*TACC
+     %+M1*M2*TTRANS+TIOL
+      IF((IP1.EQ.1).AND.(IRZ.EQ.0))TCPU=TCPU+AT1+AT2+AT3
+      IF((IP1.EQ.1).AND.(IRZ.NE.0))TCPU=TCPU+AT1+AT2+AT4+AR1
+      IF((IP2.EQ.1).AND.(IRZ.EQ.0))TCPU=TCPU+AT1+AT2+AT3
+      IF((IP2.EQ.1).AND.(IRZ.NE.0))TCPU=TCPU+AT1+AT2+AT3+AR2
+      IFOIS=IB1/IBX1
+      IF((IP3.EQ.1).AND.(IFOIS*IBX1.EQ.IB1))TCPU=TCPU+AT1+AT2+AT5+AR2
+      IF((IP3.EQ.1).AND.(IFOIS*IBX1.NE.IB1))TCPU=TCPU+AT1+AT2+AT6+AR2
+      IF((IP1.EQ.1).AND.(IRZ.EQ.1))TCPU=TCPU+AR5
+      IF((IP1.EQ.1).AND.(IRZ.EQ.2))TCPU=TCPU+AR5
+      TTIOG=TTIO+TCPU
+      IF(TTIOG.LE.0.) GOTO 99
+      IF(TTIOG.GE.TIOOP) GOTO 99
+      IBOP=IB1
+      IBBOP=IBB1
+      K3OP=K3
+      TIOOP=TTIOG
+      TIOOP1=TTIO
+      TIOOP2=TCPU
+99    IF(IB1.GE.MAX)GOTO17
+      IC=IC+1
+      GOTO 18
+4     T1=JOFI*N20*(L1-1)*REQ
+      T2=M1*(L2-1)*REQ
+      T3=JOFI*N20*N30*(RAD+REQ)*K1
+      T4=JOFI*(K1*N30*N20*(2*RMI+REQ))
+      T5=JOFI*N20*N30*(2*RAD+REQ)*K1/2
+      T6=2*JOFI*(K1*N20)*((5*RMI+RMU)+4*RAD+(L1-1)*(2*RAD+REQ)+N30*2*
+     %RAD+REQ)
+      T7=JOFI*2*K1*(L1-1)*(2*RAD+REQ)
+      T9=JOFI*N10*N20*K1*(REQ+RMI)/2+M1*M2*(REQ+RDI+2*RAD)
+      T8=JOFI*N10*N20*K1*(3*REQ+9*RAD+4*RMU+RMI)/2
+      T10=JOFI*K1*(3*RMU+2*(RMI+RAD)+N40*(3*RMI
+     %+4*RMU+3*(RAD+REQ)+N30*(2*RAD+REQ)))
+      PIO=JOFI
+      IF(PIO.LE.2)PIO=2
+      TNR=(N40+(PIO-2)*N20+(M2-(JOFI-1)*N40+L2-1))*(RMU+RMI+RAD+REQ+
+     %N30*(2*RAD+2*REQ)*K1)
+      IF(TNR.LE.0.)TNR=0.
+      BT1=JOFI*N20*WW*K1
+      BT2=JOFI*N40*WW*K1
+      BT3=JOFI*N40*(VY1+K1*N30*VY2)
+      BR1=M2*(2*(RAD+RMI+RMU+REQ)+(M1*2*(REQ+RAD)))+M2*(3*(
+     $REQ+RAD+RMU)+4*(RMI)+M1*(2*(RAD)+REQ))
+      BR2=M2*(2*(REQ+RMI)+3*RMU+M1*(2*RAD+REQ))
+      TCPU=T1+T2+T3+T4+T5+T6+T7+T8+T9+T10
+      TCPU=TCPU+TNR+BT1+BT2
+      LIOF=M1/(N30)
+      IRZ=0
+      IF(LIOF*N30.EQ.M1) GOTO 2344
+      IRZ=1
+2344  IF(IRZ.EQ.0)TCPU=TCPU+BT3
+      IF(IRZ.NE.0)TCPU=TCPU+BT3+BR2
+      TIOOP=2.*FLOAT(M1)*FLOAT(M2)*TTRANS+2.*FLOAT(K2)*TACC+TCPU
+      IBOP=1
+      IBBOP=0
+      K3OP=1
+      TIOOP2=TCPU
+      TIOOP1=TIOOP-TCPU
+17    TTOT=TIOOP+TFF
+      IF(TTOT.LE.0.) GOTO 3
+      IF(TTOT.GE.TTOTOP)GOTO3
+      N1CO=N10
+      N2CO=N20
+      IBCO=IBOP
+      IBBCO=IBBOP
+      K3CO=K3OP
+      TTOTOP=TTOT
+      TESOP=TIOOP1
+      TCOP=TIOOP2
+      TFOP=TFF
+3     CONTINUE
+ 
+      N1=N1CO
+      N2=N2CO
+      TTO=TTOTOP
+      IB=IBCO
+      IBB=IBBCO
+      K3=K3CO
+      TC=TCOP
+      TS=TESOP
+      TF=TFOP
+      TT=TCOP+TFOP
+      TWER=TTO-TT
+      IF(N1.EQ.0.OR.N2.EQ.0) CALL OUTSTR(0,'PAS DE PLACE MEMOIRE SUFFISA
+     $NTE POUR UNE MISE EN OEUVRE PAR BLOCS$')
+      IF(IB.NE.1)RETURN
+      IHJ=(M1/(N1-L1+1))
+      IF(IHJ*(N1-L1+1).NE.M1)IHJ=IHJ+1
+      IHJ1=IHJ/2
+      IF(IHJ1*2.NE.IHJ)GOTO7778
+      IB=IHJ
+      IBB=0
+      RETURN
+7778  IB=IHJ+1
+      IBB=0
+      RETURN
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/19990905-0.f b/gcc/testsuite/gfortran.dg/g77/19990905-0.f
new file mode 100644
index 000000000..8e81d43df
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990905-0.f
@@ -0,0 +1,12 @@
+c { dg-do compile }
+* =foo0.f in Burley's g77 test suite.
+! Used to give "Variable 'm' cannot appear" "Variable 'm' cannot appear"
+! after REAL a(m,n), as described in PR 16511.
+!
+      subroutine sub(a)
+      equivalence (m,iarray(100))
+      common /info/ iarray(1000)
+      equivalence (n,iarray(200))
+      real a(m,n)
+      a(1,1) = a(2,2)
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/19990905-1.f b/gcc/testsuite/gfortran.dg/g77/19990905-1.f
new file mode 100644
index 000000000..b69d66ed2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990905-1.f
@@ -0,0 +1,19 @@
+c { dg-do compile }
+c
+c  g77 gave error
+c  19990905-1.f: In subroutine `x':
+c  19990905-1.f:15: 
+c           common /foo/n
+c                   1
+c  19990905-1.f:18: (continued):
+c           call foo(a(1))
+c                2
+c  Invalid declaration of or reference to symbol `foo' at (2) [initially seen at (1)]
+* =foo7.f in Burley's g77 test suite.
+      subroutine x
+      real a(n)
+      common /foo/n  ! { dg-error "is already being used as a COMMON" }
+      continue
+      entry y(a)
+      call foo(a(1)) ! { dg-error "is already being used as a COMMON" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/19990905-2.f b/gcc/testsuite/gfortran.dg/g77/19990905-2.f
new file mode 100644
index 000000000..e0cc07397
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/19990905-2.f
@@ -0,0 +1,23 @@
+c { dg-do compile }
+* =watson11.f in Burley's g77 test suite.
+* Probably originally submitted by Ian Watson.
+* Too small to worry about copyright issues, IMO, since it
+* doesn't do anything substantive.
+      SUBROUTINE OUTDNS(A,B,LCONV)
+      IMPLICIT REAL(kind=8) (A-H,O-Z),INTEGER(I-N)
+      COMMON/ARRAYS/Z(64,8),AB(30,30),PAIRS(9,9),T(9,9),TEMP(9,9),C1(3),
+     >  C2(3),AA(30),BB(30)
+      EQUIVALENCE (X1,C1(1)),(Y1,C1(2)),(Z1,C1(3))
+      EQUIVALENCE (X2,C2(1)),(Y2,C2(2)),(Z2,C2(3))
+      COMMON /CONTRL/
+     >  SHIFT,CONV,SCION,DIVERG,
+     >  IOPT,KCNDO,KINDO,KMINDO,I2EINT,KOHNO,KSLATE,
+     >  N,NG,NUMAT,NSEK,NELECS,NIT,OCCA,OCCB,NOLDAT,NOLDFN
+      INTEGER OCCA,OCCB
+      DIMENSION W(N),A(N,N),B(N,N)
+      DIMENSION BUF(100)
+      occb=5
+      ENTRY INDNS (A,B)
+   40 READ(IREAD) BUF
+      STOP
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20000412-1.f b/gcc/testsuite/gfortran.dg/g77/20000412-1.f
new file mode 100644
index 000000000..af403ef9b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20000412-1.f
@@ -0,0 +1,6 @@
+c { dg-do compile }
+      subroutine aap(k)
+      equivalence (i,r)
+      i = k
+      print*,r
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/20000503-1.f b/gcc/testsuite/gfortran.dg/g77/20000503-1.f
new file mode 100644
index 000000000..2a48a3533
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20000503-1.f
@@ -0,0 +1,25 @@
+c { dg-do run }
+*
+*  Originally derived from LAPACK 3.0 test suite failure.
+*
+*  David Billinghurst, (David.Billinghurst@riotinto.com.au)
+*  23 February 2000
+* 
+      INTEGER N, I, SLASQX
+      N = 20
+      I = SLASQX( N ) 
+      IF ( I .NE. 2*N ) THEN
+         WRITE(6,*) 'I = ', I, ' but should be ', 2*N
+         CALL ABORT()
+      END IF
+      END
+
+      INTEGER FUNCTION SLASQX( N )
+      INTEGER  N, I0, I, K
+      I0 = 1
+      DO I = 4*I0, 2*( I0+N-1 ), 4
+         K = I
+      END DO
+      SLASQX = K
+      RETURN
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20000511-1.f b/gcc/testsuite/gfortran.dg/g77/20000511-1.f
new file mode 100644
index 000000000..261b6a0e2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20000511-1.f
@@ -0,0 +1,22 @@
+c { dg-do compile }
+      subroutine saxpy(n,sa,sx,incx,sy,incy)
+C
+C     constant times a vector plus a vector.
+C     uses unrolled loop for increments equal to one.
+C     jack dongarra, linpack, 3/11/78.
+C     modified 12/3/93, array(1) declarations changed to array(*)
+C
+      real sx(*),sy(*),sa
+      integer i,incx,incy,ix,iy,m,mp1,n
+C
+C  -ffast-math ICE provoked by this conditional
+      if(sa /= 0.0)then
+C
+C        code for both increments equal to 1
+C
+         do i= 1,n
+           sy(i)= sy(i)+sa*sx(i)
+         enddo
+      endif
+      return
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/20000511-2.f b/gcc/testsuite/gfortran.dg/g77/20000511-2.f
new file mode 100644
index 000000000..1ae24ae5b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20000511-2.f
@@ -0,0 +1,62 @@
+c { dg-do compile }
+      subroutine sgbcon(norm,n,kl,ku,ab,ldab,ipiv,anorm,rcond,work,iwork
+     &,info)
+C
+C  -- LAPACK routine (version 3.0) --
+C     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
+C     Courant Institute, Argonne National Lab, and Rice University
+C     September 30, 1994
+C
+C     .. Scalar Arguments ..
+      character norm
+      integer info,kl,ku,ldab,n
+      real anorm,rcond
+C     ..
+C     .. Array Arguments ..
+      integer ipiv(n),iwork(n)
+      real ab(ldab,n),work(n)
+C     ..
+C
+C  Purpose
+C  =======
+C demonstrate g77 bug at -O -funroll-loops
+C  =====================================================================
+C
+C     .. Parameters ..
+      real one,zero
+      parameter(one= 1.0e+0,zero= 0.0e+0)
+C     ..
+C     .. Local Scalars ..
+      logical lnoti,onenrm
+      character normin
+      integer ix,j,jp,kase,kase1,kd,lm
+      real ainvnm,scale,smlnum,t
+C     ..
+C     .. External Functions ..
+      logical lsame
+      integer isamax
+      real sdot,slamch
+      externallsame,isamax,sdot,slamch
+C     ..
+C     .. External Subroutines ..
+      externalsaxpy,slacon,slatbs,srscl,xerbla
+C     ..
+C     .. Executable Statements ..
+C
+C           Multiply by inv(L).
+C
+      do j= 1,n-1
+C the following min() intrinsic provokes this bug
+         lm= min(kl,n-j)
+         jp= ipiv(j)
+         t= work(jp)
+         if(jp.ne.j)then
+C but only when combined with this if block
+            work(jp)= work(j)
+            work(j)= t
+         endif
+C and this subroutine call
+         call saxpy(lm,-t,ab(kd+1,j),1,work(j+1),1)
+      enddo
+      return
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/20000518.f b/gcc/testsuite/gfortran.dg/g77/20000518.f
new file mode 100644
index 000000000..ac25f25ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20000518.f
@@ -0,0 +1,17 @@
+c { dg-do compile }
+      SUBROUTINE SORG2R( K, A, N, LDA )
+*  ICE in `verify_wide_reg_1', at flow.c:2605 at -O2
+*  g77 version 2.96 20000515 (experimental) on i686-pc-linux-gnu
+*
+*  Originally derived from LAPACK 3.0 test suite failure.
+*
+*  David Billinghurst, (David.Billinghurst@riotinto.com.au)
+*  18 May 2000
+      INTEGER            I, K, LDA, N
+      REAL               A( LDA, * )
+      DO I = K, 1, -1
+         IF( I.LT.N ) A( I, I ) = 1.0
+         A( I, I ) = 1.0
+      END DO
+      RETURN
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20000601-1.f b/gcc/testsuite/gfortran.dg/g77/20000601-1.f
new file mode 100644
index 000000000..d0c05ec2e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20000601-1.f
@@ -0,0 +1,29 @@
+c { dg-do compile }
+      SUBROUTINE SGBTRF( M, KL, KU, AB, LDAB )
+
+*  PR fortran/275
+*  ICE in `change_address', at emit-rtl.c:1589 with -O1 and above
+*  g77 version 2.96 20000530 (experimental) on mips-sgi-irix6.5/-mabi=64
+*
+*  Originally derived from LAPACK 3.0 test suite failure.
+*
+*  David Billinghurst, (David.Billinghurst@riotinto.com.au)
+*  1 June 2000
+
+      INTEGER   KL, KU, LDAB, M
+      REAL      AB( LDAB, * )
+
+      INTEGER   J, JB, JJ, JP, KV, KM
+      REAL      WORK13(65,64), WORK31(65,64)
+      KV = KU + KL
+      DO J = 1, M
+         JB = MIN( 1, M-J+1 )
+         DO JJ = J, J + JB - 1
+            KM = MIN( KL, M-JJ )
+            JP = KM+1
+            CALL SSWAP( JB, AB( KV+1+JJ-J, J ), LDAB-1,
+     $           AB( KV+JP+JJ-J, J ), LDAB-1 )
+         END DO
+      END DO
+      RETURN
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20000601-2.f b/gcc/testsuite/gfortran.dg/g77/20000601-2.f
new file mode 100644
index 000000000..e5b9db70d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20000601-2.f
@@ -0,0 +1,28 @@
+c { dg-do compile }
+      SUBROUTINE SGBTRF( M, KL, KU, AB, LDAB )
+
+*  Slightly modified version of 20000601-1.f that still ICES with
+*  CVS 20010118 g77 on mips-sgi-irix6.5/-mabi=64.
+*
+*  Originally derived from LAPACK 3.0 test suite failure.
+*
+*  David Billinghurst, (David.Billinghurst@riotinto.com.au)
+*  18 January 2001
+
+      INTEGER   KL, KU, LDAB, M
+      REAL      AB( LDAB, * )
+
+      INTEGER   J, JB, JJ, JP, KV, KM, F
+      REAL      WORK13(65,64), WORK31(65,64)
+      KV = KU + KL
+      DO J = 1, M
+         JB = MIN( 1, M-J+1 )
+         DO JJ = J, J + JB - 1
+            KM = MIN( KL, M-JJ )
+            JP = F( KM+1, AB( KV+1, JJ ) )
+            CALL SSWAP( JB, AB( KV+1+JJ-J, J ), LDAB-1,
+     $           AB( KV+JP+JJ-J, J ), LDAB-1 )
+         END DO
+      END DO
+      RETURN
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20000629-1.f b/gcc/testsuite/gfortran.dg/g77/20000629-1.f
new file mode 100644
index 000000000..e369efb4d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20000629-1.f
@@ -0,0 +1,12 @@
+c { dg-do compile }
+      SUBROUTINE MIST(N, BETA)
+      IMPLICIT REAL(kind=8) (A-H,O-Z)
+      INTEGER  IA, IQ, M1
+      DIMENSION BETA(N)
+      DO 80 IQ=1,M1
+         IF (BETA(IQ).EQ.0.0D0) GO TO 120
+   80 CONTINUE
+  120 IF (IQ.NE.1) GO TO 160
+  160 M1 = IA(IQ)
+      RETURN
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20000630-2.f b/gcc/testsuite/gfortran.dg/g77/20000630-2.f
new file mode 100644
index 000000000..4948c49e4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20000630-2.f
@@ -0,0 +1,12 @@
+c { dg-do compile }
+c { dg-options "-std=legacy" }
+c
+      SUBROUTINE CHOUT(CHR,ICNT)
+C ICE: failed assertion `expr != NULL'
+C Reduced version of GNATS PR fortran/329 from trond.bo@dnmi.no
+      INTEGER CHR(ICNT)
+      CHARACTER*255 BUF
+      BUF(1:1)=CHAR(CHR(1))
+      CALL FPUTC(1,BUF(1:1))
+      RETURN
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20001111.f b/gcc/testsuite/gfortran.dg/g77/20001111.f
new file mode 100644
index 000000000..366956a66
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20001111.f
@@ -0,0 +1,13 @@
+c { dg-do run }
+      DOUBLE PRECISION VALUE(2), TOLD, BK
+      DATA VALUE /0D0, 1D0/
+      DATA TOLD /0D0/
+      DO I=1, 2
+         BK = VALUE(I)
+         IF(BK .GT. TOLD) GOTO 10
+      ENDDO
+      WRITE(*,*)'Error: BK = ', BK
+      CALL ABORT
+ 10   CONTINUE
+      WRITE(*,*)'No Error: BK = ', BK
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20010115.f b/gcc/testsuite/gfortran.dg/g77/20010115.f
new file mode 100644
index 000000000..cce8dbce7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20010115.f
@@ -0,0 +1,10 @@
+c { dg-do compile }
+* GNATS PR Fortran/1636
+      PRINT 42, 'HELLO'
+   42 FORMAT(A)
+      CALL WORLD
+      END
+      SUBROUTINE WORLD
+      PRINT 42, 'WORLD'
+   42 FORMAT(A)
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20010116.f b/gcc/testsuite/gfortran.dg/g77/20010116.f
new file mode 100644
index 000000000..ca7375d0f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20010116.f
@@ -0,0 +1,41 @@
+c { dg-do run }
+c { dg-options "-std=legacy" }
+c
+*
+*  Derived from LAPACK 3.0 routine CHGEQZ
+*  Fails on i686-pc-cygwin with gcc-2.97 snapshots at -O2 and higher
+*  PR fortran/1645
+*
+*  David Billinghurst, (David.Billinghurst@riotinto.com)
+*  14 January 2001
+*  Rewritten by Toon Moene (toon@moene.indiv.nluug.nl)
+*  15 January 2001
+* 
+      COMPLEX A(5,5)
+      DATA A/25*(0.0,0.0)/
+      A(4,3) = (0.05,0.2)/3.0E-7
+      A(4,4) = (-0.03,-0.4)
+      A(5,4) = (-2.0E-07,2.0E-07)
+      CALL CHGEQZ( 5, A )
+      END
+      SUBROUTINE CHGEQZ( N, A )
+      COMPLEX   A(N,N), X
+      ABS1( X ) = ABS( REAL( X ) ) + ABS( AIMAG( X ) )
+      DO J = 4, 2, -1
+         I = J
+         TEMP  = ABS1( A(J,J) )
+         TEMP2 = ABS1( A( J+1, J ) )
+         TEMPR = MAX( TEMP, TEMP2 )
+         IF( TEMPR .LT. 1.0 .AND. TEMPR .NE. 0.0 ) THEN
+            TEMP  = TEMP / TEMPR
+            TEMP2 = TEMP2 / TEMPR
+         END IF
+         IF ( ABS1(A(J,J-1))*TEMP2 .LE. TEMP ) GO TO 90
+      END DO
+c     Should not reach here, but need a statement
+      PRINT*
+  90  IF ( I .NE. 4 ) THEN
+         PRINT*,'I =', I, ' but should be 4'
+         CALL ABORT()
+      END IF
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20010216-1.f b/gcc/testsuite/gfortran.dg/g77/20010216-1.f
new file mode 100644
index 000000000..004d1d383
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20010216-1.f
@@ -0,0 +1,52 @@
+C Test for bug in reg-stack handling conditional moves.
+C Reported by Tim Prince <tprince@computer.org>
+C
+C { dg-do run { target { { i[6789]86-*-* x86_64-*-* } && ilp32 } } }
+C { dg-options "-ffast-math -march=pentiumpro" }
+
+      double precision function foo(x, y)
+         implicit none
+         double precision x, y
+         double precision a, b, c, d
+         if (x /= y) then
+             if (x * y >= 0) then
+                 a = abs(x)
+                 b = abs(y)
+                 c = max(a, b)
+                 d = min(a, b)
+                 foo = 1 - d/c
+             else       
+                 foo = 1
+             end if  
+         else
+             foo = 0
+         end if
+      end
+
+      program test
+      implicit none
+
+      integer ntests
+      parameter (ntests=7)
+      double precision tolerance
+      parameter (tolerance=1.0D-6)
+
+C Each column is a pair of values to feed to foo,
+C and its expected return value.
+      double precision a(ntests), b(ntests), x(ntests)
+      data a /1, -23, -1,   1,   9,  10,  -9/
+      data b /1, -23, 12, -12,  10,   9, -10/
+      data x /0,   0,  1,   1, 0.1, 0.1, 0.1/
+
+      double precision foo
+      double precision result
+      integer i
+
+      do i = 1, ntests
+         result = foo(a(i), b(i))
+         if (abs(result - x(i)) > tolerance) then
+           print *, i, a(i), b(i), x(i), result
+           call abort
+         end if
+      end do
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/20010321-1.f b/gcc/testsuite/gfortran.dg/g77/20010321-1.f
new file mode 100644
index 000000000..df003190c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20010321-1.f
@@ -0,0 +1,9 @@
+c { dg-do compile }
+# 1 "20010321-1.f"
+      SUBROUTINE TWOEXP
+# 1 "include/implicit.h" 1 3
+      IMPLICIT DOUBLE PRECISION (A-H)
+# 3 "20010321-1.f" 2 3
+      LOGICAL ANTI
+      ANTI = .FALSE.
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20010426-1.f b/gcc/testsuite/gfortran.dg/g77/20010426-1.f
new file mode 100644
index 000000000..ce8cc4d10
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20010426-1.f
@@ -0,0 +1,3 @@
+c { dg-do run }
+      print*,cos(1.0)
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/20010426.f b/gcc/testsuite/gfortran.dg/g77/20010426.f
new file mode 100644
index 000000000..07bc7ea41
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20010426.f
@@ -0,0 +1,7 @@
+c { dg-do compile }
+      function f(c)
+      implicit none
+      real(kind=8) c, f
+      f = sqrt(c)
+      return
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/20010430.f b/gcc/testsuite/gfortran.dg/g77/20010430.f
new file mode 100644
index 000000000..c6af4968d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20010430.f
@@ -0,0 +1,21 @@
+c { dg-do run }
+      REAL DAT(2,5)
+      DO I = 1, 5
+         DAT(1,I) = I*1.6356-NINT(I*1.6356)
+         DAT(2,I) = I
+      ENDDO
+      DO I = 1, 4
+         DO J = I+1, 5
+            IF (DAT(1,J) - DAT(1,I) .LT. 0.0) THEN
+               DO K = 1, 2
+                  TMP = DAT(K,I)
+                  DAT(K,I) = DAT(K,J)
+                  DAT(K,J) = TMP
+               ENDDO
+            ENDIF
+         ENDDO
+      ENDDO
+      DO I = 1, 4
+         IF (DAT(1,I) .GT. DAT(1,I+1)) CALL ABORT
+      ENDDO
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20010519-1.f b/gcc/testsuite/gfortran.dg/g77/20010519-1.f
new file mode 100644
index 000000000..c268bf03e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20010519-1.f
@@ -0,0 +1,1327 @@
+c { dg-do compile }
+CHARMM Element source/dimb/nmdimb.src 1.1
+C.##IF DIMB
+      SUBROUTINE NMDIMB(X,Y,Z,NAT3,BNBND,BIMAG,LNOMA,AMASS,DDS,DDSCR,
+     1                 PARDDV,DDV,DDM,PARDDF,DDF,PARDDE,DDEV,DD1BLK,
+     2                 DD1BLL,NADD,LRAISE,DD1CMP,INBCMP,JNBCMP,
+     3                 NPAR,ATMPAR,ATMPAS,BLATOM,PARDIM,NFREG,NFRET,
+     4                 PARFRQ,CUTF1,ITMX,TOLDIM,IUNMOD,IUNRMD,
+     5                 LBIG,LSCI,ATMPAD,SAVF,NBOND,IB,JB,DDVALM)
+C-----------------------------------------------------------------------
+C     01-Jul-1992 David Perahia, Liliane Mouawad
+C     15-Dec-1994 Herman van Vlijmen
+C
+C     This is the main routine for the mixed-basis diagonalization.
+C     See: L.Mouawad and D.Perahia, Biopolymers (1993), 33, 599,
+C     and: D.Perahia and L.Mouawad, Comput. Chem. (1995), 19, 241.
+C     The method iteratively solves the diagonalization of the
+C     Hessian matrix. To save memory space, it uses a compressed
+C     form of the Hessian, which only contains the nonzero elements.
+C     In the diagonalization process, approximate eigenvectors are
+C     mixed with Cartesian coordinates to form a reduced basis. The
+C     Hessian is then diagonalized in the reduced basis. By iterating
+C     over different sets of Cartesian coordinates the method ultimately
+C     converges to the exact eigenvalues and eigenvectors (up to the
+C     requested accuracy).
+C     If no existing basis set is read, an initial basis will be created
+C     which consists of the low-frequency eigenvectors of diagonal blocks
+C     of the Hessian.
+C-----------------------------------------------------------------------
+C-----------------------------------------------------------------------
+C:::##INCLUDE '~/charmm_fcm/impnon.fcm'
+C..##IF VAX IRIS HPUX IRIS GNU CSPP OS2 GWS CRAY ALPHA
+      IMPLICIT NONE
+C..##ENDIF
+C-----------------------------------------------------------------------
+C-----------------------------------------------------------------------
+C:::##INCLUDE '~/charmm_fcm/stream.fcm'
+      LOGICAL LOWER,QLONGL
+      INTEGER MXSTRM,POUTU
+      PARAMETER (MXSTRM=20,POUTU=6)
+      INTEGER   NSTRM,ISTRM,JSTRM,OUTU,PRNLEV,WRNLEV,IOLEV
+      COMMON /CASE/   LOWER, QLONGL
+      COMMON /STREAM/ NSTRM,ISTRM,JSTRM(MXSTRM),OUTU,PRNLEV,WRNLEV,IOLEV
+C..##IF SAVEFCM
+C..##ENDIF
+C-----------------------------------------------------------------------
+C-----------------------------------------------------------------------
+C:::##INCLUDE '~/charmm_fcm/dimens.fcm'
+      INTEGER LARGE,MEDIUM,SMALL,REDUCE
+C..##IF QUANTA
+C..##ELIF T3D
+C..##ELSE
+      PARAMETER (LARGE=60120, MEDIUM=25140, SMALL=6120)
+C..##ENDIF
+      PARAMETER (REDUCE=15000)
+      INTEGER SIZE
+C..##IF XLARGE
+C..##ELIF XXLARGE
+C..##ELIF LARGE
+C..##ELIF MEDIUM
+      PARAMETER (SIZE=MEDIUM)
+C..##ELIF REDUCE
+C..##ELIF SMALL
+C..##ELIF XSMALL
+C..##ENDIF
+C..##IF MMFF
+      integer MAXDEFI
+      parameter(MAXDEFI=250)
+      INTEGER NAME0,NAMEQ0,NRES0,KRES0
+      PARAMETER (NAME0=4,NAMEQ0=10,NRES0=4,KRES0=4)
+      integer MaxAtN
+      parameter (MaxAtN=55)
+      INTEGER MAXAUX
+      PARAMETER (MAXAUX = 10)
+C..##ENDIF
+      INTEGER MAXCSP, MAXHSET
+C..##IF HMCM
+      PARAMETER (MAXHSET = 200)
+C..##ELSE
+C..##ENDIF
+C..##IF REDUCE
+C..##ELSE
+      PARAMETER (MAXCSP = 500)
+C..##ENDIF
+C..##IF HMCM
+      INTEGER MAXHCM,MAXPCM,MAXRCM
+C...##IF REDUCE
+C...##ELSE
+      PARAMETER (MAXHCM=500)
+      PARAMETER (MAXPCM=5000)
+      PARAMETER (MAXRCM=2000)
+C...##ENDIF
+C..##ENDIF
+      INTEGER MXCMSZ
+C..##IF IBM IBMRS CRAY INTEL IBMSP T3D REDUCE
+C..##ELSE
+      PARAMETER (MXCMSZ = 5000)
+C..##ENDIF
+      INTEGER CHRSIZ
+      PARAMETER (CHRSIZ = SIZE)
+      INTEGER MAXATB
+C..##IF REDUCE
+C..##ELIF QUANTA
+C..##ELSE
+      PARAMETER (MAXATB = 200)
+C..##ENDIF
+      INTEGER MAXVEC
+C..##IFN VECTOR PARVECT
+      PARAMETER (MAXVEC = 10)
+C..##ELIF LARGE XLARGE XXLARGE
+C..##ELIF MEDIUM
+C..##ELIF SMALL REDUCE
+C..##ELIF XSMALL
+C..##ELSE
+C..##ENDIF
+      INTEGER IATBMX
+      PARAMETER (IATBMX = 8)
+      INTEGER MAXHB
+C..##IF LARGE XLARGE XXLARGE
+C..##ELIF MEDIUM
+      PARAMETER (MAXHB = 8000)
+C..##ELIF SMALL
+C..##ELIF REDUCE XSMALL
+C..##ELSE
+C..##ENDIF
+      INTEGER MAXTRN,MAXSYM
+C..##IFN NOIMAGES
+      PARAMETER (MAXTRN = 5000)
+      PARAMETER (MAXSYM = 192)
+C..##ELSE
+C..##ENDIF
+C..##IF LONEPAIR (lonepair_max)
+      INTEGER MAXLP,MAXLPH
+C...##IF REDUCE
+C...##ELSE
+      PARAMETER (MAXLP  = 2000)
+      PARAMETER (MAXLPH = 4000)
+C...##ENDIF
+C..##ENDIF (lonepair_max)
+      INTEGER NOEMAX,NOEMX2
+C..##IF REDUCE
+C..##ELSE
+      PARAMETER (NOEMAX = 2000)
+      PARAMETER (NOEMX2 = 4000)
+C..##ENDIF
+      INTEGER MAXATC, MAXCB, MAXCH, MAXCI, MAXCP, MAXCT, MAXITC, MAXNBF
+C..##IF REDUCE
+C..##ELIF MMFF CFF
+      PARAMETER (MAXATC = 500, MAXCB = 1500, MAXCH = 3200, MAXCI = 600,
+     &           MAXCP  = 3000,MAXCT = 15500,MAXITC = 200, MAXNBF=1000)
+C..##ELIF YAMMP
+C..##ELIF LARGE
+C..##ELSE
+C..##ENDIF
+      INTEGER MAXCN
+      PARAMETER (MAXCN = MAXITC*(MAXITC+1)/2)
+      INTEGER MAXA, MAXAIM, MAXB, MAXT, MAXP
+      INTEGER MAXIMP, MAXNB, MAXPAD, MAXRES
+      INTEGER MAXSEG, MAXGRP
+C..##IF LARGE XLARGE XXLARGE
+C..##ELIF MEDIUM
+      PARAMETER (MAXA = SIZE, MAXB = SIZE, MAXT = SIZE,
+     &           MAXP = 2*SIZE)
+      PARAMETER (MAXIMP = 9200, MAXNB = 17200, MAXPAD = 8160,
+     &           MAXRES = 14000)
+C...##IF MCSS
+C...##ELSE
+      PARAMETER (MAXSEG = 1000)
+C...##ENDIF
+C..##ELIF SMALL
+C..##ELIF XSMALL
+C..##ELIF REDUCE
+C..##ELSE
+C..##ENDIF
+C..##IF NOIMAGES
+C..##ELSE
+      PARAMETER (MAXAIM = 2*SIZE)
+      PARAMETER (MAXGRP = 2*SIZE/3)
+C..##ENDIF
+      INTEGER REDMAX,REDMX2
+C..##IF REDUCE
+C..##ELSE
+      PARAMETER (REDMAX = 20)
+      PARAMETER (REDMX2 = 80)
+C..##ENDIF
+      INTEGER MXRTRS, MXRTA, MXRTB, MXRTT, MXRTP, MXRTI, MXRTX,
+     &        MXRTHA, MXRTHD, MXRTBL, NICM
+      PARAMETER (MXRTRS = 200, MXRTA = 5000, MXRTB = 5000,
+     &           MXRTT = 5000, MXRTP = 5000, MXRTI = 2000,
+C..##IF YAMMP
+C..##ELSE
+     &           MXRTX = 5000, MXRTHA = 300, MXRTHD = 300,
+C..##ENDIF
+     &           MXRTBL = 5000, NICM = 10)
+      INTEGER NMFTAB,  NMCTAB,  NMCATM,  NSPLIN
+C..##IF REDUCE
+C..##ELSE
+      PARAMETER (NMFTAB = 200, NMCTAB = 3, NMCATM = 12000, NSPLIN = 3)
+C..##ENDIF
+      INTEGER MAXSHK
+C..##IF XSMALL
+C..##ELIF REDUCE
+C..##ELSE
+      PARAMETER (MAXSHK = SIZE*3/4)
+C..##ENDIF
+      INTEGER SCRMAX
+C..##IF IBM IBMRS CRAY INTEL IBMSP T3D REDUCE
+C..##ELSE
+      PARAMETER (SCRMAX = 5000)
+C..##ENDIF
+C..##IF TSM
+      INTEGER MXPIGG
+C...##IF REDUCE
+C...##ELSE
+      PARAMETER (MXPIGG=500)
+C...##ENDIF
+      INTEGER MXCOLO,MXPUMB
+      PARAMETER (MXCOLO=20,MXPUMB=20)
+C..##ENDIF
+C..##IF ADUMB
+      INTEGER MAXUMP, MAXEPA, MAXNUM
+C...##IF REDUCE
+C...##ELSE
+      PARAMETER (MAXUMP = 10, MAXNUM = 4)
+C...##ENDIF
+C..##ENDIF
+      INTEGER MAXING
+      PARAMETER (MAXING=1000)
+C..##IF MMFF
+      integer MAX_RINGSIZE, MAX_EACH_SIZE
+      parameter (MAX_RINGSIZE = 20, MAX_EACH_SIZE = 1000)
+      integer MAXPATHS
+      parameter (MAXPATHS = 8000)
+      integer MAX_TO_SEARCH
+      parameter (MAX_TO_SEARCH = 6)
+C..##ENDIF
+C-----------------------------------------------------------------------
+C-----------------------------------------------------------------------
+C:::##INCLUDE '~/charmm_fcm/number.fcm'
+      REAL(KIND=8)     ZERO, ONE, TWO, THREE, FOUR, FIVE, SIX,
+     &           SEVEN, EIGHT, NINE, TEN, ELEVEN, TWELVE, THIRTN,
+     &           FIFTN, NINETN, TWENTY, THIRTY
+C..##IF SINGLE
+C..##ELSE
+      PARAMETER (ZERO   =  0.D0, ONE    =  1.D0, TWO    =  2.D0,
+     &           THREE  =  3.D0, FOUR   =  4.D0, FIVE   =  5.D0,
+     &           SIX    =  6.D0, SEVEN  =  7.D0, EIGHT  =  8.D0,
+     &           NINE   =  9.D0, TEN    = 10.D0, ELEVEN = 11.D0,
+     &           TWELVE = 12.D0, THIRTN = 13.D0, FIFTN  = 15.D0,
+     &           NINETN = 19.D0, TWENTY = 20.D0, THIRTY = 30.D0)
+C..##ENDIF
+      REAL(KIND=8)     FIFTY, SIXTY, SVNTY2, EIGHTY, NINETY, HUNDRD,
+     &           ONE2TY, ONE8TY, THRHUN, THR6TY, NINE99, FIFHUN, THOSND,
+     &           FTHSND,MEGA
+C..##IF SINGLE
+C..##ELSE
+      PARAMETER (FIFTY  = 50.D0,  SIXTY  =  60.D0,  SVNTY2 =   72.D0,
+     &           EIGHTY = 80.D0,  NINETY =  90.D0,  HUNDRD =  100.D0,
+     &           ONE2TY = 120.D0, ONE8TY = 180.D0,  THRHUN =  300.D0,
+     &           THR6TY=360.D0,   NINE99 = 999.D0,  FIFHUN = 1500.D0,
+     &           THOSND = 1000.D0,FTHSND = 5000.D0, MEGA   =   1.0D6)
+C..##ENDIF
+      REAL(KIND=8)     MINONE, MINTWO, MINSIX
+      PARAMETER (MINONE = -1.D0,  MINTWO = -2.D0,  MINSIX = -6.D0)
+      REAL(KIND=8) TENM20,TENM14,TENM8,TENM5,PT0001,PT0005,PT001,PT005,
+     &           PT01, PT02, PT05, PTONE, PT125, PT25, SIXTH, THIRD,
+     &           PTFOUR, PTSIX, HALF, PT75, PT9999, ONEPT5, TWOPT4
+C..##IF SINGLE
+C..##ELSE
+      PARAMETER (TENM20 = 1.0D-20,  TENM14 = 1.0D-14,  TENM8  = 1.0D-8,
+     &           TENM5  = 1.0D-5,   PT0001 = 1.0D-4, PT0005 = 5.0D-4,
+     &           PT001  = 1.0D-3,   PT005  = 5.0D-3, PT01   = 0.01D0,
+     &           PT02   = 0.02D0,   PT05   = 0.05D0, PTONE  = 0.1D0,
+     &           PT125  = 0.125D0,  SIXTH  = ONE/SIX,PT25   = 0.25D0,
+     &           THIRD  = ONE/THREE,PTFOUR = 0.4D0,  HALF   = 0.5D0,
+     &           PTSIX  = 0.6D0,    PT75   = 0.75D0, PT9999 = 0.9999D0,
+     &           ONEPT5 = 1.5D0,    TWOPT4 = 2.4D0)
+C..##ENDIF
+      REAL(KIND=8) ANUM,FMARK
+      REAL(KIND=8) RSMALL,RBIG
+C..##IF SINGLE
+C..##ELSE
+      PARAMETER (ANUM=9999.0D0, FMARK=-999.0D0)
+      PARAMETER (RSMALL=1.0D-10,RBIG=1.0D20)
+C..##ENDIF
+      REAL(KIND=8) RPRECI,RBIGST
+C..##IF VAX DEC
+C..##ELIF IBM
+C..##ELIF CRAY
+C..##ELIF ALPHA T3D T3E
+C..##ELSE
+C...##IF SINGLE
+C...##ELSE
+      PARAMETER (RPRECI = 2.22045D-16, RBIGST = 4.49423D+307)
+C...##ENDIF
+C..##ENDIF
+C-----------------------------------------------------------------------
+C-----------------------------------------------------------------------
+C:::##INCLUDE '~/charmm_fcm/consta.fcm'
+      REAL(KIND=8) PI,RADDEG,DEGRAD,TWOPI
+      PARAMETER(PI=3.141592653589793D0,TWOPI=2.0D0*PI)
+      PARAMETER (RADDEG=180.0D0/PI)
+      PARAMETER (DEGRAD=PI/180.0D0)
+      REAL(KIND=8) COSMAX
+      PARAMETER (COSMAX=0.9999999999D0)
+      REAL(KIND=8) TIMFAC
+      PARAMETER (TIMFAC=4.88882129D-02)
+      REAL(KIND=8) KBOLTZ
+      PARAMETER (KBOLTZ=1.987191D-03)
+      REAL(KIND=8) CCELEC
+C..##IF AMBER
+C..##ELIF DISCOVER
+C..##ELSE
+      PARAMETER (CCELEC=332.0716D0)
+C..##ENDIF
+      REAL(KIND=8) CNVFRQ
+      PARAMETER (CNVFRQ=2045.5D0/(2.99793D0*6.28319D0))
+      REAL(KIND=8) SPEEDL
+      PARAMETER (SPEEDL=2.99793D-02)
+      REAL(KIND=8) ATMOSP
+      PARAMETER (ATMOSP=1.4584007D-05)
+      REAL(KIND=8) PATMOS
+      PARAMETER (PATMOS = 1.D0 / ATMOSP )
+      REAL(KIND=8) BOHRR
+      PARAMETER (BOHRR = 0.529177249D0 )
+      REAL(KIND=8) TOKCAL
+      PARAMETER (TOKCAL = 627.5095D0 )
+C..##IF MMFF
+      REAL(KIND=8) MDAKCAL
+      parameter(MDAKCAL=143.9325D0)
+C..##ENDIF
+      REAL(KIND=8) DEBYEC
+      PARAMETER ( DEBYEC = 2.541766D0 / BOHRR )
+      REAL(KIND=8) ZEROC
+      PARAMETER ( ZEROC = 298.15D0 )
+C-----------------------------------------------------------------------
+C-----------------------------------------------------------------------
+C:::##INCLUDE '~/charmm_fcm/exfunc.fcm'
+C..##IF ACE
+C..##ENDIF
+C..##IF ADUMB
+C..##ENDIF
+      CHARACTER(4) GTRMA, NEXTA4, CURRA4
+      CHARACTER(6) NEXTA6
+      CHARACTER(8) NEXTA8
+      CHARACTER(20) NEXT20
+      INTEGER     ALLCHR, ALLSTK, ALLHP, DECODI, FIND52,
+     *            GETATN, GETRES, GETRSN, GETSEG, GTRMI, I4VAL,
+     *            ICHAR4, ICMP16, ILOGI4, INDX, INDXA, INDXAF,
+     *            INDXRA, INTEG4, IREAL4, IREAL8, LOCDIF,
+     *            LUNASS, MATOM, NEXTI, NINDX, NSELCT, NSELCTV, ATMSEL,
+     *            PARNUM, PARINS,
+     *            SRCHWD, SRCHWS, STRLNG, DSIZE, SSIZE
+C..##IF ACE
+     *           ,GETNNB
+C..##ENDIF
+      LOGICAL     CHKPTR, EQST, EQSTA, EQSTWC, EQWDWC, DOTRIM, CHECQUE,
+     *            HYDROG, INITIA, LONE, LTSTEQ, ORDER, ORDER5,
+     *            ORDERR, USEDDT, QTOKDEL, QDIGIT, QALPHA
+      REAL(KIND=8)      DECODF, DOTVEC, GTRMF, LENVEC, NEXTF, RANDOM, GTRR8,
+     *            RANUMB, R8VAL, RETVAL8, SUMVEC
+C..##IF ADUMB
+     *           ,UMFI
+C..##ENDIF
+      EXTERNAL  GTRMA, NEXTA4, CURRA4, NEXTA6, NEXTA8,NEXT20,
+     *          ALLCHR, ALLSTK, ALLHP, DECODI, FIND52,
+     *          GETATN, GETRES, GETRSN, GETSEG, GTRMI, I4VAL,
+     *          ICHAR4, ICMP16,  ILOGI4, INDX, INDXA, INDXAF,
+     *          INDXRA, INTEG4, IREAL4, IREAL8, LOCDIF,
+     *          LUNASS, MATOM, NEXTI, NINDX, NSELCT, NSELCTV, ATMSEL,
+     *          PARNUM, PARINS,
+     *          SRCHWD, SRCHWS, STRLNG, DSIZE, SSIZE,
+     *          CHKPTR, EQST, EQSTA, EQSTWC, EQWDWC, DOTRIM, CHECQUE,
+     *          HYDROG, INITIA, LONE, LTSTEQ, ORDER, ORDER5,
+     *          ORDERR, USEDDT, QTOKDEL, QDIGIT, QALPHA,
+     *          DECODF, DOTVEC, GTRMF, LENVEC, NEXTF, RANDOM, GTRR8,
+     *          RANUMB, R8VAL, RETVAL8, SUMVEC
+C..##IF ADUMB
+     *           ,UMFI
+C..##ENDIF
+C..##IF ACE
+     *           ,GETNNB
+C..##ENDIF
+C..##IFN NOIMAGES
+      INTEGER IMATOM
+      EXTERNAL IMATOM
+C..##ENDIF
+C..##IF MBOND
+C..##ENDIF
+C..##IF MMFF
+      INTEGER LEN_TRIM
+      EXTERNAL LEN_TRIM
+      CHARACTER(4) AtName
+      external AtName
+      CHARACTER(8) ElementName
+      external ElementName
+      CHARACTER(10) QNAME
+      external QNAME
+      integer  IATTCH, IBORDR, CONN12, CONN13, CONN14
+      integer  LEQUIV, LPATH
+      integer  nbndx, nbnd2, nbnd3, NTERMA
+      external IATTCH, IBORDR, CONN12, CONN13, CONN14
+      external LEQUIV, LPATH
+      external nbndx, nbnd2, nbnd3, NTERMA
+      external find_loc
+      REAL(KIND=8)   vangle, OOPNGL, TORNGL, ElementMass
+      external vangle, OOPNGL, TORNGL, ElementMass
+C..##ENDIF
+C-----------------------------------------------------------------------
+C-----------------------------------------------------------------------
+C:::##INCLUDE '~/charmm_fcm/stack.fcm'
+      INTEGER STKSIZ
+C..##IFN UNICOS
+C...##IF LARGE XLARGE
+C...##ELIF MEDIUM REDUCE
+      PARAMETER (STKSIZ=4000000)
+C...##ELIF SMALL
+C...##ELIF XSMALL
+C...##ELIF XXLARGE
+C...##ELSE
+C...##ENDIF
+      INTEGER LSTUSD,MAXUSD,STACK
+      COMMON /ISTACK/ LSTUSD,MAXUSD,STACK(STKSIZ)
+C..##ELSE
+C..##ENDIF
+C..##IF SAVEFCM
+C..##ENDIF
+C-----------------------------------------------------------------------
+C-----------------------------------------------------------------------
+C:::##INCLUDE '~/charmm_fcm/heap.fcm'
+      INTEGER HEAPDM
+C..##IFN UNICOS (unicos)
+C...##IF XXLARGE (size)
+C...##ELIF LARGE XLARGE (size)
+C...##ELIF MEDIUM (size)
+C....##IF T3D (t3d2)
+C....##ELIF TERRA (t3d2)
+C....##ELIF ALPHA (t3d2)
+C....##ELIF T3E (t3d2)
+C....##ELSE (t3d2)
+      PARAMETER (HEAPDM=2048000)
+C....##ENDIF (t3d2)
+C...##ELIF SMALL (size)
+C...##ELIF REDUCE (size)
+C...##ELIF XSMALL (size)
+C...##ELSE (size)
+C...##ENDIF (size)
+      INTEGER FREEHP,HEAPSZ,HEAP
+      COMMON /HEAPST/ FREEHP,HEAPSZ,HEAP(HEAPDM)
+      LOGICAL LHEAP(HEAPDM)
+      EQUIVALENCE (LHEAP,HEAP)
+C..##ELSE (unicos)
+C..##ENDIF (unicos)
+C..##IF SAVEFCM (save)
+C..##ENDIF (save)
+C-----------------------------------------------------------------------
+C-----------------------------------------------------------------------
+C:::##INCLUDE '~/charmm_fcm/fast.fcm'
+      INTEGER IACNB, NITCC, ICUSED, FASTER, LFAST, LMACH, OLMACH
+      INTEGER ICCOUNT, LOWTP, IGCNB, NITCC2
+      INTEGER ICCNBA, ICCNBB, ICCNBC, ICCNBD, LCCNBA, LCCNBD
+      COMMON /FASTI/ FASTER, LFAST, LMACH, OLMACH, NITCC, NITCC2,
+     &               ICUSED(MAXATC), ICCOUNT(MAXATC), LOWTP(MAXATC),
+     &               IACNB(MAXAIM), IGCNB(MAXATC),
+     &               ICCNBA, ICCNBB, ICCNBC, ICCNBD, LCCNBA, LCCNBD
+C..##IF SAVEFCM
+C..##ENDIF
+C-----------------------------------------------------------------------
+C-----------------------------------------------------------------------
+C:::##INCLUDE '~/charmm_fcm/deriv.fcm'
+      REAL(KIND=8) DX,DY,DZ
+      COMMON /DERIVR/ DX(MAXAIM),DY(MAXAIM),DZ(MAXAIM)
+C..##IF SAVEFCM
+C..##ENDIF
+C-----------------------------------------------------------------------
+C-----------------------------------------------------------------------
+C:::##INCLUDE '~/charmm_fcm/energy.fcm'
+      INTEGER LENENP, LENENT, LENENV, LENENA
+      PARAMETER (LENENP = 50, LENENT = 70, LENENV = 50,
+     &           LENENA = LENENP + LENENT + LENENV )
+      INTEGER TOTE, TOTKE, EPOT, TEMPS, GRMS, BPRESS, PJNK1, PJNK2,
+     &        PJNK3, PJNK4, HFCTE, HFCKE, EHFC, EWORK, VOLUME, PRESSE,
+     &        PRESSI, VIRI, VIRE, VIRKE, TEPR, PEPR, KEPR, KEPR2,
+     &        DROFFA,
+     &        XTLTE, XTLKE, XTLPE, XTLTEM, XTLPEP, XTLKEP, XTLKP2,
+     &        TOT4, TOTK4, EPOT4, TEM4, MbMom, BodyT, PartT
+C..##IF ACE
+     &      , SELF, SCREEN, COUL ,SOLV, INTER
+C..##ENDIF
+C..##IF FLUCQ
+     &       ,FQKIN
+C..##ENDIF
+      PARAMETER (TOTE   =  1, TOTKE  =  2, EPOT   =  3, TEMPS  =  4,
+     &           GRMS   =  5, BPRESS =  6, PJNK1  =  7, PJNK2  =  8,
+     &           PJNK3  =  9, PJNK4  = 10, HFCTE  = 11, HFCKE  = 12,
+     &           EHFC   = 13, EWORK  = 11, VOLUME = 15, PRESSE = 16,
+     &           PRESSI = 17, VIRI   = 18, VIRE   = 19, VIRKE  = 20,
+     &           TEPR   = 21, PEPR   = 22, KEPR   = 23, KEPR2  = 24,
+     &                        DROFFA = 26, XTLTE  = 27, XTLKE  = 28,
+     &           XTLPE  = 29, XTLTEM = 30, XTLPEP = 31, XTLKEP = 32,
+     &           XTLKP2 = 33,
+     &           TOT4   = 37, TOTK4  = 38, EPOT4  = 39, TEM4   = 40,
+     &           MbMom  = 41, BodyT  = 42, PartT  = 43
+C..##IF ACE
+     &         , SELF   = 45, SCREEN = 46, COUL   = 47,
+     &           SOLV   = 48, INTER  = 49
+C..##ENDIF
+C..##IF FLUCQ
+     &          ,FQKIN  = 50
+C..##ENDIF
+     &          )
+C..##IF ACE
+C..##ENDIF
+C..##IF GRID
+C..##ENDIF
+C..##IF FLUCQ
+C..##ENDIF
+      INTEGER  BOND, ANGLE, UREYB, DIHE, IMDIHE, VDW, ELEC, HBOND,
+     &         USER, CHARM, CDIHE, CINTCR, CQRT, NOE, SBNDRY,
+     &         IMVDW, IMELEC, IMHBND, EWKSUM, EWSELF, EXTNDE, RXNFLD,
+     &         ST2, IMST2, TSM, QMEL, QMVDW, ASP, EHARM, GEO, MDIP,
+     &         PRMS, PANG, SSBP, BK4D, SHEL, RESD, SHAP,
+     &         STRB, OOPL, PULL, POLAR, DMC, RGY, EWEXCL, EWQCOR,
+     &         EWUTIL, PBELEC, PBNP, PINT, MbDefrm, MbElec, STRSTR,
+     &         BNDBND, BNDTW, EBST, MBST, BBT, SST, GBEnr, GSBP
+C..##IF HMCM
+     &       , HMCM
+C..##ENDIF
+C..##IF ADUMB
+     &       , ADUMB
+C..##ENDIF
+     &       , HYDR
+C..##IF FLUCQ
+     &       , FQPOL
+C..##ENDIF
+      PARAMETER (BOND   =  1, ANGLE  =  2, UREYB  =  3, DIHE   =  4,
+     &           IMDIHE =  5, VDW    =  6, ELEC   =  7, HBOND  =  8,
+     &           USER   =  9, CHARM  = 10, CDIHE  = 11, CINTCR = 12,
+     &           CQRT   = 13, NOE    = 14, SBNDRY = 15, IMVDW  = 16,
+     &           IMELEC = 17, IMHBND = 18, EWKSUM = 19, EWSELF = 20,
+     &           EXTNDE = 21, RXNFLD = 22, ST2    = 23, IMST2  = 24,
+     &           TSM    = 25, QMEL   = 26, QMVDW  = 27, ASP    = 28,
+     &           EHARM  = 29, GEO    = 30, MDIP   = 31, PINT   = 32,
+     &           PRMS   = 33, PANG   = 34, SSBP   = 35, BK4D   = 36,
+     &           SHEL   = 37, RESD   = 38, SHAP   = 39, STRB   = 40,
+     &           OOPL   = 41, PULL   = 42, POLAR  = 43, DMC    = 44,
+     &           RGY    = 45, EWEXCL = 46, EWQCOR = 47, EWUTIL = 48,
+     &           PBELEC = 49, PBNP   = 50, MbDefrm= 51, MbElec = 52,
+     &           STRSTR = 53, BNDBND = 54, BNDTW  = 55, EBST   = 56,
+     &           MBST   = 57, BBT    = 58, SST    = 59, GBEnr  = 60,
+     &           GSBP   = 65
+C..##IF HMCM
+     &         , HMCM   = 61
+C..##ENDIF
+C..##IF ADUMB
+     &         , ADUMB  = 62
+C..##ENDIF
+     &         , HYDR   = 63
+C..##IF FLUCQ
+     &         , FQPOL  = 65
+C..##ENDIF
+     &           )
+      INTEGER  VEXX, VEXY, VEXZ, VEYX, VEYY, VEYZ, VEZX, VEZY, VEZZ,
+     &         VIXX, VIXY, VIXZ, VIYX, VIYY, VIYZ, VIZX, VIZY, VIZZ,
+     &         PEXX, PEXY, PEXZ, PEYX, PEYY, PEYZ, PEZX, PEZY, PEZZ,
+     &         PIXX, PIXY, PIXZ, PIYX, PIYY, PIYZ, PIZX, PIZY, PIZZ
+      PARAMETER ( VEXX =  1, VEXY =  2, VEXZ =  3, VEYX =  4,
+     &            VEYY =  5, VEYZ =  6, VEZX =  7, VEZY =  8,
+     &            VEZZ =  9,
+     &            VIXX = 10, VIXY = 11, VIXZ = 12, VIYX = 13,
+     &            VIYY = 14, VIYZ = 15, VIZX = 16, VIZY = 17,
+     &            VIZZ = 18,
+     &            PEXX = 19, PEXY = 20, PEXZ = 21, PEYX = 22,
+     &            PEYY = 23, PEYZ = 24, PEZX = 25, PEZY = 26,
+     &            PEZZ = 27,
+     &            PIXX = 28, PIXY = 29, PIXZ = 30, PIYX = 31,
+     &            PIYY = 32, PIYZ = 33, PIZX = 34, PIZY = 35,
+     &            PIZZ = 36)
+      CHARACTER(4)  CEPROP, CETERM, CEPRSS
+      COMMON /ANER/ CEPROP(LENENP), CETERM(LENENT), CEPRSS(LENENV)
+      LOGICAL  QEPROP, QETERM, QEPRSS
+      COMMON /QENER/ QEPROP(LENENP), QETERM(LENENT), QEPRSS(LENENV)
+      REAL(KIND=8)   EPROP, ETERM, EPRESS
+      COMMON /ENER/ EPROP(LENENP), ETERM(LENENT), EPRESS(LENENV)
+C..##IF SAVEFCM
+C..##ENDIF
+      REAL(KIND=8)   EPRPA, EPRP2A, EPRPP, EPRP2P,
+     &         ETRMA, ETRM2A, ETRMP, ETRM2P,
+     &         EPRSA, EPRS2A, EPRSP, EPRS2P
+      COMMON /ENACCM/ EPRPA(LENENP), ETRMA(LENENT), EPRSA(LENENV),
+     &                EPRP2A(LENENP),ETRM2A(LENENT),EPRS2A(LENENV),
+     &                EPRPP(LENENP), ETRMP(LENENT), EPRSP(LENENV),
+     &                EPRP2P(LENENP),ETRM2P(LENENT),EPRS2P(LENENV)
+C..##IF SAVEFCM
+C..##ENDIF
+      INTEGER  ECALLS, TOT1ST, TOT2ND
+      COMMON /EMISCI/ ECALLS, TOT1ST, TOT2ND
+      REAL(KIND=8)   EOLD, FITA, DRIFTA, EAT0A, CORRA, FITP, DRIFTP,
+     &         EAT0P, CORRP
+      COMMON /EMISCR/ EOLD, FITA, DRIFTA, EAT0A, CORRA,
+     &                     FITP, DRIFTP, EAT0P, CORRP
+C..##IF SAVEFCM
+C..##ENDIF
+C..##IF ACE
+C..##ENDIF
+C..##IF FLUCQ
+C..##ENDIF
+C..##IF ADUMB
+C..##ENDIF
+C..##IF GRID
+C..##ENDIF
+C..##IF FLUCQ
+C..##ENDIF
+C..##IF TSM
+      REAL(KIND=8) TSMTRM(LENENT),TSMTMP(LENENT)
+      COMMON /TSMENG/ TSMTRM,TSMTMP
+C...##IF SAVEFCM
+C...##ENDIF
+C..##ENDIF
+      REAL(KIND=8) EHQBM
+      LOGICAL HQBM
+      COMMON /HQBMVAR/HQBM
+C..##IF SAVEFCM
+C..##ENDIF
+C-----------------------------------------------------------------------
+C-----------------------------------------------------------------------
+C:::##INCLUDE '~/charmm_fcm/dimb.fcm'
+C..##IF DIMB (dimbfcm)
+      INTEGER NPARMX,MNBCMP,LENDSK
+      PARAMETER (NPARMX=1000,MNBCMP=300,LENDSK=200000)
+      INTEGER IJXXCM,IJXYCM,IJXZCM,IJYXCM,IJYYCM
+      INTEGER IJYZCM,IJZXCM,IJZYCM,IJZZCM
+      INTEGER IIXXCM,IIXYCM,IIXZCM,IIYYCM
+      INTEGER IIYZCM,IIZZCM
+      INTEGER JJXXCM,JJXYCM,JJXZCM,JJYYCM
+      INTEGER JJYZCM,JJZZCM
+      PARAMETER (IJXXCM=1,IJXYCM=2,IJXZCM=3,IJYXCM=4,IJYYCM=5)
+      PARAMETER (IJYZCM=6,IJZXCM=7,IJZYCM=8,IJZZCM=9)
+      PARAMETER (IIXXCM=1,IIXYCM=2,IIXZCM=3,IIYYCM=4)
+      PARAMETER (IIYZCM=5,IIZZCM=6)
+      PARAMETER (JJXXCM=1,JJXYCM=2,JJXZCM=3,JJYYCM=4)
+      PARAMETER (JJYZCM=5,JJZZCM=6)
+      INTEGER ITER,IPAR1,IPAR2,NFSAV,PINBCM,PJNBCM,PDD1CM,LENCMP
+      LOGICAL QDISK,QDW,QCMPCT
+      COMMON /DIMBI/ ITER,IPAR1,IPAR2,NFSAV,PINBCM,PJNBCM,LENCMP
+      COMMON /DIMBL/ QDISK,QDW,QCMPCT
+C...##IF SAVEFCM
+C...##ENDIF
+C..##ENDIF (dimbfcm)
+C-----------------------------------------------------------------------
+C-----------------------------------------------------------------------
+C:::##INCLUDE '~/charmm_fcm/ctitla.fcm'
+      INTEGER MAXTIT
+      PARAMETER (MAXTIT=32)
+      INTEGER NTITLA,NTITLB
+      CHARACTER(80) TITLEA,TITLEB
+      COMMON /NTITLA/ NTITLA,NTITLB
+      COMMON /CTITLA/ TITLEA(MAXTIT),TITLEB(MAXTIT)
+C..##IF SAVEFCM
+C..##ENDIF
+C-----------------------------------------------------------------------
+C Passed variables
+      INTEGER NAT3,NADD,NPAR,NFREG,NFRET,BLATOM
+      INTEGER ATMPAR(2,*),ATMPAS(2,*),ATMPAD(2,*)
+      INTEGER BNBND(*),BIMAG(*)
+      INTEGER INBCMP(*),JNBCMP(*),PARDIM
+      INTEGER ITMX,IUNMOD,IUNRMD,SAVF
+      INTEGER NBOND,IB(*),JB(*)
+      REAL(KIND=8) X(*),Y(*),Z(*),AMASS(*),DDSCR(*)
+      REAL(KIND=8) DDV(NAT3,*),PARDDV(PARDIM,*),DDM(*),DDS(*)
+      REAL(KIND=8) DDF(*),PARDDF(*),DDEV(*),PARDDE(*)
+      REAL(KIND=8) DD1BLK(*),DD1BLL(*),DD1CMP(*)
+      REAL(KIND=8) TOLDIM,DDVALM
+      REAL(KIND=8) PARFRQ,CUTF1
+      LOGICAL LNOMA,LRAISE,LSCI,LBIG
+C Local variables
+      INTEGER NATOM,NATP,NDIM,I,J,II,OLDFAS,OLDPRN,IUPD
+      INTEGER NPARC,NPARD,NPARS,NFCUT1,NFREG2,NFREG6
+      INTEGER IH1,IH2,IH3,IH4,IH5,IH6,IH7,IH8
+      INTEGER IS1,IS2,IS3,IS4,JSPACE,JSP,DDSS,DD5
+      INTEGER ISTRT,ISTOP,IPA1,IPA2,IRESF
+      INTEGER ATMPAF,INIDS,TRAROT
+      INTEGER SUBLIS,ATMCOR
+      INTEGER NFRRES,DDVBAS
+      INTEGER DDV2,DDVAL
+      INTEGER LENCM,NTR,NFRE,NFC,N1,N2,NFCUT,NSUBP
+      INTEGER SCIFV1,SCIFV2,SCIFV3,SCIFV4,SCIFV6
+      INTEGER DRATQ,ERATQ,E2RATQ,BDRATQ,INRATQ
+      INTEGER I620,I640,I660,I700,I720,I760,I800,I840,I880,I920
+      REAL(KIND=8) CVGMX,TOLER
+      LOGICAL LCARD,LAPPE,LPURG,LWDINI,QCALC,QMASWT,QMIX,QDIAG
+C Begin
+      QCALC=.TRUE.
+      LWDINI=.FALSE.
+      INIDS=0
+      IS3=0
+      IS4=0
+      LPURG=.TRUE.
+      ITER=0
+      NADD=0
+      NFSAV=0
+      TOLER=TENM5
+      QDIAG=.TRUE.
+      CVGMX=HUNDRD
+      QMIX=.FALSE.
+      NATOM=NAT3/3
+      NFREG6=(NFREG-6)/NPAR
+      NFREG2=NFREG/2
+      NFRRES=(NFREG+6)/2
+      IF(NFREG.GT.PARDIM) CALL WRNDIE(-3,'<NMDIMB>',
+     1     'NFREG IS LARGER THAN PARDIM*3')
+C
+C ALLOCATE-SPACE-FOR-TRANSROT-VECTORS
+      ASSIGN 801 TO I800 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+      GOTO 800
+ 801  CONTINUE
+C ALLOCATE-SPACE-FOR-DIAGONALIZATION
+      ASSIGN 721 TO I720 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+      GOTO 720
+ 721  CONTINUE
+C ALLOCATE-SPACE-FOR-REDUCED-BASIS
+      ASSIGN 761 TO I760 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+      GOTO 760
+ 761  CONTINUE
+C ALLOCATE-SPACE-FOR-OTHER-ARRAYS
+      ASSIGN 921 TO I920 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+      GOTO 920
+ 921  CONTINUE
+C
+C Space allocation for working arrays of EISPACK
+C diagonalization subroutines
+      IF(LSCI) THEN
+C ALLOCATE-SPACE-FOR-LSCI
+         ASSIGN 841 TO I840 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+         GOTO 840
+ 841     CONTINUE
+      ELSE
+C ALLOCATE-DUMMY-SPACE-FOR-LSCI
+         ASSIGN 881 TO I880 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+         GOTO 880
+ 881     CONTINUE
+      ENDIF
+      QMASWT=(.NOT.LNOMA)
+      IF(.NOT. QDISK) THEN
+         LENCM=INBCMP(NATOM-1)*9+NATOM*6
+         DO I=1,LENCM
+            DD1CMP(I)=0.0
+         ENDDO
+         OLDFAS=LFAST
+         QCMPCT=.TRUE.
+         LFAST = -1
+         CALL ENERGY(X,Y,Z,DX,DY,DZ,BNBND,BIMAG,NAT3,DD1CMP,.TRUE.,1)
+         LFAST=OLDFAS
+         QCMPCT=.FALSE.
+C
+C Mass weight DD1CMP matrix
+C
+         CALL MASSDD(DD1CMP,DDM,INBCMP,JNBCMP,NATOM)
+      ELSE
+         CALL WRNDIE(-3,'<NMDIMB>','QDISK OPTION NOT SUPPORTED YET')
+C         DO I=1,LENDSK
+C            DD1CMP(I)=0.0
+C         ENDDO
+C         OLDFAS=LFAST
+C         LFAST = -1
+      ENDIF
+C
+C Fill DDV with six translation-rotation vectors
+C
+      CALL TRROT(X,Y,Z,DDV,NAT3,1,DDM)
+      CALL CPARAY(HEAP(TRAROT),DDV,NAT3,1,6,1)
+      NTR=6
+      OLDPRN=PRNLEV
+      PRNLEV=1
+      CALL ORTHNM(1,6,NTR,HEAP(TRAROT),NAT3,.FALSE.,TOLER)
+      PRNLEV=OLDPRN
+      IF(IUNRMD .LT. 0) THEN
+C
+C If no previous basis is read
+C
+         IF(PRNLEV.GE.2) WRITE(OUTU,502) NPAR
+ 502     FORMAT(/' NMDIMB: Calculating initial basis from block ',
+     1           'diagonals'/' NMDIMB: The number of blocks is ',I5/)
+         NFRET = 6
+         DO I=1,NPAR
+            IS1=ATMPAR(1,I)
+            IS2=ATMPAR(2,I)
+            NDIM=(IS2-IS1+1)*3
+            NFRE=NDIM
+            IF(NFRE.GT.NFREG6) NFRE=NFREG6
+            IF(NFREG6.EQ.0) NFRE=1
+            CALL FILUPT(HEAP(IUPD),NDIM)
+            CALL MAKDDU(DD1BLK,DD1CMP,INBCMP,JNBCMP,HEAP(IUPD),
+     1                  IS1,IS2,NATOM)
+            IF(PRNLEV.GE.9) CALL PRINTE(OUTU,EPROP,ETERM,'VIBR',
+     1          'ENR',.TRUE.,1,ZERO,ZERO)
+C
+C Generate the lower section of the matrix and diagonalize
+C
+C..##IF EISPACK
+C..##ENDIF
+               IH1=1
+               NATP=NDIM+1
+               IH2=IH1+NATP
+               IH3=IH2+NATP
+               IH4=IH3+NATP
+               IH5=IH4+NATP
+               IH6=IH5+NATP
+               IH7=IH6+NATP
+               IH8=IH7+NATP
+               CALL DIAGQ(NDIM,NFRE,DD1BLK,PARDDV,DDS(IH2),DDS(IH3),
+     1           DDS(IH4),DDS(IH5),DDS,DDS(IH6),DDS(IH7),DDS(IH8),NADD)
+C..##IF EISPACK
+C..##ENDIF
+C
+C Put the PARDDV vectors into DDV and replace the elements which do
+C not belong to the considered partitioned region by zeros.
+C
+            CALL ADJNME(DDV,PARDDV,NAT3,NDIM,NFRE,NFRET,IS1,IS2)
+            IF(LSCI) THEN
+               DO J=1,NFRE
+               PARDDF(J)=CNVFRQ*SQRT(ABS(PARDDE(J)))
+               IF(PARDDE(J) .LT. 0.0) PARDDF(J)=-PARDDF(J)
+               ENDDO
+            ELSE
+               DO J=1,NFRE
+               PARDDE(J)=DDS(J)
+               PARDDF(J)=CNVFRQ*SQRT(ABS(PARDDE(J)))
+               IF(PARDDE(J) .LT. 0.0) PARDDF(J)=-PARDDF(J)
+               ENDDO
+            ENDIF
+            IF(PRNLEV.GE.2) THEN
+               WRITE(OUTU,512) I
+               WRITE(OUTU,514)
+               WRITE(OUTU,516) (J,PARDDF(J),J=1,NFRE)
+            ENDIF
+            NFRET=NFRET+NFRE
+            IF(NFRET .GE. NFREG) GOTO 10
+         ENDDO
+ 512     FORMAT(/' NMDIMB: Diagonalization of part',I5,' completed')
+ 514     FORMAT(' NMDIMB: Frequencies'/)
+ 516     FORMAT(5(I4,F12.6))
+   10    CONTINUE
+C
+C Orthonormalize the eigenvectors
+C
+         OLDPRN=PRNLEV
+         PRNLEV=1
+         CALL ORTHNM(1,NFRET,NFRET,DDV,NAT3,LPURG,TOLER)
+         PRNLEV=OLDPRN
+C
+C Do reduced basis diagonalization using the DDV vectors
+C and get eigenvectors of zero iteration
+C
+         IF(PRNLEV.GE.2) THEN
+            WRITE(OUTU,521) ITER
+            WRITE(OUTU,523) NFRET
+         ENDIF
+ 521     FORMAT(/' NMDIMB: Iteration number = ',I5)
+ 523     FORMAT(' NMDIMB: Dimension of the reduced basis set = ',I5)
+         IF(LBIG) THEN
+            IF(PRNLEV.GE.2) WRITE(OUTU,585) NFRET,IUNMOD
+ 525        FORMAT(' NMDIMB: ',I5,' basis vectors are saved in unit',I5)
+            REWIND (UNIT=IUNMOD)
+            LCARD=.FALSE.
+            CALL WRTNMD(LCARD,1,NFRET,NAT3,DDV,DDSCR,DDEV,IUNMOD,AMASS)
+            CALL SAVEIT(IUNMOD)
+         ELSE
+            CALL CPARAY(HEAP(DDVBAS),DDV,NAT3,1,NFRET,1)
+         ENDIF
+         CALL RBDG(X,Y,Z,NAT3,NDIM,NFRET,DDV,DDF,DDEV,
+     1     DDSCR,HEAP(DD5),HEAP(DDSS),HEAP(DDV2),NADD,
+     2     INBCMP,JNBCMP,HEAP(DDVBAS),DD1CMP,QMIX,0,0,IS3,IS4,
+     3     CUTF1,NFCUT1,NFREG,HEAP(IUPD),DD1BLL,HEAP(SCIFV1),
+     4     HEAP(SCIFV2),HEAP(SCIFV3),HEAP(SCIFV4),HEAP(SCIFV6),
+     5     HEAP(DRATQ),HEAP(ERATQ),HEAP(E2RATQ),
+     6     HEAP(BDRATQ),HEAP(INRATQ),LSCI,LBIG,IUNMOD)
+C
+C DO-THE-DIAGONALISATIONS-WITH-RESIDUALS
+C
+         ASSIGN 621 TO I620 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+         GOTO 620
+ 621     CONTINUE
+C SAVE-MODES
+         ASSIGN 701 TO I700 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+         GOTO 700
+ 701     CONTINUE
+         IF(ITER.EQ.ITMX) THEN
+            CALL CLEANHP(NAT3,NFREG,NPARD,NSUBP,PARDIM,DDV2,DDSS,DDVBAS,
+     1                   DDVAL,JSPACE,TRAROT,
+     2                   SCIFV1,SCIFV2,SCIFV3,SCIFV4,SCIFV6,
+     3                   DRATQ,ERATQ,E2RATQ,BDRATQ,INRATQ,IUPD,ATMPAF,
+     4                   ATMCOR,SUBLIS,LSCI,QDW,LBIG)
+            RETURN
+         ENDIF
+      ELSE
+C
+C Read in existing basis
+C
+         IF(PRNLEV.GE.2) THEN
+            WRITE(OUTU,531)
+ 531        FORMAT(/' NMDIMB: Calculations restarted')
+         ENDIF
+C READ-MODES
+         ISTRT=1
+         ISTOP=99999999
+         LCARD=.FALSE.
+         LAPPE=.FALSE.
+         CALL RDNMD(LCARD,NFRET,NFREG,NAT3,NDIM,
+     1     DDV,DDSCR,DDF,DDEV,
+     2     IUNRMD,LAPPE,ISTRT,ISTOP)
+         NFRET=NDIM
+         IF(NFRET.GT.NFREG) THEN
+            NFRET=NFREG
+            CALL WRNDIE(-1,'<NMDIMB>',
+     1       'Not enough space to hold the basis. Increase NMODes')
+         ENDIF
+C PRINT-MODES
+         IF(PRNLEV.GE.2) THEN
+            WRITE(OUTU,533) NFRET,IUNRMD
+            WRITE(OUTU,514)
+            WRITE(OUTU,516) (J,DDF(J),J=1,NFRET)
+         ENDIF
+ 533     FORMAT(/' NMDIMB: ',I5,' restart modes read from unit ',I5)
+         NFRRES=NFRET
+      ENDIF
+C
+C -------------------------------------------------
+C Here starts the mixed-basis diagonalization part.
+C -------------------------------------------------
+C
+C
+C Check cut-off frequency
+C
+      CALL SELNMD(DDF,NFRET,CUTF1,NFCUT1)
+C TEST-NFCUT1
+      IF(IUNRMD.LT.0) THEN
+        IF(NFCUT1*2-6.GT.NFREG) THEN
+           IF(PRNLEV.GE.2) WRITE(OUTU,537) DDF(NFRRES)
+           NFCUT1=NFRRES
+           CUTF1=DDF(NFRRES)
+        ENDIF
+      ELSE
+        CUTF1=DDF(NFRRES)
+      ENDIF
+ 537  FORMAT(/' NMDIMB: Too many vectors for the given cutoff frequency'
+     1       /'         Cutoff frequency is decreased to',F9.3)
+C
+C Compute the new partioning of the molecule
+C
+      CALL PARTIC(NAT3,NFREG,NFCUT1,NPARMX,NPARC,ATMPAR,NFRRES,
+     1            PARDIM)
+      NPARS=NPARC
+      DO I=1,NPARC
+         ATMPAS(1,I)=ATMPAR(1,I)
+         ATMPAS(2,I)=ATMPAR(2,I)
+      ENDDO
+      IF(QDW) THEN
+         IF(IPAR1.EQ.0.OR.IPAR2.EQ.0) LWDINI=.TRUE.
+         IF(IPAR1.GE.IPAR2) LWDINI=.TRUE.
+         IF(IABS(IPAR1).GT.NPARC*2) LWDINI=.TRUE.
+         IF(IABS(IPAR2).GT.NPARC*2) LWDINI=.TRUE.
+         IF(ITER.EQ.0) LWDINI=.TRUE.
+      ENDIF
+      ITMX=ITMX+ITER
+      IF(PRNLEV.GE.2) THEN
+         WRITE(OUTU,543) ITER,ITMX
+         IF(QDW) WRITE(OUTU,545) IPAR1,IPAR2
+      ENDIF
+ 543  FORMAT(/' NMDIMB: Previous iteration number = ',I8/
+     1        ' NMDIMB: Iteration number to reach = ',I8)
+ 545  FORMAT(' NMDIMB: Previous sub-blocks = ',I5,2X,I5)
+C
+      IF(SAVF.LE.0) SAVF=NPARC
+      IF(PRNLEV.GE.2) WRITE(OUTU,547) SAVF
+ 547  FORMAT(' NMDIMB: Eigenvectors will be saved every',I5,
+     1       ' iterations')
+C
+C If double windowing is defined, the original block sizes are divided
+C in two.
+C
+      IF(QDW) THEN
+         NSUBP=1
+         CALL PARTID(NPARC,ATMPAR,NPARD,ATMPAD,NPARMX)
+         ATMPAF=ALLHP(INTEG4(NPARD*NPARD))
+         ATMCOR=ALLHP(INTEG4(NATOM))
+         DDVAL=ALLHP(IREAL8(NPARD*NPARD))
+         CALL CORARR(ATMPAD,NPARD,HEAP(ATMCOR),NATOM)
+         CALL PARLIS(HEAP(ATMCOR),HEAP(ATMPAF),INBCMP,JNBCMP,NPARD,
+     2         NSUBP,NATOM,X,Y,Z,NBOND,IB,JB,DD1CMP,HEAP(DDVAL),DDVALM)
+         SUBLIS=ALLHP(INTEG4(NSUBP*2))
+         CALL PARINT(HEAP(ATMPAF),NPARD,HEAP(SUBLIS),NSUBP)
+         CALL INIPAF(HEAP(ATMPAF),NPARD)
+C
+C Find out with which block to continue (double window method only)
+C
+         IPA1=IPAR1
+         IPA2=IPAR2
+         IRESF=0
+         IF(LWDINI) THEN
+            ITER=0
+            LWDINI=.FALSE.
+            GOTO 500
+         ENDIF
+         DO II=1,NSUBP
+            CALL IPART(HEAP(SUBLIS),II,IPAR1,IPAR2,HEAP(ATMPAF),
+     1                 NPARD,QCALC)
+            IF((IPAR1.EQ.IPA1).AND.(IPAR2.EQ.IPA2)) GOTO 500
+         ENDDO
+      ENDIF
+ 500  CONTINUE
+C
+C Main loop.
+C
+      DO WHILE((CVGMX.GT.TOLDIM).AND.(ITER.LT.ITMX))
+         IF(.NOT.QDW) THEN
+            ITER=ITER+1
+            IF(PRNLEV.GE.2) WRITE(OUTU,553) ITER
+ 553  FORMAT(/' NMDIMB: Iteration number = ',I8)
+            IF(INIDS.EQ.0) THEN
+               INIDS=1
+            ELSE
+               INIDS=0
+            ENDIF
+            CALL PARTDS(NAT3,NPARC,ATMPAR,NPARS,ATMPAS,INIDS,NPARMX,
+     1                  DDF,NFREG,CUTF1,PARDIM,NFCUT1)
+C DO-THE-DIAGONALISATIONS
+            ASSIGN 641 to I640 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+            GOTO 640
+ 641        CONTINUE
+            QDIAG=.FALSE.
+C DO-THE-DIAGONALISATIONS-WITH-RESIDUALS
+            ASSIGN 622 TO I620 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+            GOTO 620
+ 622        CONTINUE
+            QDIAG=.TRUE.
+C SAVE-MODES
+            ASSIGN 702 TO I700 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+            GOTO 700
+ 702        CONTINUE
+C
+         ELSE
+            DO II=1,NSUBP
+               CALL IPART(HEAP(SUBLIS),II,IPAR1,IPAR2,HEAP(ATMPAF),
+     1                 NPARD,QCALC)
+               IF(QCALC) THEN
+                  IRESF=IRESF+1
+                  ITER=ITER+1
+                  IF(PRNLEV.GE.2) WRITE(OUTU,553) ITER
+C DO-THE-DWIN-DIAGONALISATIONS
+                  ASSIGN 661 TO I660 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+                  GOTO 660
+ 661              CONTINUE
+               ENDIF
+               IF((IRESF.EQ.SAVF).OR.(ITER.EQ.ITMX)) THEN
+                  IRESF=0
+                  QDIAG=.FALSE.
+C DO-THE-DIAGONALISATIONS-WITH-RESIDUALS
+                  ASSIGN 623 TO I620 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+                  GOTO 620
+ 623              CONTINUE
+                  QDIAG=.TRUE.
+                  IF((CVGMX.LE.TOLDIM).OR.(ITER.EQ.ITMX)) GOTO 600
+C SAVE-MODES
+                  ASSIGN 703 TO I700 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+                  GOTO 700
+ 703              CONTINUE
+               ENDIF
+            ENDDO
+         ENDIF
+      ENDDO
+ 600  CONTINUE
+C
+C SAVE-MODES
+      ASSIGN 704 TO I700 ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+      GOTO 700
+ 704  CONTINUE
+      CALL CLEANHP(NAT3,NFREG,NPARD,NSUBP,PARDIM,DDV2,DDSS,DDVBAS,
+     1             DDVAL,JSPACE,TRAROT,
+     2             SCIFV1,SCIFV2,SCIFV3,SCIFV4,SCIFV6,
+     3             DRATQ,ERATQ,E2RATQ,BDRATQ,INRATQ,IUPD,ATMPAF,
+     4             ATMCOR,SUBLIS,LSCI,QDW,LBIG)
+      RETURN
+C-----------------------------------------------------------------------
+C INTERNAL PROCEDURES
+C-----------------------------------------------------------------------
+C TO DO-THE-DIAGONALISATIONS-WITH-RESIDUALS
+ 620  CONTINUE
+      IF(IUNRMD.LT.0) THEN
+        CALL SELNMD(DDF,NFRET,CUTF1,NFC)
+        N1=NFCUT1
+        N2=(NFRET+6)/2
+        NFCUT=MAX(N1,N2)
+        IF(NFCUT*2-6 .GT. NFREG) THEN
+           NFCUT=(NFREG+6)/2
+           CUTF1=DDF(NFCUT)
+           IF(PRNLEV.GE.2) THEN
+             WRITE(OUTU,562) ITER
+             WRITE(OUTU,564) CUTF1
+           ENDIF
+        ENDIF
+      ELSE
+        NFCUT=NFRET
+        NFC=NFRET
+      ENDIF
+ 562  FORMAT(/' NMDIMB: Not enough space to hold the residual vectors'/
+     1       '         into DDV array during iteration ',I5)
+ 564  FORMAT('         Cutoff frequency is changed to ',F9.3)
+C
+C do reduced diagonalization with preceding eigenvectors plus
+C residual vectors
+C
+      ISTRT=1
+      ISTOP=NFCUT
+      CALL CLETR(DDV,HEAP(TRAROT),NAT3,ISTRT,ISTOP,NFCUT,DDEV,DDF)
+      CALL RNMTST(DDV,HEAP(DDVBAS),NAT3,DDSCR,DD1CMP,INBCMP,JNBCMP,
+     2            7,NFCUT,CVGMX,NFCUT,NFC,QDIAG,LBIG,IUNMOD)
+      NFSAV=NFCUT
+      IF(QDIAG) THEN
+         NFRET=NFCUT*2-6
+         IF(PRNLEV.GE.2) WRITE(OUTU,566) NFRET
+ 566     FORMAT(/' NMDIMB: Diagonalization with residual vectors. '/
+     1          '          Dimension of the reduced basis set'/
+     2          '             before orthonormalization = ',I5)
+         NFCUT=NFRET
+         OLDPRN=PRNLEV
+         PRNLEV=1
+         CALL ORTHNM(1,NFRET,NFCUT,DDV,NAT3,LPURG,TOLER)
+         PRNLEV=OLDPRN
+         NFRET=NFCUT
+         IF(PRNLEV.GE.2) WRITE(OUTU,568) NFRET
+ 568     FORMAT('             after orthonormalization  = ',I5)
+         IF(LBIG) THEN
+            IF(PRNLEV.GE.2) WRITE(OUTU,570) NFCUT,IUNMOD
+ 570        FORMAT(' NMDIMB: ',I5,' basis vectors are saved in unit',I5)
+            REWIND (UNIT=IUNMOD)
+            LCARD=.FALSE.
+            CALL WRTNMD(LCARD,1,NFCUT,NAT3,DDV,DDSCR,DDEV,IUNMOD,AMASS)
+            CALL SAVEIT(IUNMOD)
+         ELSE
+            CALL CPARAY(HEAP(DDVBAS),DDV,NAT3,1,NFCUT,1)
+         ENDIF
+         QMIX=.FALSE.
+         CALL RBDG(X,Y,Z,NAT3,NDIM,NFRET,DDV,DDF,DDEV,
+     1     DDSCR,HEAP(DD5),HEAP(DDSS),HEAP(DDV2),NADD,
+     2     INBCMP,JNBCMP,HEAP(DDVBAS),DD1CMP,QMIX,0,0,IS3,IS4,
+     3     CUTF1,NFCUT1,NFREG,HEAP(IUPD),DD1BLL,HEAP(SCIFV1),
+     4     HEAP(SCIFV2),HEAP(SCIFV3),HEAP(SCIFV4),HEAP(SCIFV6),
+     5     HEAP(DRATQ),HEAP(ERATQ),HEAP(E2RATQ),
+     6     HEAP(BDRATQ),HEAP(INRATQ),LSCI,LBIG,IUNMOD)
+         CALL SELNMD(DDF,NFRET,CUTF1,NFCUT1)
+      ENDIF
+      GOTO I620 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" }
+C
+C-----------------------------------------------------------------------
+C TO DO-THE-DIAGONALISATIONS
+ 640  CONTINUE
+      DO I=1,NPARC
+         NFCUT1=NFRRES
+         IS1=ATMPAR(1,I)
+         IS2=ATMPAR(2,I)
+         NDIM=(IS2-IS1+1)*3
+         IF(PRNLEV.GE.2) WRITE(OUTU,573) I,IS1,IS2
+ 573     FORMAT(/' NMDIMB: Mixed diagonalization, part ',I5/
+     1           ' NMDIMB: Block limits: ',I5,2X,I5)
+         IF(NDIM+NFCUT1.GT.PARDIM) CALL WRNDIE(-3,'<NMDIMB>',
+     1      'Error in dimension of block')
+         NFRET=NFCUT1
+         IF(NFRET.GT.NFREG) NFRET=NFREG
+         CALL CLETR(DDV,HEAP(TRAROT),NAT3,1,NFCUT1,NFCUT,DDEV,DDF)
+         NFCUT1=NFCUT
+         CALL ADZER(DDV,1,NFCUT1,NAT3,IS1,IS2)
+         NFSAV=NFCUT1
+         OLDPRN=PRNLEV
+         PRNLEV=1
+         CALL ORTHNM(1,NFCUT1,NFCUT,DDV,NAT3,LPURG,TOLER)
+         PRNLEV=OLDPRN
+         CALL CPARAY(HEAP(DDVBAS),DDV,NAT3,1,NFCUT,1)
+         NFRET=NDIM+NFCUT
+         QMIX=.TRUE.
+         CALL RBDG(X,Y,Z,NAT3,NDIM,NFRET,DDV,DDF,DDEV,
+     1        DDSCR,HEAP(DD5),HEAP(DDSS),HEAP(DDV2),NADD,
+     2        INBCMP,JNBCMP,HEAP(DDVBAS),DD1CMP,QMIX,IS1,IS2,IS3,IS4,
+     3        CUTF1,NFCUT,NFREG,HEAP(IUPD),DD1BLL,HEAP(SCIFV1),
+     4        HEAP(SCIFV2),HEAP(SCIFV3),HEAP(SCIFV4),HEAP(SCIFV6),
+     5        HEAP(DRATQ),HEAP(ERATQ),HEAP(E2RATQ),
+     6        HEAP(BDRATQ),HEAP(INRATQ),LSCI,LBIG,IUNMOD)
+         QMIX=.FALSE.
+         IF(NFCUT.GT.NFRRES) NFCUT=NFRRES
+         NFCUT1=NFCUT
+         NFRET=NFCUT
+      ENDDO
+      GOTO I640 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" }
+C
+C-----------------------------------------------------------------------
+C TO DO-THE-DWIN-DIAGONALISATIONS
+ 660  CONTINUE
+C
+C Store the DDV vectors into DDVBAS
+C
+      NFCUT1=NFRRES
+      IS1=ATMPAD(1,IPAR1)
+      IS2=ATMPAD(2,IPAR1)
+      IS3=ATMPAD(1,IPAR2)
+      IS4=ATMPAD(2,IPAR2)
+      NDIM=(IS2-IS1+IS4-IS3+2)*3
+      IF(PRNLEV.GE.2) WRITE(OUTU,577) IPAR1,IPAR2,IS1,IS2,IS3,IS4
+ 577  FORMAT(/' NMDIMB: Mixed double window diagonalization, parts ',
+     1        2I5/
+     2        ' NMDIMB: Block limits: ',I5,2X,I5,4X,I5,2X,I5)
+      IF(NDIM+NFCUT1.GT.PARDIM) CALL WRNDIE(-3,'<NMDIMB>',
+     1      'Error in dimension of block')
+      NFRET=NFCUT1
+      IF(NFRET.GT.NFREG) NFRET=NFREG
+C
+C Prepare the DDV vectors consisting of 6 translations-rotations
+C + eigenvectors from 7 to NFCUT1 + cartesian displacements vectors
+C spanning the atoms from IS1 to IS2
+C
+      CALL CLETR(DDV,HEAP(TRAROT),NAT3,1,NFCUT1,NFCUT,DDEV,DDF)
+      NFCUT1=NFCUT
+      NFSAV=NFCUT1
+      CALL ADZERD(DDV,1,NFCUT1,NAT3,IS1,IS2,IS3,IS4)
+      OLDPRN=PRNLEV
+      PRNLEV=1
+      CALL ORTHNM(1,NFCUT1,NFCUT,DDV,NAT3,LPURG,TOLER)
+      PRNLEV=OLDPRN
+      CALL CPARAY(HEAP(DDVBAS),DDV,NAT3,1,NFCUT,1)
+C
+      NFRET=NDIM+NFCUT
+      QMIX=.TRUE.
+      CALL RBDG(X,Y,Z,NAT3,NDIM,NFRET,DDV,DDF,DDEV,
+     1     DDSCR,HEAP(DD5),HEAP(DDSS),HEAP(DDV2),NADD,
+     2     INBCMP,JNBCMP,HEAP(DDVBAS),DD1CMP,QMIX,IS1,IS2,IS3,IS4,
+     3     CUTF1,NFCUT,NFREG,HEAP(IUPD),DD1BLL,HEAP(SCIFV1),
+     4     HEAP(SCIFV2),HEAP(SCIFV3),HEAP(SCIFV4),HEAP(SCIFV6),
+     5     HEAP(DRATQ),HEAP(ERATQ),HEAP(E2RATQ),
+     6     HEAP(BDRATQ),HEAP(INRATQ),LSCI,LBIG,IUNMOD)
+      QMIX=.FALSE.
+C
+      IF(NFCUT.GT.NFRRES) NFCUT=NFRRES
+      NFCUT1=NFCUT
+      NFRET=NFCUT
+      GOTO I660 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" }
+C
+C-----------------------------------------------------------------------
+C TO SAVE-MODES
+ 700  CONTINUE
+      IF(PRNLEV.GE.2) WRITE(OUTU,583) IUNMOD
+ 583  FORMAT(/' NMDIMB: Saving the eigenvalues and eigenvectors to unit'
+     1       ,I4)
+      REWIND (UNIT=IUNMOD)
+      ISTRT=1
+      ISTOP=NFSAV
+      LCARD=.FALSE.
+      IF(PRNLEV.GE.2) WRITE(OUTU,585) NFSAV,IUNMOD
+ 585  FORMAT(' NMDIMB: ',I5,' modes are saved in unit',I5)
+      CALL WRTNMD(LCARD,ISTRT,ISTOP,NAT3,DDV,DDSCR,DDEV,IUNMOD,
+     1            AMASS)
+      CALL SAVEIT(IUNMOD)
+      GOTO I700 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" }
+C
+C-----------------------------------------------------------------------
+C TO ALLOCATE-SPACE-FOR-DIAGONALIZATION
+ 720  CONTINUE
+      DDV2=ALLHP(IREAL8((PARDIM+3)*(PARDIM+3)))
+      JSPACE=IREAL8((PARDIM+4))*8
+      JSP=IREAL8(((PARDIM+3)*(PARDIM+4))/2)
+      JSPACE=JSPACE+JSP
+      DDSS=ALLHP(JSPACE)
+      DD5=DDSS+JSPACE-JSP
+      GOTO I720 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" }
+C
+C-----------------------------------------------------------------------
+C TO ALLOCATE-SPACE-FOR-REDUCED-BASIS
+ 760  CONTINUE
+      IF(LBIG) THEN
+         DDVBAS=ALLHP(IREAL8(NAT3))
+      ELSE
+         DDVBAS=ALLHP(IREAL8(NFREG*NAT3))
+      ENDIF
+      GOTO I760 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" }
+C
+C-----------------------------------------------------------------------
+C TO ALLOCATE-SPACE-FOR-TRANSROT-VECTORS
+ 800  CONTINUE
+      TRAROT=ALLHP(IREAL8(6*NAT3))
+      GOTO I800 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" }
+C
+C-----------------------------------------------------------------------
+C TO ALLOCATE-SPACE-FOR-LSCI
+ 840  CONTINUE
+      SCIFV1=ALLHP(IREAL8(PARDIM+3))
+      SCIFV2=ALLHP(IREAL8(PARDIM+3))
+      SCIFV3=ALLHP(IREAL8(PARDIM+3))
+      SCIFV4=ALLHP(IREAL8(PARDIM+3))
+      SCIFV6=ALLHP(IREAL8(PARDIM+3))
+      DRATQ=ALLHP(IREAL8(PARDIM+3))
+      ERATQ=ALLHP(IREAL8(PARDIM+3))
+      E2RATQ=ALLHP(IREAL8(PARDIM+3))
+      BDRATQ=ALLHP(IREAL8(PARDIM+3))
+      INRATQ=ALLHP(INTEG4(PARDIM+3))
+      GOTO I840 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" }
+C
+C-----------------------------------------------------------------------
+C TO ALLOCATE-DUMMY-SPACE-FOR-LSCI
+ 880  CONTINUE
+      SCIFV1=ALLHP(IREAL8(2))
+      SCIFV2=ALLHP(IREAL8(2))
+      SCIFV3=ALLHP(IREAL8(2))
+      SCIFV4=ALLHP(IREAL8(2))
+      SCIFV6=ALLHP(IREAL8(2))
+      DRATQ=ALLHP(IREAL8(2))
+      ERATQ=ALLHP(IREAL8(2))
+      E2RATQ=ALLHP(IREAL8(2))
+      BDRATQ=ALLHP(IREAL8(2))
+      INRATQ=ALLHP(INTEG4(2))
+      GOTO I880 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" }
+C
+C-----------------------------------------------------------------------
+C TO ALLOCATE-SPACE-FOR-OTHER-ARRAYS
+ 920  CONTINUE
+      IUPD=ALLHP(INTEG4(PARDIM+3))
+      GOTO I920 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" }
+C.##ELSE
+C.##ENDIF
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20010610.f b/gcc/testsuite/gfortran.dg/g77/20010610.f
new file mode 100644
index 000000000..5adbcd672
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20010610.f
@@ -0,0 +1,5 @@
+c { dg-do run }
+      DO I = 0, 255
+         IF (ICHAR(CHAR(I)) .NE. I) CALL ABORT
+      ENDDO
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20020307-1.f b/gcc/testsuite/gfortran.dg/g77/20020307-1.f
new file mode 100644
index 000000000..730c14d32
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20020307-1.f
@@ -0,0 +1,22 @@
+c { dg-do compile }
+      SUBROUTINE SWEEP
+      PARAMETER(MAXDIM=4,MAXVEC=4**3*8,MAXT=20)
+      REAL(KIND=8) B,W1,W2,BNORM,BINV,WT,W0,C1,C2,R1,R2
+      DIMENSION B(MAXVEC,0:3),W1(MAXVEC,0:3),W2(MAXVEC,0:3)
+      DIMENSION BNORM(MAXVEC),BINV(MAXVEC),WT(MAXVEC),W0(MAXVEC)
+      DIMENSION C1(MAXVEC),C2(MAXVEC),R1(MAXVEC),R2(MAXVEC)
+      DO 200 ILAT=1,2**IDIM
+      DO 200 I1=1,IDIM
+      DO 220 I2=1,IDIM
+      CALL INTACT(ILAT,I1,I1,W1)
+220   CONTINUE
+      DO 310 IATT=1,IDIM
+      DO 311 I=1,100
+      WT(I)=ONE + C1(I)*LOG(EPS+R1(I))
+      IF( R2(I)**2 .LE. (ONE-WT(I)**2) )THEN
+      W0(I)=WT(I)
+      ENDIF
+311   CONTINUE
+310   CONTINUE
+200   CONTINUE
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/20030326-1.f b/gcc/testsuite/gfortran.dg/g77/20030326-1.f
new file mode 100644
index 000000000..6efc5d9a6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/20030326-1.f
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options -pedantic }
+!      PR fortran/9793
+!      larson@w6yx.stanford.edu
+!
+! For gfortran, see PR 13490
+!
+       integer c
+       c = -2147483648_4 / (-1) ! { dg-error "too big for its kind" "" }
+       end
diff --git a/gcc/testsuite/gfortran.dg/g77/6177.f b/gcc/testsuite/gfortran.dg/g77/6177.f
new file mode 100644
index 000000000..d708652a6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/6177.f
@@ -0,0 +1,15 @@
+c { dg-do run }
+      program pr6177
+C
+C Test case for PR optimization/6177.
+C This bug (an ICE) originally showed up in file cblat2.f from LAPACK.
+C
+      complex x
+      complex w(1)
+      intrinsic conjg
+      x = (2.0d0, 1.0d0)
+      w(1) = x
+      x = conjg(x)
+      w(1) = conjg(w(1))
+      if (abs(x-w(1)) .gt. 1.0e-5) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/7388.f b/gcc/testsuite/gfortran.dg/g77/7388.f
new file mode 100644
index 000000000..0b8374646
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/7388.f
@@ -0,0 +1,12 @@
+C { dg-do run }
+C { dg-options "-fbounds-check" }
+      character*25 buff(0:10)
+      character*80 line
+      integer i, m1, m2
+      i  = 1
+      m1 = 1
+      m2 = 7
+      buff(i) = 'tcase0a'
+      write(line,*) buff(i)(m1:m2)
+      if (line .ne. ' tcase0a') call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/8485.f b/gcc/testsuite/gfortran.dg/g77/8485.f
new file mode 100644
index 000000000..ae5f03451
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/8485.f
@@ -0,0 +1,9 @@
+c { dg-do compile }
+C      Extracted from PR fortran/8485
+       PARAMETER (PPMULT = 1.0E5)
+       INTEGER(kind=8) NWRONG
+       PARAMETER (NWRONG = 8)
+       PARAMETER (DDMULT = PPMULT * NWRONG)
+       PRINT 10, DDMULT
+10     FORMAT (F10.3)
+       END
diff --git a/gcc/testsuite/gfortran.dg/g77/9263.f b/gcc/testsuite/gfortran.dg/g77/9263.f
new file mode 100644
index 000000000..77ce98575
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/9263.f
@@ -0,0 +1,11 @@
+C { dg-do compile }
+      PARAMETER (Q=1)
+      PARAMETER (P=10)
+      INTEGER C(10),D(10),E(10),F(10)
+C     TERMINAL NOT INTEGER
+      DATA (C(I),I=1,P)    /10*10/ ! { dg-error "End expression in DO loop" "" }
+C     START NOT INTEGER
+      DATA (D(I),I=Q,10)   /10*10/ ! { dg-error "Start expression in DO loop" "" }
+C     INCREMENT NOT INTEGER
+      DATA (E(I),I=1,10,Q) /10*10/ ! { dg-error "Step expression in DO loop" "" }
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/947.f b/gcc/testsuite/gfortran.dg/g77/947.f
new file mode 100644
index 000000000..247c1a09e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/947.f
@@ -0,0 +1,13 @@
+c { dg-do run }
+      DIMENSION A(-5:5)
+      INTEGER(kind=1) IM5, IZ, IP5
+      INTEGER(kind=2) IM1, IP1
+      PARAMETER (IM5=-5, IM1=-1, IZ=0, IP1=1, IP5=5)
+      DATA A(IM5) /-5./, A(IM1) /-1./
+      DATA A(IZ)  /0./
+      DATA A(IP5) /+5./, A(IP1) /+1./
+      IF (A(IM5) .NE. -5. .OR. A(IM1) .NE. -1. .OR.
+     ,    A(IZ)  .NE.  0. .OR.
+     ,    A(IP5) .NE. +5. .OR. A(IP1) .NE. +1. )
+     ,  CALL ABORT
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/960317-1.f b/gcc/testsuite/gfortran.dg/g77/960317-1.f
new file mode 100644
index 000000000..c8b3b69ba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/960317-1.f
@@ -0,0 +1,104 @@
+c { dg-do compile }
+* Date: Sat, 16 Mar 1996 19:58:37 -0500 (EST)
+* From: Kate Hedstrom <kate@ahab.Rutgers.EDU>
+* To: burley@gnu.ai.mit.edu
+* Subject: g77 bug in assign
+* 
+* I found some files in the NCAR graphics source code which used to
+* compile with g77 and now don't.  All contain the following combination
+* of "save" and "assign".  It fails on a Sun running SunOS 4.1.3 and a
+* Sun running SunOS 5.5 (slightly older g77), but compiles on an
+* IBM/RS6000:
+* 
+C
+      SUBROUTINE QUICK
+      SAVE
+C
+      ASSIGN 101 TO JUMP ! { dg-warning "Deleted feature: ASSIGN" "" }
+  101 Continue
+C
+      RETURN
+      END
+* 
+* Everything else in the NCAR distribution compiled, including quite a
+* few C routines.
+* 
+* Kate
+* 
+* 
+* nemo% g77 -v -c quick.f
+*  gcc -v -c -xf77 quick.f
+* Reading specs from /usr/local/lib/gcc-lib/sparc-sun-sunos4.1.3/2.7.2/specs
+* gcc version 2.7.2
+*  /usr/local/lib/gcc-lib/sparc-sun-sunos4.1.3/2.7.2/f771 quick.f -fset-g77-defaults -quiet -dumpbase quick.f -version -fversion -o /usr/tmp/cca24166.s
+* GNU F77 version 2.7.2 (sparc) compiled by GNU C version 2.7.1.
+* GNU Fortran Front End version 0.5.18-960314 compiled: Mar 16 1996 14:28:11
+* gcc: Internal compiler error: program f771 got fatal signal 11
+* 
+* 
+* nemo% gdb /usr/local/lib/gcc-lib/*/*/f771 core
+* GDB is free software and you are welcome to distribute copies of it
+*  under certain conditions; type "show copying" to see the conditions.
+* There is absolutely no warranty for GDB; type "show warranty" for details.
+* GDB 4.14 (sparc-sun-sunos4.1.3), 
+* Copyright 1995 Free Software Foundation, Inc...
+* Core was generated by `f771'.
+* Program terminated with signal 11, Segmentation fault.
+* Couldn't read input and local registers from core file
+* find_solib: Can't read pathname for load map: I/O error
+* 
+* Couldn't read input and local registers from core file
+* #0  0x21aa4 in ffecom_sym_transform_assign_ (s=???) at f/com.c:7881
+* 7881          if ((ffesymbol_save (s) || ffe_is_saveall ())
+* (gdb) where
+* #0  0x21aa4 in ffecom_sym_transform_assign_ (s=???) at f/com.c:7881
+* Error accessing memory address 0xefffefcc: Invalid argument.
+* (gdb) 
+* 
+* 
+* ahab% g77 -v -c quick.f
+*  gcc -v -c -xf77 quick.f
+* Reading specs from /usr/local/lib/gcc-lib/sparc-sun-solaris2.5/2.7.2/specs
+* gcc version 2.7.2
+*  /usr/local/lib/gcc-lib/sparc-sun-solaris2.5/2.7.2/f771 quick.f -quiet -dumpbase quick.f -version -fversion -o /var/tmp/cca003D2.s
+* GNU F77 version 2.7.2 (sparc) compiled by GNU C version 2.7.2.
+* GNU Fortran Front End version 0.5.18-960304 compiled: Mar  5 1996 16:12:46
+* gcc: Internal compiler error: program f771 got fatal signal 11
+* 
+* 
+* ahab% !gdb
+* gdb /usr/local/lib/gcc-lib/*/*/f771 core
+* GDB is free software and you are welcome to distribute copies of it
+*  under certain conditions; type "show copying" to see the conditions.
+* There is absolutely no warranty for GDB; type "show warranty" for details.
+* GDB 4.15.1 (sparc-sun-solaris2.4), 
+* Copyright 1995 Free Software Foundation, Inc...
+* Core was generated by
+* `/usr/local/lib/gcc-lib/sparc-sun-solaris2.5/2.7.2/f771 quick.f -quiet -dumpbase'.
+* Program terminated with signal 11, Segmentation fault.
+* Reading symbols from /usr/lib/libc.so.1...done.
+* Reading symbols from /usr/lib/libdl.so.1...done.
+* #0  0x43e04 in ffecom_sym_transform_assign_ (s=0x3a22f8) at f/com.c:7963
+* Source file is more recent than executable.
+* 7963      assert (st != NULL);
+* (gdb) where
+* #0  0x43e04 in ffecom_sym_transform_assign_ (s=0x3a22f8) at f/com.c:7963
+* #1  0x38044 in ffecom_expr_ (expr=0x3a23c0, dest_tree=0x0, dest=0x0, dest_used=0x0, assignp=true) at f/com.c:2100
+* #2  0x489c8 in ffecom_expr_assign_w (expr=0x3a23c0) at f/com.c:10238
+* #3  0xe9228 in ffeste_R838 (label=0x3a1ba8, target=0x3a23c0) at f/ste.c:2769
+* #4  0xdae60 in ffestd_stmt_pass_ () at f/std.c:840
+* #5  0xdc090 in ffestd_exec_end () at f/std.c:1405
+* #6  0xcb534 in ffestc_shriek_subroutine_ (ok=true) at f/stc.c:4849
+* #7  0xd8f00 in ffestc_R1225 (name=0x0) at f/stc.c:12307
+* #8  0xcc808 in ffestc_end () at f/stc.c:5572
+* #9  0x9fa84 in ffestb_end3_ (t=0x3a19c8) at f/stb.c:3216
+* #10 0x9f30c in ffestb_end (t=0x3a19c8) at f/stb.c:2995
+* #11 0x98414 in ffesta_save_ (t=0x3a19c8) at f/sta.c:453
+* #12 0x997ec in ffesta_second_ (t=0x3a19c8) at f/sta.c:1178
+* #13 0x8ed84 in ffelex_send_token_ () at f/lex.c:1614
+* #14 0x8cab8 in ffelex_finish_statement_ () at f/lex.c:946
+* #15 0x91684 in ffelex_file_fixed (wf=0x397780, f=0x37a560) at f/lex.c:2946
+* #16 0x107a94 in ffe_file (wf=0x397780, f=0x37a560) at f/top.c:456
+* #17 0x96218 in yyparse () at f/parse.c:77
+* #18 0x10beac in compile_file (name=0xdffffaf7 "quick.f") at toplev.c:2239
+* #19 0x110dc0 in main (argc=9, argv=0xdffff994, envp=0xdffff9bc) at toplev.c:3927
diff --git a/gcc/testsuite/gfortran.dg/g77/970125-0.f b/gcc/testsuite/gfortran.dg/g77/970125-0.f
new file mode 100644
index 000000000..656c4750a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/970125-0.f
@@ -0,0 +1,45 @@
+c { dg-do compile }
+c
+c Following line added on transfer to gfortran testsuite
+c { dg-excess-errors "" }
+c
+C JCB comments:
+C g77 doesn't accept the added line "integer(kind=7) ..." --
+C it crashes!
+C 
+C It's questionable that g77 DTRT with regarding to passing
+C %LOC() as an argument (thus by reference) and the new global
+C analysis.  I need to look into that further; my feeling is that
+C passing %LOC() as an argument should be treated like passing an
+C INTEGER(KIND=7) by reference, and no more specially than that
+C (and that INTEGER(KIND=7) should be permitted as equivalent to
+C INTEGER(KIND=1), INTEGER(KIND=2), or whatever, depending on the
+C system's pointer size).
+C 
+C The back end *still* has a bug here, which should be fixed,
+C because, currently, what g77 is passing to it is, IMO, correct.
+
+C No options:
+C ../../egcs/gcc/f/info.c:259: failed assertion `ffeinfo_types_[basictype][kindtype] != NULL'
+C -fno-globals -O:
+C ../../egcs/gcc/expr.c:7291: Internal compiler error in function expand_expr
+
+c     Frontend bug fixed by JCB 1998-06-01 com.c &c changes.
+
+        integer i4
+        integer(kind=8) i8
+        integer(kind=8) max4
+        data max4/2147483647/
+        i4 = %loc(i4)
+        i8 = %loc(i8)
+        print *, max4
+        print *, i4, %loc(i4)
+        print *, i8, %loc(i8)
+        call foo(i4, %loc(i4), i8, %loc(i8))
+        end
+        subroutine foo(i4, i4a, i8, i8a)
+        integer(kind=7) i4a, i8a
+        integer(kind=8) i8
+        print *, i4, i4a
+        print *, i8, i8a
+        end
diff --git a/gcc/testsuite/gfortran.dg/g77/970625-2.f b/gcc/testsuite/gfortran.dg/g77/970625-2.f
new file mode 100644
index 000000000..7f8a46448
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/970625-2.f
@@ -0,0 +1,84 @@
+* Date: Wed, 25 Jun 1997 12:48:26 +0200 (MET DST)
+* MIME-Version: 1.0
+* From: R.Hooft@EuroMail.com (Rob Hooft)
+* To: g77-alpha@gnu.ai.mit.edu
+* Subject: Re: testing 970624.
+* In-Reply-To: <199706251027.GAA07892@churchy.gnu.ai.mit.edu>
+* References: <199706251018.MAA21538@nu>
+* <199706251027.GAA07892@churchy.gnu.ai.mit.edu>
+* X-Mailer: VM 6.30 under Emacs 19.34.1
+* Content-Type: text/plain; charset=US-ASCII
+* 
+* >>>>> "CB" == Craig Burley <burley@gnu.ai.mit.edu> writes:
+* 
+*  CB> but OTOH I'd like to see more problems like this on other
+*  CB> applications, and especially other systems
+* 
+* How about this one: An application that prints "112." on all
+* compilers/platforms I have tested, except with the new g77 on ALPHA (I
+* don't have the new g77 on any other platform here to test)?
+* 
+* Application Appended. Source code courtesy of my boss.....
+* Disclaimer: I do not know the right answer, or even whether there is a
+* single right answer.....
+* 
+* Regards,
+* -- 
+* ===== R.Hooft@EuroMail.com   http://www.Sander.EMBL-Heidelberg.DE/rob/ ==
+* ==== In need of protein modeling?  http://www.Sander.EMBL-Heidelberg.DE/whatif/
+* Validation of protein structures?  http://biotech.EMBL-Heidelberg.DE:8400/ ====
+* == PGPid 0xFA19277D == Use Linux!  Free Software Rules The World! =============
+* 
+* nu[152]for% cat humor.f      
+      PROGRAM SUBROUTINE
+      LOGICAL ELSE IF
+      INTEGER REAL, GO TO PROGRAM, WHILE, THEN, END DO
+      REAL FORMAT(2)
+      DATA IF,REAL,END DO,WHILE,FORMAT(2),I2/2,6,7,1,112.,1/
+      DO THEN=1, END DO, WHILE
+         CALL = END DO - IF
+         PROGRAM = THEN - IF
+         ELSE IF = THEN .GT. IF
+         IF (THEN.GT.REAL) THEN
+            CALL FUNCTION PROGRAM (ELSE IF, GO TO PROGRAM, THEN) ! { dg-error "Type mismatch in argument" }
+         ELSE IF (ELSE IF) THEN
+            REAL = THEN + END DO
+         END IF
+      END DO
+ 10   FORMAT(I2/I2) = WHILE*REAL*THEN
+      IF (FORMAT(I2) .NE. FORMAT(I2+I2)) CALL ABORT
+      END ! DO
+      SUBROUTINE FUNCTION PROGRAM (REAL,INTEGER, LOGICAL)
+      LOGICAL REAL
+      REAL LOGICAL
+      INTEGER INTEGER, STOP, RETURN, GO TO
+      ASSIGN 9 TO STOP     ! { dg-warning "ASSIGN" "" }
+      ASSIGN = 9 + LOGICAL
+      ASSIGN 7 TO RETURN   ! { dg-warning "ASSIGN" "" }
+      ASSIGN 9 TO GO TO    ! { dg-warning "ASSIGN" "" }
+      GO TO = 5
+      STOP = 8
+      IF (.NOT.REAL) GOTO STOP ! { dg-warning "Assigned GOTO" "" }
+      IF (LOGICAL.GT.INTEGER) THEN
+         IF = LOGICAL +5
+         IF (LOGICAL.EQ.5) ASSIGN 5 TO IF ! { dg-warning "ASSIGN" "" }
+         INTEGER=IF
+      ELSE
+         IF (ASSIGN.GT.STOP) ASSIGN 9 TO GOTO ! { dg-warning "ASSIGN" "" }
+         ELSE = GO TO
+         END IF = ELSE + GO TO
+         IF (.NOT.REAL.AND.GOTO.GT.ELSE) GOTO RETURN ! { dg-warning "Assigned GOTO" "" }
+      END IF
+    5 CONTINUE
+    7 LOGICAL=LOGICAL+STOP
+    9 RETURN
+      END ! IF
+* nu[153]for% f77 humor.f
+* nu[154]for% ./a.out
+*    112.0000    
+* nu[155]for% f90 humor.f  
+* nu[156]for% ./a.out    
+*    112.0000    
+* nu[157]for% g77 humor.f 
+* nu[158]for% ./a.out    
+*   40.
diff --git a/gcc/testsuite/gfortran.dg/g77/970816-3.f b/gcc/testsuite/gfortran.dg/g77/970816-3.f
new file mode 100644
index 000000000..690438646
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/970816-3.f
@@ -0,0 +1,21 @@
+c { dg-do run }
+* Date: Wed, 13 Aug 1997 15:34:23 +0200 (METDST)
+* From: Claus Denk <denk@cica.es>
+* To: g77-alpha@gnu.ai.mit.edu
+* Subject: 970811 report - segfault bug on alpha still there
+*[...]
+* Now, the bug that I reported some weeks ago is still there, I'll post
+* the test program again:
+*
+        PROGRAM TEST
+C       a bug in g77-0.5.21 - alpha. Works with NSTART=0 and segfaults with
+C       NSTART=1 on the second write.
+        PARAMETER (NSTART=1,NADD=NSTART+1)
+        REAL AB(NSTART:NSTART)
+        AB(NSTART)=1.0
+        I=1
+        J=2
+        IND=I-J+NADD
+        write(*,*) AB(IND)
+        write(*,*) AB(I-J+NADD)
+        END
diff --git a/gcc/testsuite/gfortran.dg/g77/970915-0.f b/gcc/testsuite/gfortran.dg/g77/970915-0.f
new file mode 100644
index 000000000..228248e2a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/970915-0.f
@@ -0,0 +1,21 @@
+c { dg-do compile }
+* fixed by patch to safe_from_p to avoid visiting any SAVE_EXPR
+* node twice in a given top-level call to it.
+* (JCB com.c patch of 1998-06-04.)
+
+      SUBROUTINE TSTSIG11
+      IMPLICIT COMPLEX (A-Z)
+      EXTERNAL gzi1,gzi2
+      branch3 =  sw2 / cw
+     .     * (  rdw * (epsh*gzi1(A,B)-gzi2(A,B))
+     .     + rdw * (epsh*gzi1(A,B)-gzi2(A,B)) )
+     .     + (-1./2. + 2.*sw2/3.) / (sw*cw)
+     .     * rdw * (epsh*gzi1(A,B)-gzi2(A,B)
+     .     + rdw * (epsh*gzi1(A,B)-gzi2(A,B))
+     .     + rdw * (epsh*gzi1(A,B)-gzi2(A,B)) )
+     .     * rup * (epsh*gzi1(A,B)-gzi2(A,B)
+     .     + rup * (epsh*gzi1(A,B)-gzi2(A,B)) )
+     .     * 4.*(3.-tw**2) * gzi2(A,B)
+     .     + ((1.+2./tauw)*tw**2-(5.+2./tauw))* gzi1(A,B)
+      RETURN
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/971102-1.f b/gcc/testsuite/gfortran.dg/g77/971102-1.f
new file mode 100644
index 000000000..6181a1771
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/971102-1.f
@@ -0,0 +1,12 @@
+c { dg-do run }
+       i=3
+       j=0
+       do i=i,5
+         j = j+i
+       end do
+       do i=3,i
+         j = j+i
+       end do
+       if (i.ne.7) call abort()
+       print *, i,j
+       end
diff --git a/gcc/testsuite/gfortran.dg/g77/980310-1.f b/gcc/testsuite/gfortran.dg/g77/980310-1.f
new file mode 100644
index 000000000..303013337
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980310-1.f
@@ -0,0 +1,29 @@
+c { dg-do compile }
+C Causes internal compiler error on egcs 1.0.1 on i586-pc-sco3.2v5.0.4
+C To: egcs-bugs@cygnus.com
+C Subject: backend case range problem/fix
+C From: Dave Love <d.love@dl.ac.uk>
+C Date: 02 Dec 1997 18:11:35 +0000
+C Message-ID: <rzqpvnfboo8.fsf@djlvig.dl.ac.uk>
+C 
+C The following Fortran test case aborts the compiler because
+C tree_int_cst_lt dereferences a null tree; this is a regression from
+C gcc 2.7.
+
+      INTEGER N
+      READ(*,*) N
+      SELECT CASE (N)
+        CASE (1:)
+           WRITE(*,*) 'case 1'
+        CASE (0)
+           WRITE(*,*) 'case 0'
+      END SELECT
+      END
+
+C The relevant change to cure this is:
+C
+C Thu Dec  4 06:34:40 1997  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+C
+C       * stmt.c (pushcase_range): Clean up handling of "infinite" values.
+C
+
diff --git a/gcc/testsuite/gfortran.dg/g77/980310-2.f b/gcc/testsuite/gfortran.dg/g77/980310-2.f
new file mode 100644
index 000000000..1ed5efc59
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980310-2.f
@@ -0,0 +1,44 @@
+c { dg-do compile }
+C unable to confirm this bug on egcs 1.0.1 for i586-pc-sco3.2v5.0.4 robertl
+C
+C Date: Sat, 23 Aug 1997 00:47:53 -0400 (EDT)
+C From: David Bristow <dbristow@lynx.dac.neu.edu>
+C To: egcs-bugs@cygnus.com
+C Subject: g77 crashes compiling Dungeon
+C Message-ID: <Pine.OSF.3.91.970823003521.11281A-100000@lynx.dac.neu.edu>
+C
+C The following small segment of Dungeon (the adventure that became the 
+C commercial hit Zork) causes an internal error in f771.  The platform is 
+C i586-pc-linux-gnulibc1, the compiler is egcs-ss-970821 (g77-GNU Fortran 
+C 0.5.21-19970811)
+C 
+C --cut here--cut here--cut here--cut here--cut here--cut here--
+C g77 --verbose -fugly -fvxt -c subr_.f
+C g77 version 0.5.21-19970811
+C  gcc --verbose -fugly -fvxt -xf77 subr_.f -xnone -lf2c -lm
+C Reading specs from /usr/lib/gcc-lib/i586-pc-linux-gnulibc1/egcs-2.90.01/specs
+C gcc version egcs-2.90.01 970821 (gcc2-970802 experimental)
+C  /usr/lib/gcc-lib/i586-pc-linux-gnulibc1/egcs-2.90.01/f771 subr_.f -fset-g77-defaults -quiet -dumpbase subr_.f -version -fversion -fugly -fvxt -o /tmp/cca23974.s
+C f771: warning: -fugly is overloaded with meanings and likely to be removed;
+C f771: warning: use only the specific -fugly-* options you need
+C GNU F77 version egcs-2.90.01 970821 (gcc2-970802 experimental) (i586-pc-linux-gnulibc1) compiled by GNU C version egcs-2.90.01 970821 (gcc2-970802 experimental).
+C GNU Fortran Front End version 0.5.21-19970811
+C f/com.c:941: failed assertion `TYPE_PRECISION (type) <= TYPE_PRECISION (TREE_TYPE (e))'
+C gcc: Internal compiler error: program f771 got fatal signal 6
+C --cut here--cut here--cut here--cut here--cut here--cut here--
+C 
+C Here's the FORTRAN code, it's basically a single subroutine from subr.f 
+C in the Dungeon source, slightly altered (the original calls RAN(), which 
+C doesn't exist in the g77 runtime)
+C 
+C RND - Return a random integer mod n
+C
+      INTEGER FUNCTION RND (N)
+      IMPLICIT INTEGER (A-Z)
+      REAL RAND
+      COMMON /SEED/ RNSEED
+
+      RND = RAND(RNSEED)*FLOAT(N)
+      RETURN
+
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/980310-3.f b/gcc/testsuite/gfortran.dg/g77/980310-3.f
new file mode 100644
index 000000000..565602378
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980310-3.f
@@ -0,0 +1,260 @@
+c { dg-do compile }
+c
+c This demonstrates a problem with g77 and pic on x86 where 
+c egcs 1.0.1 and earlier will generate bogus assembler output.
+c unfortunately, gas accepts the bogus acssembler output and 
+c generates code that almost works.
+c
+
+
+C Date: Wed, 17 Dec 1997 23:20:29 +0000
+C From: Joao Cardoso <jcardoso@inescn.pt>
+C To: egcs-bugs@cygnus.com
+C Subject: egcs-1.0 f77 bug on OSR5
+C When trying to compile the Fortran file that I enclose bellow,
+C I got an assembler error:
+C 
+C ./g77 -B./ -fpic -O -c scaleg.f
+C /usr/tmp/cca002D8.s:123:syntax error at (
+C 
+C ./g77 -B./ -fpic -O0 -c scaleg.f 
+C /usr/tmp/cca002EW.s:246:invalid operand combination: leal
+C 
+C Compiling without the -fpic flag runs OK.
+
+      subroutine scaleg (n,ma,a,mb,b,low,igh,cscale,cperm,wk)
+c
+c     *****parameters:
+      integer igh,low,ma,mb,n
+      double precision a(ma,n),b(mb,n),cperm(n),cscale(n),wk(n,6)
+c
+c     *****local variables:
+      integer i,ir,it,j,jc,kount,nr,nrp2
+      double precision alpha,basl,beta,cmax,coef,coef2,coef5,cor,
+     *                 ew,ewc,fi,fj,gamma,pgamma,sum,t,ta,tb,tc
+c
+c     *****fortran functions:
+      double precision dabs, dlog10, dsign
+c     float
+c
+c     *****subroutines called:
+c     none
+c
+c     ---------------------------------------------------------------
+c
+c     *****purpose:
+c     scales the matrices a and b in the generalized eigenvalue
+c     problem a*x = (lambda)*b*x such that the magnitudes of the
+c     elements of the submatrices of a and b (as specified by low
+c     and igh) are close to unity in the least squares sense.
+c     ref.:  ward, r. c., balancing the generalized eigenvalue
+c     problem, siam j. sci. stat. comput., vol. 2, no. 2, june 1981,
+c     141-152.
+c
+c     *****parameter description:
+c
+c     on input:
+c
+c       ma,mb   integer
+c               row dimensions of the arrays containing matrices
+c               a and b respectively, as declared in the main calling
+c               program dimension statement;
+c
+c       n       integer
+c               order of the matrices a and b;
+c
+c       a       real(ma,n)
+c               contains the a matrix of the generalized eigenproblem
+c               defined above;
+c
+c       b       real(mb,n)
+c               contains the b matrix of the generalized eigenproblem
+c               defined above;
+c
+c       low     integer
+c               specifies the beginning -1 for the rows and
+c               columns of a and b to be scaled;
+c
+c       igh     integer
+c               specifies the ending -1 for the rows and columns
+c               of a and b to be scaled;
+c
+c       cperm   real(n)
+c               work array.  only locations low through igh are
+c               referenced and altered by this subroutine;
+c
+c       wk      real(n,6)
+c               work array that must contain at least 6*n locations.
+c               only locations low through igh, n+low through n+igh,
+c               ..., 5*n+low through 5*n+igh are referenced and
+c               altered by this subroutine.
+c
+c     on output:
+c
+c       a,b     contain the scaled a and b matrices;
+c
+c       cscale  real(n)
+c               contains in its low through igh locations the integer
+c               exponents of 2 used for the column scaling factors.
+c               the other locations are not referenced;
+c
+c       wk      contains in its low through igh locations the integer
+c               exponents of 2 used for the row scaling factors.
+c
+c     *****algorithm notes:
+c     none.
+c
+c     *****history:
+c     written by r. c. ward.......
+c     modified 8/86 by bobby bodenheimer so that if
+c       sum = 0 (corresponding to the case where the matrix
+c       doesn't need to be scaled) the routine returns.
+c
+c     ---------------------------------------------------------------
+c
+      if (low .eq. igh) go to 410
+      do 210 i = low,igh
+         wk(i,1) = 0.0d0
+         wk(i,2) = 0.0d0
+         wk(i,3) = 0.0d0
+         wk(i,4) = 0.0d0
+         wk(i,5) = 0.0d0
+         wk(i,6) = 0.0d0
+         cscale(i) = 0.0d0
+         cperm(i) = 0.0d0
+  210 continue
+c
+c     compute right side vector in resulting linear equations
+c
+      basl = dlog10(2.0d0)
+      do 240 i = low,igh
+         do 240 j = low,igh
+            tb = b(i,j)
+            ta = a(i,j)
+            if (ta .eq. 0.0d0) go to 220
+            ta = dlog10(dabs(ta)) / basl
+  220       continue
+            if (tb .eq. 0.0d0) go to 230
+            tb = dlog10(dabs(tb)) / basl
+  230       continue
+            wk(i,5) = wk(i,5) - ta - tb
+            wk(j,6) = wk(j,6) - ta - tb
+  240 continue
+      nr = igh-low+1
+      coef = 1.0d0/float(2*nr)
+      coef2 = coef*coef
+      coef5 = 0.5d0*coef2
+      nrp2 = nr+2
+      beta = 0.0d0
+      it = 1
+c
+c     start generalized conjugate gradient iteration
+c
+  250 continue
+      ew = 0.0d0
+      ewc = 0.0d0
+      gamma = 0.0d0
+      do 260 i = low,igh
+         gamma = gamma + wk(i,5)*wk(i,5) + wk(i,6)*wk(i,6)
+         ew = ew + wk(i,5)
+         ewc = ewc + wk(i,6)
+  260 continue
+      gamma = coef*gamma - coef2*(ew**2 + ewc**2)
+     +        - coef5*(ew - ewc)**2
+      if (it .ne. 1) beta = gamma / pgamma
+      t = coef5*(ewc - 3.0d0*ew)
+      tc = coef5*(ew - 3.0d0*ewc)
+      do 270 i = low,igh
+         wk(i,2) = beta*wk(i,2) + coef*wk(i,5) + t
+         cperm(i) = beta*cperm(i) + coef*wk(i,6) + tc
+  270 continue
+c
+c     apply matrix to vector
+c
+      do 300 i = low,igh
+         kount = 0
+         sum = 0.0d0
+         do 290 j = low,igh
+            if (a(i,j) .eq. 0.0d0) go to 280
+            kount = kount+1
+            sum = sum + cperm(j)
+  280       continue
+            if (b(i,j) .eq. 0.0d0) go to 290
+            kount = kount+1
+            sum = sum + cperm(j)
+  290    continue
+         wk(i,3) = float(kount)*wk(i,2) + sum
+  300 continue
+      do 330 j = low,igh
+         kount = 0
+         sum = 0.0d0
+         do 320 i = low,igh
+            if (a(i,j) .eq. 0.0d0) go to 310
+            kount = kount+1
+            sum = sum + wk(i,2)
+  310       continue
+            if (b(i,j) .eq. 0.0d0) go to 320
+            kount = kount+1
+            sum = sum + wk(i,2)
+  320    continue
+         wk(j,4) = float(kount)*cperm(j) + sum
+  330 continue
+      sum = 0.0d0
+      do 340 i = low,igh
+         sum = sum + wk(i,2)*wk(i,3) + cperm(i)*wk(i,4)
+  340 continue
+      if(sum.eq.0.0d0) return
+      alpha = gamma / sum
+c
+c     determine correction to current iterate
+c
+      cmax = 0.0d0
+      do 350 i = low,igh
+         cor = alpha * wk(i,2)
+         if (dabs(cor) .gt. cmax) cmax = dabs(cor)
+         wk(i,1) = wk(i,1) + cor
+         cor = alpha * cperm(i)
+         if (dabs(cor) .gt. cmax) cmax = dabs(cor)
+         cscale(i) = cscale(i) + cor
+  350 continue
+      if (cmax .lt. 0.5d0) go to 370
+      do 360 i = low,igh
+         wk(i,5) = wk(i,5) - alpha*wk(i,3)
+         wk(i,6) = wk(i,6) - alpha*wk(i,4)
+  360 continue
+      pgamma = gamma
+      it = it+1
+      if (it .le. nrp2) go to 250
+c
+c     end generalized conjugate gradient iteration
+c
+  370 continue
+      do 380 i = low,igh
+         ir = wk(i,1) + dsign(0.5d0,wk(i,1))
+         wk(i,1) = ir
+         jc = cscale(i) + dsign(0.5d0,cscale(i))
+         cscale(i) = jc
+  380 continue
+c
+c     scale a and b
+c
+      do 400 i = 1,igh
+         ir = wk(i,1)
+         fi = 2.0d0**ir
+         if (i .lt. low) fi = 1.0d0
+         do 400 j =low,n
+            jc = cscale(j)
+            fj = 2.0d0**jc
+            if (j .le. igh) go to 390
+            if (i .lt. low) go to 400
+            fj = 1.0d0
+  390       continue
+            a(i,j) = a(i,j)*fi*fj
+            b(i,j) = b(i,j)*fi*fj
+  400 continue
+  410 continue
+      return
+c
+c     last line of scaleg
+c
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980310-4.f b/gcc/testsuite/gfortran.dg/g77/980310-4.f
new file mode 100644
index 000000000..ee50bc6b4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980310-4.f
@@ -0,0 +1,348 @@
+c { dg-do compile }
+C To: egcs-bugs@cygnus.com
+C Subject: -fPIC problem showing up with fortran on x86
+C From: Dave Love <d.love@dl.ac.uk>
+C Date: 19 Dec 1997 19:31:41 +0000
+C 
+C 
+C This illustrates a long-standing problem noted at the end of the g77
+C `Actual Bugs' info node and thought to be in the back end.  Although
+C the report is against gcc 2.7 I can reproduce it (specifically on
+C redhat 4.2) with the 971216 egcs snapshot.
+C 
+C g77 version 0.5.21
+C  gcc -v -fnull-version -o /tmp/gfa00415 -xf77-cpp-input /tmp/gfa00415.f -xnone
+C -lf2c -lm
+C
+
+C ------------
+      subroutine dqage(f,a,b,epsabs,epsrel,limit,result,abserr,
+     *   neval,ier,alist,blist,rlist,elist,iord,last)
+C     --------------------------------------------------
+C
+C     Modified Feb 1989 by Barry W. Brown to eliminate key
+C     as argument (use key=1) and to eliminate all Fortran
+C     output.
+C
+C     Purpose: to make this routine usable from within S.
+C
+C     --------------------------------------------------
+c***begin prologue  dqage
+c***date written   800101   (yymmdd)
+c***revision date  830518   (yymmdd)
+c***category no.  h2a1a1
+c***keywords  automatic integrator, general-purpose,
+c             integrand examinator, globally adaptive,
+c             gauss-kronrod
+c***author  piessens,robert,appl. math. & progr. div. - k.u.leuven
+c           de doncker,elise,appl. math. & progr. div. - k.u.leuven
+c***purpose  the routine calculates an approximation result to a given
+c            definite integral   i = integral of f over (a,b),
+c            hopefully satisfying following claim for accuracy
+c            abs(i-reslt).le.max(epsabs,epsrel*abs(i)).
+c***description
+c
+c        computation of a definite integral
+c        standard fortran subroutine
+c        double precision version
+c
+c        parameters
+c         on entry
+c            f      - double precision
+c                     function subprogram defining the integrand
+c                     function f(x). the actual name for f needs to be
+c                     declared e x t e r n a l in the driver program.
+c
+c            a      - double precision
+c                     lower limit of integration
+c
+c            b      - double precision
+c                     upper limit of integration
+c
+c            epsabs - double precision
+c                     absolute accuracy requested
+c            epsrel - double precision
+c                     relative accuracy requested
+c                     if  epsabs.le.0
+c                     and epsrel.lt.max(50*rel.mach.acc.,0.5d-28),
+c                     the routine will end with ier = 6.
+c
+c            key    - integer
+c                     key for choice of local integration rule
+c                     a gauss-kronrod pair is used with
+c                          7 - 15 points if key.lt.2,
+c                         10 - 21 points if key = 2,
+c                         15 - 31 points if key = 3,
+c                         20 - 41 points if key = 4,
+c                         25 - 51 points if key = 5,
+c                         30 - 61 points if key.gt.5.
+c
+c            limit  - integer
+c                     gives an upperbound on the number of subintervals
+c                     in the partition of (a,b), limit.ge.1.
+c
+c         on return
+c            result - double precision
+c                     approximation to the integral
+c
+c            abserr - double precision
+c                     estimate of the modulus of the absolute error,
+c                     which should equal or exceed abs(i-result)
+c
+c            neval  - integer
+c                     number of integrand evaluations
+c
+c            ier    - integer
+c                     ier = 0 normal and reliable termination of the
+c                             routine. it is assumed that the requested
+c                             accuracy has been achieved.
+c                     ier.gt.0 abnormal termination of the routine
+c                             the estimates for result and error are
+c                             less reliable. it is assumed that the
+c                             requested accuracy has not been achieved.
+c            error messages
+c                     ier = 1 maximum number of subdivisions allowed
+c                             has been achieved. one can allow more
+c                             subdivisions by increasing the value
+c                             of limit.
+c                             however, if this yields no improvement it
+c                             is rather advised to analyze the integrand
+c                             in order to determine the integration
+c                             difficulties. if the position of a local
+c                             difficulty can be determined(e.g.
+c                             singularity, discontinuity within the
+c                             interval) one will probably gain from
+c                             splitting up the interval at this point
+c                             and calling the integrator on the
+c                             subranges. if possible, an appropriate
+c                             special-purpose integrator should be used
+c                             which is designed for handling the type of
+c                             difficulty involved.
+c                         = 2 the occurrence of roundoff error is
+c                             detected, which prevents the requested
+c                             tolerance from being achieved.
+c                         = 3 extremely bad integrand behavior occurs
+c                             at some points of the integration
+c                             interval.
+c                         = 6 the input is invalid, because
+c                             (epsabs.le.0 and
+c                              epsrel.lt.max(50*rel.mach.acc.,0.5d-28),
+c                             result, abserr, neval, last, rlist(1) ,
+c                             elist(1) and iord(1) are set to zero.
+c                             alist(1) and blist(1) are set to a and b
+c                             respectively.
+c
+c            alist   - double precision
+c                      vector of dimension at least limit, the first
+c                       last  elements of which are the left
+c                      end points of the subintervals in the partition
+c                      of the given integration range (a,b)
+c
+c            blist   - double precision
+c                      vector of dimension at least limit, the first
+c                       last  elements of which are the right
+c                      end points of the subintervals in the partition
+c                      of the given integration range (a,b)
+c
+c            rlist   - double precision
+c                      vector of dimension at least limit, the first
+c                       last  elements of which are the
+c                      integral approximations on the subintervals
+c
+c            elist   - double precision
+c                      vector of dimension at least limit, the first
+c                       last  elements of which are the moduli of the
+c                      absolute error estimates on the subintervals
+c
+c            iord    - integer
+c                      vector of dimension at least limit, the first k
+c                      elements of which are pointers to the
+c                      error estimates over the subintervals,
+c                      such that elist(iord(1)), ...,
+c                      elist(iord(k)) form a decreasing sequence,
+c                      with k = last if last.le.(limit/2+2), and
+c                      k = limit+1-last otherwise
+c
+c            last    - integer
+c                      number of subintervals actually produced in the
+c                      subdivision process
+c
+c***references  (none)
+c***routines called  d1mach,dqk15,dqk21,dqk31,
+c                    dqk41,dqk51,dqk61,dqpsrt
+c***end prologue  dqage
+c
+      double precision a,abserr,alist,area,area1,area12,area2,a1,a2,b,
+     *  blist,b1,b2,dabs,defabs,defab1,defab2,dmax1,d1mach,elist,epmach,
+     *  epsabs,epsrel,errbnd,errmax,error1,error2,erro12,errsum,f,
+     *  resabs,result,rlist,uflow
+      integer ier,iord,iroff1,iroff2,k,last,limit,maxerr,neval,
+     *  nrmax
+c
+      dimension alist(limit),blist(limit),elist(limit),iord(limit),
+     *  rlist(limit)
+c
+      external f
+c
+c            list of major variables
+c            -----------------------
+c
+c           alist     - list of left end points of all subintervals
+c                       considered up to now
+c           blist     - list of right end points of all subintervals
+c                       considered up to now
+c           rlist(i)  - approximation to the integral over
+c                      (alist(i),blist(i))
+c           elist(i)  - error estimate applying to rlist(i)
+c           maxerr    - pointer to the interval with largest
+c                       error estimate
+c           errmax    - elist(maxerr)
+c           area      - sum of the integrals over the subintervals
+c           errsum    - sum of the errors over the subintervals
+c           errbnd    - requested accuracy max(epsabs,epsrel*
+c                       abs(result))
+c           *****1    - variable for the left subinterval
+c           *****2    - variable for the right subinterval
+c           last      - index for subdivision
+c
+c
+c           machine dependent constants
+c           ---------------------------
+c
+c           epmach  is the largest relative spacing.
+c           uflow  is the smallest positive magnitude.
+c
+c***first executable statement  dqage
+      epmach = d1mach(4)
+      uflow = d1mach(1)
+c
+c           test on validity of parameters
+c           ------------------------------
+c
+      ier = 0
+      neval = 0
+      last = 0
+      result = 0.0d+00
+      abserr = 0.0d+00
+      alist(1) = a
+      blist(1) = b
+      rlist(1) = 0.0d+00
+      elist(1) = 0.0d+00
+      iord(1) = 0
+      if(epsabs.le.0.0d+00.and.
+     *  epsrel.lt.dmax1(0.5d+02*epmach,0.5d-28)) ier = 6
+      if(ier.eq.6) go to 999
+c
+c           first approximation to the integral
+c           -----------------------------------
+c
+      neval = 0
+      call dqk15(f,a,b,result,abserr,defabs,resabs)
+      last = 1
+      rlist(1) = result
+      elist(1) = abserr
+      iord(1) = 1
+c
+c           test on accuracy.
+c
+      errbnd = dmax1(epsabs,epsrel*dabs(result))
+      if(abserr.le.0.5d+02*epmach*defabs.and.abserr.gt.errbnd) ier = 2
+      if(limit.eq.1) ier = 1
+      if(ier.ne.0.or.(abserr.le.errbnd.and.abserr.ne.resabs)
+     *  .or.abserr.eq.0.0d+00) go to 60
+c
+c           initialization
+c           --------------
+c
+c
+      errmax = abserr
+      maxerr = 1
+      area = result
+      errsum = abserr
+      nrmax = 1
+      iroff1 = 0
+      iroff2 = 0
+c
+c           main do-loop
+c           ------------
+c
+      do 30 last = 2,limit
+c
+c           bisect the subinterval with the largest error estimate.
+c
+        a1 = alist(maxerr)
+        b1 = 0.5d+00*(alist(maxerr)+blist(maxerr))
+        a2 = b1
+        b2 = blist(maxerr)
+        call dqk15(f,a1,b1,area1,error1,resabs,defab1)
+        call dqk15(f,a2,b2,area2,error2,resabs,defab2)
+c
+c           improve previous approximations to integral
+c           and error and test for accuracy.
+c
+        neval = neval+1
+        area12 = area1+area2
+        erro12 = error1+error2
+        errsum = errsum+erro12-errmax
+        area = area+area12-rlist(maxerr)
+        if(defab1.eq.error1.or.defab2.eq.error2) go to 5
+        if(dabs(rlist(maxerr)-area12).le.0.1d-04*dabs(area12)
+     *  .and.erro12.ge.0.99d+00*errmax) iroff1 = iroff1+1
+        if(last.gt.10.and.erro12.gt.errmax) iroff2 = iroff2+1
+    5   rlist(maxerr) = area1
+        rlist(last) = area2
+        errbnd = dmax1(epsabs,epsrel*dabs(area))
+        if(errsum.le.errbnd) go to 8
+c
+c           test for roundoff error and eventually set error flag.
+c
+        if(iroff1.ge.6.or.iroff2.ge.20) ier = 2
+c
+c           set error flag in the case that the number of subintervals
+c           equals limit.
+c
+        if(last.eq.limit) ier = 1
+c
+c           set error flag in the case of bad integrand behavior
+c           at a point of the integration range.
+c
+        if(dmax1(dabs(a1),dabs(b2)).le.(0.1d+01+0.1d+03*
+     *  epmach)*(dabs(a2)+0.1d+04*uflow)) ier = 3
+c
+c           append the newly-created intervals to the list.
+c
+    8   if(error2.gt.error1) go to 10
+        alist(last) = a2
+        blist(maxerr) = b1
+        blist(last) = b2
+        elist(maxerr) = error1
+        elist(last) = error2
+        go to 20
+   10   alist(maxerr) = a2
+        alist(last) = a1
+        blist(last) = b1
+        rlist(maxerr) = area2
+        rlist(last) = area1
+        elist(maxerr) = error2
+        elist(last) = error1
+c
+c           call subroutine dqpsrt to maintain the descending ordering
+c           in the list of error estimates and select the subinterval
+c           with the largest error estimate (to be bisected next).
+c
+   20   call dqpsrt(limit,last,maxerr,errmax,elist,iord,nrmax)
+c ***jump out of do-loop
+        if(ier.ne.0.or.errsum.le.errbnd) go to 40
+   30 continue
+c
+c           compute final result.
+c           ---------------------
+c
+   40 result = 0.0d+00
+      do 50 k=1,last
+        result = result+rlist(k)
+   50 continue
+      abserr = errsum
+   60 neval = 30*neval+15
+  999 return
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980310-6.f b/gcc/testsuite/gfortran.dg/g77/980310-6.f
new file mode 100644
index 000000000..b4b2f1d1e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980310-6.f
@@ -0,0 +1,22 @@
+c { dg-do compile }
+C From: Norbert Conrad <Norbert.Conrad@hrz.uni-giessen.de>
+C Message-Id: <199711131008.LAA12272@marvin.hrz.uni-giessen.de>
+C Subject: 971105  g77 bug
+C To: egcs-bugs@cygnus.com
+C Date: Thu, 13 Nov 1997 11:08:19 +0100 (CET)
+
+C I found a bug in g77 in snapshot 971105
+
+      subroutine ai (a)
+      dimension a(-1:*)
+      return
+      end
+C ai.f: In subroutine `ai':
+C ai.f:1: 
+C          subroutine ai (a)
+C                         ^
+C Array `a' at (^) is too large to handle
+C 
+C This happens whenever the lower index boundary is negative and the upper index
+C boundary is '*'. 
+
diff --git a/gcc/testsuite/gfortran.dg/g77/980310-7.f b/gcc/testsuite/gfortran.dg/g77/980310-7.f
new file mode 100644
index 000000000..3cbcbe9ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980310-7.f
@@ -0,0 +1,51 @@
+c { dg-do compile }
+C From: "David C. Doherty" <doherty@networkcs.com>
+C Message-Id: <199711171846.MAA27947@uh.msc.edu>
+C Subject: g77: auto arrays + goto = no go
+C To: egcs-bugs@cygnus.com
+C Date: Mon, 17 Nov 1997 12:46:27 -0600 (CST)
+
+C I sent the following to fortran@gnu.ai.mit.edu, and Dave Love
+C replied that he was able to reproduce it on rs6000-aix; not on
+C others. He suggested that I send it to egcs-bugs. 
+
+C Hi - I've observed the following behavior regarding 
+C automatic arrays and gotos.  Seems similar to what I found
+C in the docs about computed gotos (but not exactly the same).
+C 
+C I suspect from the nature of the error msg that it's in the GBE.
+C 
+C I'm using egcs-971105, under linux-ppc.
+C 
+C I also observed the same in g77-0.5.19 (and gcc 2.7.2?).
+C 
+C I'd appreciate any advice on this.  thanks for the great work.
+C --
+C >cat testg77.f
+      subroutine testg77(n, a)
+c
+      implicit none
+c
+      integer n
+      real a(n)
+      real b(n)
+      integer i
+c
+      do i = 1, 10
+        if (i .gt. 4) goto 100
+        write(0, '(i2)')i
+      enddo
+c
+      goto 200
+100   continue
+200   continue
+c
+      return
+      end
+C >g77 -c testg77.f
+C testg77.f: In subroutine `testg77':
+C testg77.f:19: label `200' used before containing binding contour
+C testg77.f:18: label `100' used before containing binding contour
+C --
+C If I comment out the b(n) line or replace it with, e.g., b(10),
+C it compiles fine.
diff --git a/gcc/testsuite/gfortran.dg/g77/980310-8.f b/gcc/testsuite/gfortran.dg/g77/980310-8.f
new file mode 100644
index 000000000..c20f2d720
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980310-8.f
@@ -0,0 +1,41 @@
+c { dg-do compile }
+C To: egcs-bugs@cygnus.com
+C Subject: egcs-g77 and array indexing
+C Reply-To: etseidl@jutland.ca.sandia.gov
+C Date: Wed, 26 Nov 1997 10:38:27 -0800
+C From: Edward Seidl <etseidl@jutland.ca.sandia.gov>
+C
+C I have some horrible spaghetti code I'm trying compile with egcs-g77,
+C but it's puking on code like the example below.  I have no idea if it's
+C legal fortran or not, and I'm in no position to change it.  All I do know
+C is it compiles with a number of other compilers, including f2c and
+C g77-0.5.19.1/gcc-2.7.2.1.  When I try to compile with egcs-2.90.18 971122
+C I get the following (on both i686-pc-linux-gnu and
+C alphaev56-unknown-linux-gnu):
+C
+Cfoo.f: In subroutine `foobar':
+Cfoo.f:11: 
+C         subroutine foobar(norb,nnorb)
+C                           ^
+CArray `norb' at (^) is too large to handle
+
+      program foo
+      implicit integer(A-Z)
+      dimension norb(6)
+      nnorb=6
+
+      call foobar(norb,nnorb)
+
+      stop
+      end
+
+      subroutine foobar(norb,nnorb)
+      implicit integer(A-Z)
+      dimension norb(-1:*)
+
+      do 10 i=-1,nnorb-2
+        norb(i) = i+999
+  10  continue
+
+      return
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980419-2.f b/gcc/testsuite/gfortran.dg/g77/980419-2.f
new file mode 100644
index 000000000..bb02862e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980419-2.f
@@ -0,0 +1,51 @@
+c { dg-do compile }
+c { dg-options "-std=legacy" }
+c
+c     SEGVs in loop.c with -O2.
+
+      character*80 function nxtlin(lun,ierr,itok)
+      character onechr*1,twochr*2,thrchr*3
+      itok=0
+      do while (.true.)
+         read (lun,'(a)',iostat=ierr) nxtlin
+         if (nxtlin(1:1).ne.'#') then
+            ito=0
+            do 10 it=1,79
+               if (nxtlin(it:it).ne.' ' .and. nxtlin(it+1:it+1).eq.' ')
+     $              then
+                  itast=0
+                  itstrt=0
+                  do itt=ito+1,it
+                     if (nxtlin(itt:itt).eq.'*') itast=itt
+                  enddo
+                  itstrt=ito+1
+                  do while (nxtlin(itstrt:itstrt).eq.' ')
+                     itstrt=itstrt+1
+                  enddo
+                  if (itast.gt.0) then
+                     nchrs=itast-itstrt
+                     if (nchrs.eq.1) then
+                        onechr=nxtlin(itstrt:itstrt)
+                        read (onechr,*) itokn
+                     elseif (nchrs.eq.2) then
+                        twochr=nxtlin(itstrt:itstrt+1)
+                        read (twochr,*) itokn
+                     elseif (nchrs.eq.3) then
+                        thrchr=nxtlin(itstrt:itstrt+2)
+                        read (thrchr,*) itokn
+                     elseif (nchrs.eq.4) then
+                        thrchr=nxtlin(itstrt:itstrt+3)
+                        read (thrchr,*) itokn
+                     endif
+                     itok=itok+itokn
+                  else
+                     itok=itok+1
+                  endif
+                  ito=it+1
+               endif
+ 10         continue
+            return
+         endif
+      enddo
+      return
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980424-0.f b/gcc/testsuite/gfortran.dg/g77/980424-0.f
new file mode 100644
index 000000000..dd6e7a858
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980424-0.f
@@ -0,0 +1,7 @@
+c { dg-do compile }
+C     crashes in subst_stack_regs_pat on x86-linux, in the "abort();"
+C     within the switch statement.
+      SUBROUTINE C(A)
+      COMPLEX A
+      WRITE(*,*) A.NE.CMPLX(0.0D0)
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/980427-0.f b/gcc/testsuite/gfortran.dg/g77/980427-0.f
new file mode 100644
index 000000000..c5c3ade00
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980427-0.f
@@ -0,0 +1,9 @@
+c { dg-do compile }
+c ../../egcs/gcc/f/com.c:938: failed assertion `TREE_CODE (TREE_TYPE (e)) == REAL_TYPE'
+c     Fixed by 28-04-1998 global.c (ffeglobal_ref_progunit_) change.
+      external b
+      call y(b)
+      end
+      subroutine x
+      a = b()
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980519-2.f b/gcc/testsuite/gfortran.dg/g77/980519-2.f
new file mode 100644
index 000000000..3134a00b5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980519-2.f
@@ -0,0 +1,51 @@
+c { dg-do compile }
+* Date: Fri, 17 Apr 1998 14:12:51 +0200
+* From: Jean-Paul Jeannot <jeannot@gx-tech.fr>
+* Organization: GX Technology France
+* To: egcs-bugs@cygnus.com
+* Subject: identified bug in g77 on Alpha
+* 
+* Dear Sir,
+* 
+* You will find below the assembly code of a simple Fortran routine which
+* crashes with segmentation fault when storing the first element 
+*       in( jT_f-hd_T     ) = Xsp
+* whereas everything is fine when commenting this line.
+* 
+* The assembly code (generated with 
+* -ffast-math -fexpensive-optimizations -fomit-frame-pointer -fno-inline
+* or with -O5)
+* uses a zapnot instruction to copy an address.
+* BUT the zapnot parameter is 15 (copuing 4 bytes) instead of 255 (to copy
+* 8 bytes). 
+* 
+* I guess this is typically a 64 bit issue. As, from my understanding,
+* zapnots are used a lot to copy registers, this may create problems
+* elsewhere.
+* 
+* Thanks for your help
+* 
+* Jean-Paul Jeannot
+* 
+      subroutine simul_trace( in, Xsp, Ysp, Xrcv, Yrcv )
+
+c   Next declaration added on transfer to gfortran testsuite
+      integer hd_S, hd_Z, hd_T
+
+      common /Idim/ jT_f, jT_l, nT, nT_dim
+      common /Idim/ jZ_f, jZ_l, nZ, nZ_dim
+      common /Idim/ jZ2_f, jZ2_l, nZ2, nZ2_dim
+      common /Idim/ jzs_f, jzs_l, nzs, nzs_dim, l_amp
+      common /Idim/ hd_S, hd_Z, hd_T
+      common /Idim/ nlay, nlayz
+      common /Idim/ n_work
+      common /Idim/ nb_calls
+
+      real Xsp, Ysp, Xrcv, Yrcv
+      real in( jT_f-hd_T : jT_l )
+
+      in( jT_f-hd_T     ) = Xsp
+      in( jT_f-hd_T + 1 ) = Ysp 
+      in( jT_f-hd_T + 2 ) = Xrcv
+      in( jT_f-hd_T + 3 ) = Yrcv
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980520-1.f b/gcc/testsuite/gfortran.dg/g77/980520-1.f
new file mode 100644
index 000000000..855b9a442
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980520-1.f
@@ -0,0 +1,9 @@
+c { dg-do run }
+c { dg-options "-std=legacy" }
+c
+c     Produced a link error through not eliminating the unused statement
+c     function after 1998-05-15 change to gcc/toplev.c.  It's in
+c     `execute' since it needs to link.
+c     Fixed by 1998-05-23 change to f/com.c.
+      values(i,j) = val((i-1)*n+j)
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980615-0.f b/gcc/testsuite/gfortran.dg/g77/980615-0.f
new file mode 100644
index 000000000..5107f4f79
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980615-0.f
@@ -0,0 +1,12 @@
+c { dg-do compile }
+* Fixed by JCB 1998-07-25 change to stc.c.
+
+* Date: Thu, 11 Jun 1998 22:35:20 -0500
+* From: Ian A Watson <WATSON_IAN_A@lilly.com>
+* Subject: crash
+* 
+      CaLL foo(W)
+      END
+      SUBROUTINE foo(W)
+      yy(I)=A(I)Q(X) ! { dg-error "Unclassifiable statement" "" }
+c { dg-error "end of file" "end of file" { target *-*-* } 0 }
diff --git a/gcc/testsuite/gfortran.dg/g77/980616-0.f b/gcc/testsuite/gfortran.dg/g77/980616-0.f
new file mode 100644
index 000000000..069b611eb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980616-0.f
@@ -0,0 +1,10 @@
+c { dg-do compile }
+* Fixed by 1998-07-11 equiv.c change.
+* ../../gcc/f/equiv.c:666: failed assertion `ffebld_op (subscript) == FFEBLD_opCONTER'
+
+* Date: Mon, 15 Jun 1998 21:54:32 -0500
+* From: Ian A Watson <WATSON_IAN_A@lilly.com>
+* Subject: Mangler Crash
+      EQUIVALENCE(I,glerf(P)) ! { dg-error "is a variable"  "is a variable" }
+      COMMON /foo/ glerf(3)
+c { dg-error "end of file" "end of file" { target *-*-* } 0 }
diff --git a/gcc/testsuite/gfortran.dg/g77/980628-0.f b/gcc/testsuite/gfortran.dg/g77/980628-0.f
new file mode 100644
index 000000000..9943e3c21
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980628-0.f
@@ -0,0 +1,62 @@
+c { dg-do run }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+      equivalence (r1(2), d1)
+      equivalence (r2(2), d2)
+      equivalence (r3(2), d3)
+
+      r1(1) = 1.
+      d1 = 10.
+      r1(4) = 1.
+      r1(5) = 1.
+      i1 = 1
+      r2(1) = 2.
+      d2 = 20.
+      r2(4) = 2.
+      r2(5) = 2.
+      i2 = 2
+      r3(1) = 3.
+      d3 = 30.
+      r3(4) = 3.
+      r3(5) = 3.
+      i3 = 3
+
+      call x (r1, d1, i1, r2, d2, i2, r3, d3, i3)
+
+      end
+
+      subroutine x (r1, d1, i1, r2, d2, i2, r3, d3, i3)
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+
+      if (r1(1) .ne. 1.) call abort
+      if (d1 .ne. 10.) call abort
+      if (r1(4) .ne. 1.) call abort
+      if (r1(5) .ne. 1.) call abort
+      if (i1 .ne. 1) call abort
+      if (r2(1) .ne. 2.) call abort
+      if (d2 .ne. 20.) call abort
+      if (r2(4) .ne. 2.) call abort
+      if (r2(5) .ne. 2.) call abort
+      if (i2 .ne. 2) call abort
+      if (r3(1) .ne. 3.) call abort
+      if (d3 .ne. 30.) call abort
+      if (r3(4) .ne. 3.) call abort
+      if (r3(5) .ne. 3.) call abort
+      if (i3 .ne. 3) call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980628-1.f b/gcc/testsuite/gfortran.dg/g77/980628-1.f
new file mode 100644
index 000000000..7524a3f8a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980628-1.f
@@ -0,0 +1,63 @@
+c { dg-do run }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+      save
+
+      real r1(5), r2(5), r3(5)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+      equivalence (r1(2), d1)
+      equivalence (r2(2), d2)
+      equivalence (r3(2), d3)
+
+      r1(1) = 1.
+      d1 = 10.
+      r1(4) = 1.
+      r1(5) = 1.
+      i1 = 1
+      r2(1) = 2.
+      d2 = 20.
+      r2(4) = 2.
+      r2(5) = 2.
+      i2 = 2
+      r3(1) = 3.
+      d3 = 30.
+      r3(4) = 3.
+      r3(5) = 3.
+      i3 = 3
+
+      call x (r1, d1, i1, r2, d2, i2, r3, d3, i3)
+
+      end
+
+      subroutine x (r1, d1, i1, r2, d2, i2, r3, d3, i3)
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+
+      if (r1(1) .ne. 1.) call abort
+      if (d1 .ne. 10.) call abort
+      if (r1(4) .ne. 1.) call abort
+      if (r1(5) .ne. 1.) call abort
+      if (i1 .ne. 1) call abort
+      if (r2(1) .ne. 2.) call abort
+      if (d2 .ne. 20.) call abort
+      if (r2(4) .ne. 2.) call abort
+      if (r2(5) .ne. 2.) call abort
+      if (i2 .ne. 2) call abort
+      if (r3(1) .ne. 3.) call abort
+      if (d3 .ne. 30.) call abort
+      if (r3(4) .ne. 3.) call abort
+      if (r3(5) .ne. 3.) call abort
+      if (i3 .ne. 3) call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980628-10.f b/gcc/testsuite/gfortran.dg/g77/980628-10.f
new file mode 100644
index 000000000..b7429e4c9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980628-10.f
@@ -0,0 +1,59 @@
+c { dg-do run }
+c { dg-options "-std=gnu" }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+      save
+
+      character c1(11), c2(11), c3(11)
+      real r1, r2, r3
+      character c4, c5, c6
+      equivalence (r1, c1(2))
+      equivalence (r2, c2(2))
+      equivalence (r3, c3(2))
+
+      c1(1) = '1'
+      r1 = 1.
+      c1(11) = '1'
+      c4 = '4'
+      c2(1) = '2'
+      r2 = 2.
+      c2(11) = '2'
+      c5 = '5'
+      c3(1) = '3'
+      r3 = 3.
+      c3(11) = '3'
+      c6 = '6'
+
+      call x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
+
+      end
+
+      subroutine x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
+      implicit none
+
+      character c1(11), c2(11), c3(11)
+      real r1, r2, r3
+      character c4, c5, c6
+
+      if (c1(1) .ne. '1') call abort
+      if (r1 .ne. 1.) call abort
+      if (c1(11) .ne. '1') call abort
+      if (c4 .ne. '4') call abort
+      if (c2(1) .ne. '2') call abort
+      if (r2 .ne. 2.) call abort
+      if (c2(11) .ne. '2') call abort
+      if (c5 .ne. '5') call abort
+      if (c3(1) .ne. '3') call abort
+      if (r3 .ne. 3.) call abort
+      if (c3(11) .ne. '3') call abort
+      if (c6 .ne. '6') call abort
+
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/g77/980628-2.f b/gcc/testsuite/gfortran.dg/g77/980628-2.f
new file mode 100644
index 000000000..89a9e2354
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980628-2.f
@@ -0,0 +1,57 @@
+c { dg-do run }
+c { dg-options "-std=gnu" }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+
+      character c1(11), c2(11), c3(11)
+      real r1, r2, r3
+      character c4, c5, c6
+      equivalence (c1(2), r1)
+      equivalence (c2(2), r2)
+      equivalence (c3(2), r3)
+
+      c1(1) = '1'
+      r1 = 1.
+      c1(11) = '1'
+      c4 = '4'
+      c2(1) = '2'
+      r2 = 2.
+      c2(11) = '2'
+      c5 = '5'
+      c3(1) = '3'
+      r3 = 3.
+      c3(11) = '3'
+      c6 = '6'
+
+      call x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
+
+      end
+
+      subroutine x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
+      implicit none
+
+      character c1(11), c2(11), c3(11)
+      real r1, r2, r3
+      character c4, c5, c6
+
+      if (c1(1) .ne. '1') call abort
+      if (r1 .ne. 1.) call abort
+      if (c1(11) .ne. '1') call abort
+      if (c4 .ne. '4') call abort
+      if (c2(1) .ne. '2') call abort
+      if (r2 .ne. 2.) call abort
+      if (c2(11) .ne. '2') call abort
+      if (c5 .ne. '5') call abort
+      if (c3(1) .ne. '3') call abort
+      if (r3 .ne. 3.) call abort
+      if (c3(11) .ne. '3') call abort
+      if (c6 .ne. '6') call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980628-3.f b/gcc/testsuite/gfortran.dg/g77/980628-3.f
new file mode 100644
index 000000000..dea368d02
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980628-3.f
@@ -0,0 +1,59 @@
+c { dg-do run }
+c { dg-options "-std=gnu" }
+c
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+      save
+
+      character c1(11), c2(11), c3(11)
+      real r1, r2, r3
+      character c4, c5, c6
+      equivalence (c1(2), r1)
+      equivalence (c2(2), r2)
+      equivalence (c3(2), r3)
+
+      c1(1) = '1'
+      r1 = 1.
+      c1(11) = '1'
+      c4 = '4'
+      c2(1) = '2'
+      r2 = 2.
+      c2(11) = '2'
+      c5 = '5'
+      c3(1) = '3'
+      r3 = 3.
+      c3(11) = '3'
+      c6 = '6'
+
+      call x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
+
+      end
+
+      subroutine x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
+      implicit none
+
+      character c1(11), c2(11), c3(11)
+      real r1, r2, r3
+      character c4, c5, c6
+
+      if (c1(1) .ne. '1') call abort
+      if (r1 .ne. 1.) call abort
+      if (c1(11) .ne. '1') call abort
+      if (c4 .ne. '4') call abort
+      if (c2(1) .ne. '2') call abort
+      if (r2 .ne. 2.) call abort
+      if (c2(11) .ne. '2') call abort
+      if (c5 .ne. '5') call abort
+      if (c3(1) .ne. '3') call abort
+      if (r3 .ne. 3.) call abort
+      if (c3(11) .ne. '3') call abort
+      if (c6 .ne. '6') call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980628-7.f b/gcc/testsuite/gfortran.dg/g77/980628-7.f
new file mode 100644
index 000000000..22ef08a47
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980628-7.f
@@ -0,0 +1,63 @@
+c { dg-do run }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+      equivalence (d1, r1(2))
+      equivalence (d2, r2(2))
+      equivalence (d3, r3(2))
+
+      r1(1) = 1.
+      d1 = 10.
+      r1(4) = 1.
+      r1(5) = 1.
+      i1 = 1
+      r2(1) = 2.
+      d2 = 20.
+      r2(4) = 2.
+      r2(5) = 2.
+      i2 = 2
+      r3(1) = 3.
+      d3 = 30.
+      r3(4) = 3.
+      r3(5) = 3.
+      i3 = 3
+
+      call x (r1, d1, i1, r2, d2, i2, r3, d3, i3)
+
+      end
+
+      subroutine x (r1, d1, i1, r2, d2, i2, r3, d3, i3)
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+
+      if (r1(1) .ne. 1.) call abort
+      if (d1 .ne. 10.) call abort
+      if (r1(4) .ne. 1.) call abort
+      if (r1(5) .ne. 1.) call abort
+      if (i1 .ne. 1) call abort
+      if (r2(1) .ne. 2.) call abort
+      if (d2 .ne. 20.) call abort
+      if (r2(4) .ne. 2.) call abort
+      if (r2(5) .ne. 2.) call abort
+      if (i2 .ne. 2) call abort
+      if (r3(1) .ne. 3.) call abort
+      if (d3 .ne. 30.) call abort
+      if (r3(4) .ne. 3.) call abort
+      if (r3(5) .ne. 3.) call abort
+      if (i3 .ne. 3) call abort
+
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/g77/980628-8.f b/gcc/testsuite/gfortran.dg/g77/980628-8.f
new file mode 100644
index 000000000..3b4a4a3fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980628-8.f
@@ -0,0 +1,64 @@
+c { dg-do run }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+      save
+
+      real r1(5), r2(5), r3(5)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+      equivalence (d1, r1(2))
+      equivalence (d2, r2(2))
+      equivalence (d3, r3(2))
+
+      r1(1) = 1.
+      d1 = 10.
+      r1(4) = 1.
+      r1(5) = 1.
+      i1 = 1
+      r2(1) = 2.
+      d2 = 20.
+      r2(4) = 2.
+      r2(5) = 2.
+      i2 = 2
+      r3(1) = 3.
+      d3 = 30.
+      r3(4) = 3.
+      r3(5) = 3.
+      i3 = 3
+
+      call x (r1, d1, i1, r2, d2, i2, r3, d3, i3)
+
+      end
+
+      subroutine x (r1, d1, i1, r2, d2, i2, r3, d3, i3)
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+
+      if (r1(1) .ne. 1.) call abort
+      if (d1 .ne. 10.) call abort
+      if (r1(4) .ne. 1.) call abort
+      if (r1(5) .ne. 1.) call abort
+      if (i1 .ne. 1) call abort
+      if (r2(1) .ne. 2.) call abort
+      if (d2 .ne. 20.) call abort
+      if (r2(4) .ne. 2.) call abort
+      if (r2(5) .ne. 2.) call abort
+      if (i2 .ne. 2) call abort
+      if (r3(1) .ne. 3.) call abort
+      if (d3 .ne. 30.) call abort
+      if (r3(4) .ne. 3.) call abort
+      if (r3(5) .ne. 3.) call abort
+      if (i3 .ne. 3) call abort
+
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/g77/980628-9.f b/gcc/testsuite/gfortran.dg/g77/980628-9.f
new file mode 100644
index 000000000..7e2f2279f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980628-9.f
@@ -0,0 +1,58 @@
+c { dg-do run }
+c { dg-options "-std=gnu" }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+
+      character c1(11), c2(11), c3(11)
+      real r1, r2, r3
+      character c4, c5, c6
+      equivalence (r1, c1(2))
+      equivalence (r2, c2(2))
+      equivalence (r3, c3(2))
+
+      c1(1) = '1'
+      r1 = 1.
+      c1(11) = '1'
+      c4 = '4'
+      c2(1) = '2'
+      r2 = 2.
+      c2(11) = '2'
+      c5 = '5'
+      c3(1) = '3'
+      r3 = 3.
+      c3(11) = '3'
+      c6 = '6'
+
+      call x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
+
+      end
+
+      subroutine x (c1, r1, c2, r2, c3, r3, c4, c5, c6)
+      implicit none
+
+      character c1(11), c2(11), c3(11)
+      real r1, r2, r3
+      character c4, c5, c6
+
+      if (c1(1) .ne. '1') call abort
+      if (r1 .ne. 1.) call abort
+      if (c1(11) .ne. '1') call abort
+      if (c4 .ne. '4') call abort
+      if (c2(1) .ne. '2') call abort
+      if (r2 .ne. 2.) call abort
+      if (c2(11) .ne. '2') call abort
+      if (c5 .ne. '5') call abort
+      if (c3(1) .ne. '3') call abort
+      if (r3 .ne. 3.) call abort
+      if (c3(11) .ne. '3') call abort
+      if (c6 .ne. '6') call abort
+
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/g77/980701-0.f b/gcc/testsuite/gfortran.dg/g77/980701-0.f
new file mode 100644
index 000000000..2820d2e1d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980701-0.f
@@ -0,0 +1,73 @@
+c { dg-do run }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      real s1(2), s2(2), s3(2)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+      equivalence (r1, s1(2))
+      equivalence (d1, r1(2))
+      equivalence (r2, s2(2))
+      equivalence (d2, r2(2))
+      equivalence (r3, s3(2))
+      equivalence (d3, r3(2))
+
+      s1(1) = 1.
+      r1(1) = 1.
+      d1 = 10.
+      r1(4) = 1.
+      r1(5) = 1.
+      i1 = 1
+      s2(1) = 2.
+      r2(1) = 2.
+      d2 = 20.
+      r2(4) = 2.
+      r2(5) = 2.
+      i2 = 2
+      s3(1) = 3.
+      r3(1) = 3.
+      d3 = 30.
+      r3(4) = 3.
+      r3(5) = 3.
+      i3 = 3
+
+      call x (s1, r1, d1, i1, s2, r2, d2, i2, s3, r3, d3, i3)
+
+      end
+
+      subroutine x (s1, r1, d1, i1, s2, r2, d2, i2, s3, r3, d3, i3)
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      real s1(2), s2(2), s3(2)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+
+      if (s1(1) .ne. 1.) call abort
+      if (r1(1) .ne. 1.) call abort
+      if (d1 .ne. 10.) call abort
+      if (r1(4) .ne. 1.) call abort
+      if (r1(5) .ne. 1.) call abort
+      if (i1 .ne. 1) call abort
+      if (s2(1) .ne. 2.) call abort
+      if (r2(1) .ne. 2.) call abort
+      if (d2 .ne. 20.) call abort
+      if (r2(4) .ne. 2.) call abort
+      if (r2(5) .ne. 2.) call abort
+      if (i2 .ne. 2) call abort
+      if (s3(1) .ne. 3.) call abort
+      if (r3(1) .ne. 3.) call abort
+      if (d3 .ne. 30.) call abort
+      if (r3(4) .ne. 3.) call abort
+      if (r3(5) .ne. 3.) call abort
+      if (i3 .ne. 3) call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980701-1.f b/gcc/testsuite/gfortran.dg/g77/980701-1.f
new file mode 100644
index 000000000..0f07de3f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980701-1.f
@@ -0,0 +1,73 @@
+c { dg-do run }
+* g77 0.5.23 and previous had bugs involving too little space
+* allocated for EQUIVALENCE and COMMON areas needing initial
+* padding to meet alignment requirements of the system.
+
+      call subr
+      end
+
+      subroutine subr
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      real s1(2), s2(2), s3(2)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+      equivalence (d1, r1(2))
+      equivalence (r1, s1(2))
+      equivalence (d2, r2(2))
+      equivalence (r2, s2(2))
+      equivalence (d3, r3(2))
+      equivalence (r3, s3(2))
+
+      s1(1) = 1.
+      r1(1) = 1.
+      d1 = 10.
+      r1(4) = 1.
+      r1(5) = 1.
+      i1 = 1
+      s2(1) = 2.
+      r2(1) = 2.
+      d2 = 20.
+      r2(4) = 2.
+      r2(5) = 2.
+      i2 = 2
+      s3(1) = 3.
+      r3(1) = 3.
+      d3 = 30.
+      r3(4) = 3.
+      r3(5) = 3.
+      i3 = 3
+
+      call x (s1, r1, d1, i1, s2, r2, d2, i2, s3, r3, d3, i3)
+
+      end
+
+      subroutine x (s1, r1, d1, i1, s2, r2, d2, i2, s3, r3, d3, i3)
+      implicit none
+
+      real r1(5), r2(5), r3(5)
+      real s1(2), s2(2), s3(2)
+      double precision d1, d2, d3
+      integer i1, i2, i3
+
+      if (s1(1) .ne. 1.) call abort
+      if (r1(1) .ne. 1.) call abort
+      if (d1 .ne. 10.) call abort
+      if (r1(4) .ne. 1.) call abort
+      if (r1(5) .ne. 1.) call abort
+      if (i1 .ne. 1) call abort
+      if (s2(1) .ne. 2.) call abort
+      if (r2(1) .ne. 2.) call abort
+      if (d2 .ne. 20.) call abort
+      if (r2(4) .ne. 2.) call abort
+      if (r2(5) .ne. 2.) call abort
+      if (i2 .ne. 2) call abort
+      if (s3(1) .ne. 3.) call abort
+      if (r3(1) .ne. 3.) call abort
+      if (d3 .ne. 30.) call abort
+      if (r3(4) .ne. 3.) call abort
+      if (r3(5) .ne. 3.) call abort
+      if (i3 .ne. 3) call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/980729-0.f b/gcc/testsuite/gfortran.dg/g77/980729-0.f
new file mode 100644
index 000000000..f0ca9da66
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/980729-0.f
@@ -0,0 +1,6 @@
+c { dg-do compile }
+c     Got ICE on Alpha only with -mieee (currently not tested).
+c     Fixed by rth 1998-07-30 alpha.md change.
+      subroutine a(b,c)
+      b = max(b,c)
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/981117-1.f b/gcc/testsuite/gfortran.dg/g77/981117-1.f
new file mode 100644
index 000000000..705a5da40
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/981117-1.f
@@ -0,0 +1,24 @@
+c { dg-do compile }
+* egcs-bugs:
+* From: Martin Kahlert <martin.kahlert@mchp.siemens.de>
+* Subject: ICE in g77 from egcs-19981109
+* Message-Id: <199811101134.MAA29838@keksy.mchp.siemens.de>
+
+* As of 1998-11-17, fails -O2 -fomit-frame-pointer with 
+* egcs/gcc/testsuite/g77.f-torture/compile/981117-1.f:8: internal error--insn does not satisfy its constraints:
+* (insn 31 83 32 (set (reg:SF 8 %st(0))
+*         (mult:SF (reg:SF 8 %st(0))
+*             (const_double:SF (mem/u:SF (symbol_ref/u:SI ("*.LC1")) 0) 0 0 1073643520))) 350 {strlensi-3} (nil)
+*     (nil))
+* ../../egcs/gcc/toplev.c:1390: Internal compiler error in function fatal_insn
+
+* Fixed sometime before 1998-11-21 -- don't know by which change.
+
+      SUBROUTINE SSPTRD
+      PARAMETER (HALF = 0.5 )
+      DO I = 1, N
+         CALL SSPMV(TAUI)
+         ALPHA = -HALF*TAUI
+         CALL SAXPY(ALPHA)
+      ENDDO
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/990115-1.f b/gcc/testsuite/gfortran.dg/g77/990115-1.f
new file mode 100644
index 000000000..b38d55adf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/990115-1.f
@@ -0,0 +1,12 @@
+c { dg-do compile }
+C Derived from lapack
+      SUBROUTINE ZGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
+     $                   WORK, RWORK, INFO )
+      COMPLEX(kind=8)         WORK( * )
+c     Following declaration added on transfer to gfortran testsuite.
+c     It is present in original lapack source
+      integer rank
+            DO 20 I = 1, RANK
+               WORK( ISMAX+I-1 ) = S2*WORK( ISMAX+I-1 )
+   20       CONTINUE
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/README b/gcc/testsuite/gfortran.dg/g77/README
new file mode 100644
index 000000000..a790ca86f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/README
@@ -0,0 +1,208 @@
+The g77 testsuite is being transferred to the gfortran testsuite.
+This file documents the status of each test case.
+
+	Y	Test has been transferred.
+        Y XFAIL This test has been transferred but fails
+	N	This feature will not be supported by gfortran.
+	F	This test fails with gfortran.  Not transferred (yet).
+	?	We looked at this case, but haven't decided.
+
+Directory g77.dg
+
+12632.f				Y
+20010216-1.f			Y
+7388.f				Y
+f77-edit-apostrophe-out.f	Y
+f77-edit-colon-out.f		Y
+f77-edit-h-out.f		Y
+f77-edit-i-in.f			Y
+f77-edit-i-out.f		Y
+f77-edit-s-out.f		Y  XFAIL PR 16434
+f77-edit-slash-out.f		Y
+f77-edit-t-in.f			Y  XFAIL PR 16436
+f77-edit-t-out.f		Y
+f77-edit-x-out.f		Y  XFAIL PR 16435
+fbackslash.f			?
+fcase-preserve.f		?
+ff90-1.f			?
+ffixed-form-1.f			Y
+ffixed-form-2.f			Y
+ffixed-line-length-0.f		Y
+ffixed-line-length-132.f	Y
+ffixed-line-length-7.f		F  PR 16465
+ffixed-line-length-72.f		Y
+ffixed-line-length-none.f	Y
+ffree-form-1.f			Y
+ffree-form-2.f			Y
+ffree-form-3.f			Y
+fno-backslash.f			?
+fno-f90-1.f			?
+fno-fixed-form-1.f		?
+fno-onetrip.f			?
+fno-typeless-boz.f		?
+fno-underscoring.f		Y
+fno-vxt-1.f			?
+fonetrip.f			?
+ftypeless-boz.f			?
+fugly-assumed.f			?
+funderscoring.f			Y
+fvxt-1.f			?
+pr3743-1.f			?
+pr3743-2.f			?
+pr3743-3.f			?
+pr3743-4.f			?
+pr5473.f			?
+pr9258.f			Y
+strlen0.f			Y
+
+
+Directory g77.dg/bprob
+g77-bprob-1.f
+
+
+Directory g77.dg/gcov
+gcov-1.f 
+
+Directory g77.f-torture/compile
+12002.f				Y
+13060.f				Y
+19990218-0.f			Y
+19990305-0.f			Y
+19990419-0.f			Y
+19990502-0.f			Y
+19990502-1.f			Y
+19990525-0.f			Y
+19990826-1.f			Y
+19990826-3.f			Y
+19990905-0.f			Y  XFAIL PR 16511
+19990905-2.f			Y
+20000412-1.f			Y
+20000511-1.f			Y
+20000511-2.f			Y
+20000518.f			Y
+20000601-1.f			Y
+20000601-2.f			Y
+20000629-1.f			Y
+20000630-2.f			Y
+20010115.f			Y
+20010321-1.f			Y
+20010426.f			Y
+20010519-1.f			Y  Add dg-warnings for ASSIGN
+20020307-1.f			Y
+20030115-1.f			Y  Add dg-warnings for ASSIGN
+20030326-1.f			Y
+8485.f				Y
+960317-1.f			Y
+970125-0.f			Y  Add dg-excess-errors. Investigate.later.
+970915-0.f			Y
+980310-1.f			Y
+980310-2.f			Y
+980310-3.f			Y
+980310-4.f			Y
+980310-6.f			Y
+980310-7.f			Y
+980310-8.f			Y
+980419-2.f			Y
+980424-0.f			Y
+980427-0.f			Y
+980519-2.f			Y  Modify slightly
+980729-0.f			Y
+981117-1.f			Y
+990115-1.f			Y  Declare variable RANK
+alpha1.f			Y  Work around PR 16508 and PR 16509
+toon_1.f			Y
+xformat.f			Y  Add dg-warning for extension
+cpp.F				Y
+cpp2.F				Y
+
+g77.f-torture/execute
+10197.f & 10197.x
+13037.f				Y
+1832.f				Y
+19981119-0.f			Y
+19990313-0.f			Y
+19990313-1.f			Y
+19990313-2.f			Y
+19990313-3.f			Y
+19990325-0.f			F Execution failure
+19990325-1.f			F Execution failure
+19990419-1.f			Y
+19990826-0.f			Y
+19990826-2.f			Y
+20000503-1.f			Y
+20001111.f			Y
+20001201.f & 20001201.x
+20010116.f			Y
+20010426.f renamed 20010426-1.f	Y 
+20010430.f			Y
+20010610.f			Y
+5122.f				- Assembler failure
+6177.f				Y
+6367.f & 6367.x
+947.f				Y
+970625-2.f			Y Add dg-warnings and declare variables
+970816-3.f			Y
+971102-1.f			Y
+980520-1.f			Y
+980628-0.f			Y
+980628-1.f			Y
+980628-10.f			Y
+980628-2.f			Y
+980628-3.f			Y
+980628-4.f & 980628-4.x
+980628-5.f & 980628-5.x
+980628-6.f & 980628-6.x
+980628-7.f			Y
+980628-8.f			Y
+980628-9.f			Y
+980701-0.f			Y
+980701-1.f			Y
+alpha2.f & alpha2.x
+auto0.f & auto0.x
+auto1.f & auto1.x
+cabs.f				Y
+claus.f				Y
+complex_1.f			Y
+cpp.F	(Renamed cpp3.F)	Y
+cpp2.F				- Compiler warnings
+dcomplex.f			Y
+dnrm2.f				Y Add dg-warning as required
+erfc.f				Y
+exp.f				  Compiler warnings and fails
+f90-intrinsic-bit.f             F 16581 Compile errors
+f90-intrinsic-mathematical.f	Y 
+f90-intrinsic-numeric.f		Y
+int8421.f			Y
+intrinsic-f2c-z.f		F Execution fail
+intrinsic-unix-bessel.f		Y
+intrinsic-unix-erf.f		Y
+intrinsic-vax-cd.f		F Execution fail
+intrinsic77.f	 		F PR 16580 Compiler ICE
+io0.f & io0.x
+io1.f & io1.x
+labug1.f			Y
+large_vec.f			Y
+le.f				Y
+select.f			  Lots of compiler warnings
+short.f				Y
+u77-test.f & u77-test.x
+
+
+Directory g77.f-torture/noncompile
+19981216-0.f			Y Accepted by gfortran
+19990218-1.f			Y g77 issued warning.
+19990826-4.f			?
+19990905-1.f			Y XFAIL 16520  gfortran ICE on invalid
+9263.f				Y
+970626-2.f			?
+980615-0.f                      Y
+980616-0.f			Y
+check0.f			Y
+select_no_compile.f		Y
+
+
+Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+
+Copying and distribution of this file, with or without modification,
+are permitted in any medium without royalty provided the copyright
+notice and this notice are preserved.
diff --git a/gcc/testsuite/gfortran.dg/g77/alpha1.f b/gcc/testsuite/gfortran.dg/g77/alpha1.f
new file mode 100644
index 000000000..68947692d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/alpha1.f
@@ -0,0 +1,27 @@
+c { dg-do compile }
+      REAL(kind=8) A,B,C
+      REAL(kind=4) RARRAY(19)
+      DATA RARRAY /19*-1/
+      INTEGER BOTTOM,RIGHT
+      INTEGER IARRAY(19)
+      DATA IARRAY /0,0,0,0,0,0,0,0,0,0,0,0,13,14,0,0,0,0,0/
+      EQUIVALENCE (RARRAY(13),BOTTOM),(RARRAY(14),RIGHT)
+C
+      IF(I.NE.0) call exit(1)
+C gcc: Internal compiler error: program f771 got fatal signal 11
+C  at this point!
+      END
+
+! previously g77.ftorture/compile/alpha1.f with following alpha1.x
+!
+!# This test fails compilation in cross-endian environments, for example as
+!# below, with a "sorry" message.
+!
+!if { [ishost "i\[34567\]86-*-*"] } {
+!    if { [istarget "mmix-knuth-mmixware"]
+! || [istarget "powerpc-*-*"] } {
+!    set torture_compile_xfail [istarget]
+!    }
+!}
+!
+!return 0
diff --git a/gcc/testsuite/gfortran.dg/g77/cabs.f b/gcc/testsuite/gfortran.dg/g77/cabs.f
new file mode 100644
index 000000000..998327b6e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/cabs.f
@@ -0,0 +1,16 @@
+c { dg-do run }
+c { dg-xfail-run-if "PR target/16292" { mips-sgi-irix6* } { -O0 } }
+      program cabs_1
+      complex      z0
+      real         r0
+      complex(kind=8)   z1
+      real(kind=8)       r1
+
+      z0 = cmplx(3.,4.)
+      r0 = cabs(z0)
+      if (r0 .ne. 5.) call abort
+
+      z1 = dcmplx(3.d0,4.d0)
+      r1 = zabs(z1)
+      if (r1 .ne. 5.d0) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/check0.f b/gcc/testsuite/gfortran.dg/g77/check0.f
new file mode 100644
index 000000000..f0a14f826
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/check0.f
@@ -0,0 +1,14 @@
+c { dg-do compile }
+c { dg-options "-std=legacy" }
+c
+CCC Abort fixed by:
+CCC1998-04-21  Jim Wilson  <wilson@cygnus.com>
+CCC
+CCC        * stmt.c (check_seenlabel): When search for line number note for
+CCC        warning, handle case where there is no such note.
+      logical l(10)
+      integer i(10)
+      goto (10,20),l ! { dg-error "Selection expression in computed GOTO" "" }
+      goto (10,20),i ! { dg-error "Selection expression in computed GOTO" "" }
+ 10   stop
+ 20   end
diff --git a/gcc/testsuite/gfortran.dg/g77/claus.f b/gcc/testsuite/gfortran.dg/g77/claus.f
new file mode 100644
index 000000000..391d1cb9a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/claus.f
@@ -0,0 +1,14 @@
+c { dg-do run }
+        PROGRAM TEST
+        REAL AB(3)
+        do i=1,3
+         AB(i)=i
+        enddo
+        k=1
+        n=2
+        ind=k-n+2
+        if (ind /= 1) call abort
+        if (ab(ind) /= 1) call abort
+        if (k-n+2 /= 1) call abort
+        if (ab(k-n+2) /= 1) call abort
+        END
diff --git a/gcc/testsuite/gfortran.dg/g77/complex_1.f b/gcc/testsuite/gfortran.dg/g77/complex_1.f
new file mode 100644
index 000000000..ddfbeff3f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/complex_1.f
@@ -0,0 +1,19 @@
+c { dg-do run }
+      program complex_1
+      complex      z0, z1, z2
+
+      z0 = cmplx(0.,.5)
+      z1 = 1./z0
+      if (z1 .ne. cmplx(0.,-2)) call abort
+
+      z0 = 10.*z0
+      if (z0 .ne. cmplx(0.,5.)) call abort
+
+      z2 = cmplx(1.,2.)
+      z1 = z0/z2
+      if (z1 .ne. cmplx(2.,1.)) call abort
+
+      z1 = z0*z2
+      if (z1 .ne. cmplx(-10.,5.)) call abort
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/g77/cpp.F b/gcc/testsuite/gfortran.dg/g77/cpp.F
new file mode 100644
index 000000000..42c4735c9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/cpp.F
@@ -0,0 +1,10 @@
+c { dg-do compile }
+C When run through the C preprocessor, the indentation of the
+C CONTINUE line must not be mangled.
+      subroutine aap(a, n)
+      dimension a(n)
+      do 10 i = 1, n
+         a(i) = i
+ 10   continue
+      print *, a(1)
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/cpp2.F b/gcc/testsuite/gfortran.dg/g77/cpp2.F
new file mode 100644
index 000000000..a1ee05afd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/cpp2.F
@@ -0,0 +1,8 @@
+c { dg-do compile }
+C The preprocessor must not introduce a newline after
+C the "a" when ARGUMENTS is expanded.
+
+#define ARGUMENTS a\
+
+      subroutine yada (ARGUMENTS)
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/cpp3.F b/gcc/testsuite/gfortran.dg/g77/cpp3.F
new file mode 100644
index 000000000..ab25b5329
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/cpp3.F
@@ -0,0 +1,8 @@
+c { dg-do run }
+c { dg-options "-std=legacy" }
+c
+!  Some versions of cpp will delete "//'World' as a C++ comment.
+      character*40    title
+      title = 'Hello '//'World'
+      if (title .ne. 'Hello World') call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/cpp4.F b/gcc/testsuite/gfortran.dg/g77/cpp4.F
new file mode 100644
index 000000000..bc14e0469
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/cpp4.F
@@ -0,0 +1,12 @@
+c { dg-do run }
+C The preprocessor must not mangle Hollerith constants
+C which contain apostrophes.
+      integer i
+      character(4) j
+      data i /4hbla'/
+      write (j, '(4a)') i
+      if (j .ne. "bla'") call abort
+      end
+
+      ! { dg-warning "Hollerith constant" "const" { target *-*-* } 6 }
+      ! { dg-warning "Conversion" "conversion" { target *-*-* } 6 }
diff --git a/gcc/testsuite/gfortran.dg/g77/cpp5.F b/gcc/testsuite/gfortran.dg/g77/cpp5.F
new file mode 100644
index 000000000..9b8d15bd7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/cpp5.F
@@ -0,0 +1,4 @@
+        ! { dg-do run }
+#include "cpp5.h"
+        IF (FOO().NE.1) CALL ABORT ()
+        END
diff --git a/gcc/testsuite/gfortran.dg/g77/cpp5.h b/gcc/testsuite/gfortran.dg/g77/cpp5.h
new file mode 100644
index 000000000..bb6d1927c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/cpp5.h
@@ -0,0 +1,3 @@
+        FUNCTION FOO()
+#include "cpp5inc.h"
+        END FUNCTION
diff --git a/gcc/testsuite/gfortran.dg/g77/cpp5inc.h b/gcc/testsuite/gfortran.dg/g77/cpp5inc.h
new file mode 100644
index 000000000..9a2a15885
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/cpp5inc.h
@@ -0,0 +1 @@
+        FOO = 1
diff --git a/gcc/testsuite/gfortran.dg/g77/cpp6.f b/gcc/testsuite/gfortran.dg/g77/cpp6.f
new file mode 100644
index 000000000..4160cfea1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/cpp6.f
@@ -0,0 +1,20 @@
+# 1 "test.F"
+# 1 "<built-in>"
+# 1 "<command line>"
+# 1 "test.F"
+! { dg-do compile }
+
+# 1 "A234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890" 1
+
+# 1 "B234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890" 1
+
+# 1 "C234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890" 1
+
+# 1 "D234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890" 1
+       PARAMETER (I=1)
+
+# 2 "C234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890" 2
+# 2 "B234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890" 2
+# 2 "A234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890" 2
+# 3 "test.F" 2
+       END
diff --git a/gcc/testsuite/gfortran.dg/g77/dcomplex.f b/gcc/testsuite/gfortran.dg/g77/dcomplex.f
new file mode 100644
index 000000000..f25e7c570
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/dcomplex.f
@@ -0,0 +1,19 @@
+c { dg-do run }
+      program foo
+      complex(kind=8)      z0, z1, z2
+
+      z0 = dcmplx(0.,.5)
+      z1 = 1./z0
+      if (z1 .ne. dcmplx(0.,-2)) call abort
+
+      z0 = 10.*z0
+      if (z0 .ne. dcmplx(0.,5.)) call abort
+
+      z2 = cmplx(1.,2.)
+      z1 = z0/z2
+      if (z1 .ne. dcmplx(2.,1.)) call abort
+
+      z1 = z0*z2
+      if (z1 .ne. dcmplx(-10.,5.)) call abort
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/g77/dnrm2.f b/gcc/testsuite/gfortran.dg/g77/dnrm2.f
new file mode 100644
index 000000000..dbf9f0d05
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/dnrm2.f
@@ -0,0 +1,76 @@
+c { dg-do run }
+c { dg-options "-fno-bounds-check" }
+CCC g77 0.5.21 `Actual Bugs':
+CCC   * A code-generation bug afflicts Intel x86 targets when `-O2' is
+CCC     specified compiling, for example, an old version of the `DNRM2'
+CCC     routine.  The x87 coprocessor stack is being somewhat mismanaged
+CCC     in cases where assigned `GOTO' and `ASSIGN' are involved.
+CCC
+CCC     Version 0.5.21 of `g77' contains an initial effort to fix the
+CCC     problem, but this effort is incomplete, and a more complete fix is
+CCC     planned for the next release.
+
+C     Currently this test fails with (at least) `-O2 -funroll-loops' on
+C     i586-unknown-linux-gnulibc1.
+
+C     (This is actually an obsolete version of dnrm2 -- consult the
+c     current Netlib BLAS.)
+
+      integer i
+      double precision a(1:100), dnrm2
+      do i=1,100
+         a(i)=0.D0
+      enddo
+      if (dnrm2(100,a,1) .ne. 0.0) call abort
+      end
+
+      double precision function dnrm2 ( n, dx, incx)
+      integer i, incx, ix, j, n, next
+      double precision   dx(1), cutlo, cuthi, hitest, sum, xmax,zero,one
+      data   zero, one /0.0d0, 1.0d0/
+      data cutlo, cuthi / 8.232d-11,  1.304d19 /
+      j = 0
+      if(n .gt. 0 .and. incx.gt.0) go to 10
+         dnrm2  = zero
+         go to 300
+   10 assign 30 to next ! { dg-warning "ASSIGN" "" }
+      sum = zero
+      i = 1
+      ix = 1
+   20    go to next,(30, 50, 70, 110) ! { dg-warning "Assigned GOTO" "" }
+   30 if( dabs(dx(i)) .gt. cutlo) go to 85
+      assign 50 to next ! { dg-warning "ASSIGN" "" }
+      xmax = zero
+   50 if( dx(i) .eq. zero) go to 200
+      if( dabs(dx(i)) .gt. cutlo) go to 85
+      assign 70 to next ! { dg-warning "ASSIGN" "" }
+      go to 105
+  100 continue
+      ix = j
+      assign 110 to next ! { dg-warning "ASSIGN" "" }
+      sum = (sum / dx(i)) / dx(i)
+  105 xmax = dabs(dx(i))
+      go to 115
+   70 if( dabs(dx(i)) .gt. cutlo ) go to 75
+  110 if( dabs(dx(i)) .le. xmax ) go to 115
+         sum = one + sum * (xmax / dx(i))**2
+         xmax = dabs(dx(i))
+         go to 200
+  115 sum = sum + (dx(i)/xmax)**2
+      go to 200
+   75 sum = (sum * xmax) * xmax
+   85 hitest = cuthi/float( n )
+      do 95 j = ix,n
+      if(dabs(dx(i)) .ge. hitest) go to 100
+         sum = sum + dx(i)**2
+         i = i + incx
+   95 continue
+      dnrm2 = dsqrt( sum )
+      go to 300
+  200 continue
+      ix = ix + 1
+      i = i + incx
+      if( ix .le. n ) go to 20
+      dnrm2 = xmax * dsqrt(sum)
+  300 continue
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/erfc.f b/gcc/testsuite/gfortran.dg/g77/erfc.f
new file mode 100644
index 000000000..9897162af
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/erfc.f
@@ -0,0 +1,39 @@
+c { dg-do run }
+c============================================== test.f
+      real x, y
+      real(kind=8) x1, y1
+      x=0.
+      y = erfc(x)
+      if (y .ne. 1.) call abort
+
+      x=1.1
+      y = erfc(x)
+      if (abs(y - .1197949) .ge. 1.e-6) call abort
+
+c modified from x=10, y .gt. 1.5e-44 to avoid lack of -mieee on Alphas.
+      x=8
+      y = erfc(x)
+      if (y .gt. 1.2e-28) call abort
+
+      x1=0.
+      y1 = erfc(x1)
+      if (y1 .ne. 1.) call abort
+
+      x1=1.1d0
+      y1 = erfc(x1)
+      if (abs(y1 - .1197949d0) .ge. 1.d-6) call abort
+
+      x1=10
+      y1 = erfc(x1)
+      if (y1 .gt. 1.5d-44) call abort
+      end
+c=================================================
+!output:
+!  0.  1.875
+!  1.10000002  1.48958981
+!  10.  5.00220949E-06
+!
+!The values should be:
+!erfc(0)=1
+!erfc(1.1)= 0.1197949
+!erfc(10)<1.543115467311259E-044
diff --git a/gcc/testsuite/gfortran.dg/g77/f77-edit-apostrophe-out.f b/gcc/testsuite/gfortran.dg/g77/f77-edit-apostrophe-out.f
new file mode 100644
index 000000000..aa51bc05c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/f77-edit-apostrophe-out.f
@@ -0,0 +1,21 @@
+C Test Fortran 77 apostrophe edit descriptor 
+C      (ANSI X3.9-1978 Section 13.5.1)
+C
+C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+C
+C { dg-do run }
+C { dg-output "^" }
+ 10   format('abcde') 
+ 20   format('and an apostrophe -''-')
+ 30   format('''a leading apostrophe')
+ 40   format('a trailing apostrophe''')
+ 50   format('''and all of the above -''-''')
+
+      write(*,10)        ! { dg-output "abcde(\n|\r\n|\r)" } 
+      write(*,20)        ! { dg-output "and an apostrophe -'-(\n|\r\n|\r)" }
+      write(*,30)        ! { dg-output "'a leading apostrophe(\n|\r\n|\r)" }
+      write(*,40)        ! { dg-output "a trailing apostrophe'(\n|\r\n|\r)" }
+      write(*,50)        ! { dg-output "'and all of the above -'-'(\n|\r\n|\r)" }
+
+C { dg-output "\$" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/f77-edit-colon-out.f b/gcc/testsuite/gfortran.dg/g77/f77-edit-colon-out.f
new file mode 100644
index 000000000..4feef755f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/f77-edit-colon-out.f
@@ -0,0 +1,9 @@
+C Test Fortran 77 colon edit descriptor 
+C      (ANSI X3.9-1978 Section 13.5.5)
+C
+C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+C
+C { dg-do run }
+C { dg-output "^123(\n|\r\n|\r)45(\n|\r\n|\r)\$" }
+      write(*,'((3(I1:)))')  (I,I=1,5)
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/f77-edit-h-out.f b/gcc/testsuite/gfortran.dg/g77/f77-edit-h-out.f
new file mode 100644
index 000000000..78e6f017b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/f77-edit-h-out.f
@@ -0,0 +1,14 @@
+C Test Fortran 77 H edit descriptor
+C      (ANSI X3.9-1978 Section 13.5.2)
+C
+C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+C
+C { dg-do run }
+C { dg-output "^" }
+ 10   format(1H1)
+ 20   format(6H     6)
+      write(*,10)        ! { dg-output "1(\n|\r\n|\r)" }
+      write(*,20)        ! { dg-output "     6(\n|\r\n|\r)" }
+      write(*,'(16H''apostrophe'' fun)') ! { dg-output "'apostrophe' fun(\n|\r\n|\r)" }
+C { dg-output "\$" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/f77-edit-i-in.f b/gcc/testsuite/gfortran.dg/g77/f77-edit-i-in.f
new file mode 100644
index 000000000..0369b79db
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/f77-edit-i-in.f
@@ -0,0 +1,24 @@
+C Test Fortran 77 I edit descriptor for input
+C      (ANSI X3.9-1978 Section 13.5.9.1)
+C
+C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+C
+C { dg-do run }
+C { dg-options "-std=legacy" }
+C
+
+      integer i,j
+      character*10 buf
+
+      write(buf,'(A)') '1  -1'
+
+      read(buf,'(I1)') i
+      if ( i.ne.1 ) call abort()
+
+      read(buf,'(1X,I1)') i
+      if ( i.ne.0 ) call abort()
+
+      read(buf,'(1X,I1,1X,I2)') i,j
+      if ( i.ne.0 .and. j.ne.-1 ) call abort()
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/f77-edit-i-out.f b/gcc/testsuite/gfortran.dg/g77/f77-edit-i-out.f
new file mode 100644
index 000000000..9887704c7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/f77-edit-i-out.f
@@ -0,0 +1,26 @@
+C Test Fortran 77 I edit descriptor for output
+C      (ANSI X3.9-1978 Section 13.5.9.1)
+C
+C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+C
+C { dg-do run }
+C { dg-output "^" }
+
+      write(*,'(I1)')    1  ! { dg-output "1(\n|\r\n|\r)" }
+      write(*,'(I1)')   -1  ! { dg-output "\\*(\n|\r\n|\r)" }
+      write(*,'(I2)')    2  ! { dg-output " 2(\n|\r\n|\r)" }
+      write(*,'(I2)')   -2  ! { dg-output "-2(\n|\r\n|\r)" }
+      write(*,'(I3)')    3  ! { dg-output "  3(\n|\r\n|\r)" }
+      write(*,'(I3)')   -3  ! { dg-output " -3(\n|\r\n|\r)" }
+
+      write(*,'(I2.0)')  0  ! { dg-output "  (\n|\r\n|\r)" }
+      write(*,'(I1.1)')  4  ! { dg-output "4(\n|\r\n|\r)" }
+      write(*,'(I1.1)') -4  ! { dg-output "\\*(\n|\r\n|\r)" }
+      write(*,'(I2.1)')  5  ! { dg-output " 5(\n|\r\n|\r)" }
+      write(*,'(I2.1)') -5  ! { dg-output "-5(\n|\r\n|\r)" }
+      write(*,'(I2.2)')  6  ! { dg-output "06(\n|\r\n|\r)" }
+      write(*,'(I2.2)') -6  ! { dg-output "\\*\\*(\n|\r\n|\r)" }
+      write(*,'(I3.2)')  7  ! { dg-output " 07(\n|\r\n|\r)" }
+      write(*,'(I3.2)') -7  ! { dg-output "-07(\n|\r\n|\r)" }
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/f77-edit-s-out.f b/gcc/testsuite/gfortran.dg/g77/f77-edit-s-out.f
new file mode 100644
index 000000000..89a8df2ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/f77-edit-s-out.f
@@ -0,0 +1,20 @@
+C Test Fortran 77 S, SS and SP edit descriptors 
+C      (ANSI X3.9-1978 Section 13.5.6)
+C
+C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+C
+C { dg-do run }
+C ( dg-output "^" }
+ 10   format(SP,I3,1X,SS,I3)
+ 20   format(SP,I3,1X,SS,I3,SP,I3)
+ 30   format(SP,I3,1X,SS,I3,S,I3)
+ 40   format(SP,I3)
+ 50   format(SP,I2)
+      write(*,10) 10, 20      ! { dg-output "\\+10  20(\n|\r\n|\r)" }
+      write(*,20) 10, 20, 30  ! { dg-output "\\+10  20\\+30(\n|\r\n|\r)" }
+      write(*,30) 10, 20, 30  ! { dg-output "\\+10  20 30(\n|\r\n|\r)" } 
+      write(*,40) 0           ! { dg-output " \\+0(\n|\r\n|\r)" }
+C 15.5.9 - Note 5: When SP editing is in effect, the plus sign is not optional
+      write(*,50) 11          ! { dg-output "\\*\\*(\n|\r\n|\r)" }
+C { dg-output "\$" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/f77-edit-slash-out.f b/gcc/testsuite/gfortran.dg/g77/f77-edit-slash-out.f
new file mode 100644
index 000000000..6cc9a8842
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/f77-edit-slash-out.f
@@ -0,0 +1,9 @@
+C Test Fortran 77 colon slash descriptor 
+C      (ANSI X3.9-1978 Section 13.5.4)
+C
+C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+C
+C { dg-do run }
+C { dg-output "^123(\n|\r\n|\r)45(\n|\r\n|\r)\$" }
+      write(*,'(3(I1)/2(I1))')  (I,I=1,5)
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/f77-edit-t-in.f b/gcc/testsuite/gfortran.dg/g77/f77-edit-t-in.f
new file mode 100644
index 000000000..524b18e31
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/f77-edit-t-in.f
@@ -0,0 +1,33 @@
+C Test Fortran 77 T edit descriptor for input
+C      (ANSI X3.9-1978 Section 13.5.3.2)
+C
+C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+C
+C { dg-do run }
+C { dg-options "-std=legacy" }
+C
+      integer i,j
+      real a,b,c,d,e
+      character*32 in
+
+      in = '1234   8'
+      read(in,'(T3,I1)') i
+      if ( i.ne.3 )                   call abort()
+      read(in,'(5X,TL4,I2)') i
+      if ( i.ne.23 )                  call abort()
+      read(in,'(3X,I1,TR3,I1)') i,j
+      if ( i.ne.4 )                  call abort()
+      if ( j.ne.8 )                  call abort()
+
+      in = '   1.5  -12.62  348.75  1.0E-6'
+ 100  format(F6.0,TL6,I4,1X,I1,8X,I5,F3.0,T10,F5.0,T17,F6.0,TR2,F6.0)
+      read(in,100) a,i,j,k,b,c,d,e
+      if ( abs(a-1.5).gt.1.0e-5 )     call abort()
+      if ( i.ne.1 )                   call abort()
+      if ( j.ne.5 )                   call abort()
+      if ( k.ne.348 )                 call abort()
+      if ( abs(b-0.75).gt.1.0e-5 )    call abort()
+      if ( abs(c-12.62).gt.1.0e-5 )   call abort()
+      if ( abs(d-348.75).gt.1.0e-4 )  call abort()
+      if ( abs(e-1.0e-6).gt.1.0e-11 ) call abort()
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/f77-edit-t-out.f b/gcc/testsuite/gfortran.dg/g77/f77-edit-t-out.f
new file mode 100644
index 000000000..8e411888f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/f77-edit-t-out.f
@@ -0,0 +1,12 @@
+C Test Fortran 77 T edit descriptor 
+C      (ANSI X3.9-1978 Section 13.5.3.2)
+C
+C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+C
+C { dg-do run }
+C ( dg-output "^" }
+      write(*,'(I4,T8,I1)')     1234,8 ! { dg-output "1234   8(\n|\r\n|\r)" }
+      write(*,'(I4,TR3,I1)')    1234,8 ! { dg-output "1234   8(\n|\r\n|\r)" }
+      write(*,'(I4,5X,TL2,I1)') 1234,8 ! { dg-output "1234   8(\n|\r\n|\r)" }
+C ( dg-output "\$" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/f77-edit-x-out.f b/gcc/testsuite/gfortran.dg/g77/f77-edit-x-out.f
new file mode 100644
index 000000000..9d196331d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/f77-edit-x-out.f
@@ -0,0 +1,12 @@
+C Test Fortran 77 X descriptor 
+C      (ANSI X3.9-1978 Section 13.5.3.2)
+C
+C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+C
+C { dg-do run } 
+C ( dg-output "^" }
+      write(*,'(I1,1X,I1,2X,I1)') 1,2,3    ! { dg-output "1 2  3(\n|\r\n|\r)" }
+C Section 13.5.3 explains why there are no trailing blanks
+      write(*,'(I1,1X,I1,2X,I1,3X)') 1,2,3 ! { dg-output "1 2  3(\n|\r\n|\r)" }
+C { dg-output "\$" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/f90-intrinsic-bit.f b/gcc/testsuite/gfortran.dg/g77/f90-intrinsic-bit.f
new file mode 100644
index 000000000..01436d197
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/f90-intrinsic-bit.f
@@ -0,0 +1,468 @@
+c { dg-do run }
+c  f90-intrinsic-bit.f
+c
+c Test Fortran 90 
+c  * intrinsic bit manipulation functions - Section 13.10.10
+c  * bitcopy subroutine - Section 13.9.3 
+c David Billinghurst <David.Billinghurst@riotinto.com>
+c
+c Notes: 
+c  * g77 only supports scalar arguments
+c  * third argument of ISHFTC is not optional in g77
+
+      logical fail
+      integer   i, i2, ia, i3
+      integer(kind=2) j, j2, j3, ja
+      integer(kind=1) k, k2, k3, ka
+      integer(kind=8) m, m2, m3, ma
+
+      common /flags/ fail
+      fail = .false.
+
+c     BIT_SIZE - Section 13.13.16
+c     Determine BIT_SIZE by counting the bits 
+      ia = 0
+      i = 0
+      i = not(i)
+      do while ( (i.ne.0) .and. (ia.lt.127) ) 
+         ia = ia + 1
+         i = ishft(i,-1)
+      end do
+      call c_i(BIT_SIZE(i),ia,'BIT_SIZE(integer)')
+      ja = 0
+      j = 0
+      j = not(j)
+      do while  ( (j.ne.0) .and. (ja.lt.127) ) 
+         ja = ja + 1
+         j = ishft(j,-1)
+      end do
+      call c_i2(BIT_SIZE(j),ja,'BIT_SIZE(integer(2))')
+      ka = 0
+      k = 0
+      k = not(k)
+      do while ( (k.ne.0) .and. (ka.lt.127) )
+         ka = ka + 1
+         k = ishft(k,-1)
+      end do
+      call c_i1(BIT_SIZE(k),ka,'BIT_SIZE(integer(1))')
+      ma = 0
+      m = 0
+      m = not(m)
+      do while ( (m.ne.0) .and. (ma.lt.127) )
+         ma = ma + 1
+         m = ishft(m,-1)
+      end do
+      call c_i8(BIT_SIZE(m),ma,'BIT_SIZE(integer(8))')
+
+c     BTEST  - Section 13.13.17
+      j  = 7
+      j2 = 3
+      k  = 7
+      k2 = 3
+      m  = 7
+      m2 = 3
+      call c_l(BTEST(7,3),.true.,'BTEST(integer,integer)')
+      call c_l(BTEST(7,j2),.true.,'BTEST(integer,integer(2))')
+      call c_l(BTEST(7,k2),.true.,'BTEST(integer,integer(1))')
+      call c_l(BTEST(7,m2),.true.,'BTEST(integer,integer(8))')
+      call c_l(BTEST(j,3),.true.,'BTEST(integer(2),integer)')
+      call c_l(BTEST(j,j2),.true.,'BTEST(integer(2),integer(2))')
+      call c_l(BTEST(j,k2),.true.,'BTEST(integer(2),integer(1))')
+      call c_l(BTEST(j,m2),.true.,'BTEST(integer(2),integer(8))')
+      call c_l(BTEST(k,3),.true.,'BTEST(integer(1),integer)')
+      call c_l(BTEST(k,j2),.true.,'BTEST(integer(1),integer(2))')
+      call c_l(BTEST(k,k2),.true.,'BTEST(integer(1),integer(1))')
+      call c_l(BTEST(k,m2),.true.,'BTEST(integer(1),integer(8))')
+      call c_l(BTEST(m,3),.true.,'BTEST(integer(8),integer)')
+      call c_l(BTEST(m,j2),.true.,'BTEST(integer(8),integer(2))')
+      call c_l(BTEST(m,k2),.true.,'BTEST(integer(8),integer(1))')
+      call c_l(BTEST(m,m2),.true.,'BTEST(integer(8),integer(8))')
+ 
+c     IAND   - Section 13.13.40
+      j  = 3
+      j2 = 1
+      ja = 1
+      k  = 3
+      k2 = 1
+      ka = 1
+      m  = 3
+      m2 = 1
+      ma = 1
+      call c_i(IAND(3,1),1,'IAND(integer,integer)')
+      call c_i2(IAND(j,j2),ja,'IAND(integer(2),integer(2)')
+      call c_i1(IAND(k,k2),ka,'IAND(integer(1),integer(1))')
+      call c_i8(IAND(m,m2),ma,'IAND(integer(8),integer(8))')
+
+
+c     IBCLR  - Section 13.13.41
+      j  = 14
+      j2 = 1
+      ja = 12
+      k  = 14
+      k2 = 1
+      ka = 12
+      m  = 14
+      m2 = 1
+      ma = 12
+      call c_i(IBCLR(14,1),12,'IBCLR(integer,integer)')
+      call c_i(IBCLR(14,j2),12,'IBCLR(integer,integer(2))')
+      call c_i(IBCLR(14,k2),12,'IBCLR(integer,integer(1))')
+      call c_i(IBCLR(14,m2),12,'IBCLR(integer,integer(8))')
+      call c_i2(IBCLR(j,1),ja,'IBCLR(integer(2),integer)')
+      call c_i2(IBCLR(j,j2),ja,'IBCLR(integer(2),integer(2))')
+      call c_i2(IBCLR(j,k2),ja,'IBCLR(integer(2),integer(1))')
+      call c_i2(IBCLR(j,m2),ja,'IBCLR(integer(2),integer(8))')
+      call c_i1(IBCLR(k,1),ka,'IBCLR(integer(1),integer)')
+      call c_i1(IBCLR(k,j2),ka,'IBCLR(integer(1),integer(2))')
+      call c_i1(IBCLR(k,k2),ka,'IBCLR(integer(1),integer(1))')
+      call c_i1(IBCLR(k,m2),ka,'IBCLR(integer(1),integer(8))')
+      call c_i8(IBCLR(m,1),ma,'IBCLR(integer(8),integer)')
+      call c_i8(IBCLR(m,j2),ma,'IBCLR(integer(8),integer(2))')
+      call c_i8(IBCLR(m,k2),ma,'IBCLR(integer(8),integer(1))')
+      call c_i8(IBCLR(m,m2),ma,'IBCLR(integer(8),integer(8))')
+
+c     IBSET  - Section 13.13.43
+      j  = 12
+      j2 = 1
+      ja = 14
+      k  = 12
+      k2 = 1
+      ka = 14
+      m  = 12
+      m2 = 1
+      ma = 14
+      call c_i(IBSET(12,1),14,'IBSET(integer,integer)')
+      call c_i(IBSET(12,j2),14,'IBSET(integer,integer(2))')
+      call c_i(IBSET(12,k2),14,'IBSET(integer,integer(1))')
+      call c_i(IBSET(12,m2),14,'IBSET(integer,integer(8))')
+      call c_i2(IBSET(j,1),ja,'IBSET(integer(2),integer)')
+      call c_i2(IBSET(j,j2),ja,'IBSET(integer(2),integer(2))')
+      call c_i2(IBSET(j,k2),ja,'IBSET(integer(2),integer(1))')
+      call c_i2(IBSET(j,m2),ja,'IBSET(integer(2),integer(8))')
+      call c_i1(IBSET(k,1),ka,'IBSET(integer(1),integer)')
+      call c_i1(IBSET(k,j2),ka,'IBSET(integer(1),integer(2))')
+      call c_i1(IBSET(k,k2),ka,'IBSET(integer(1),integer(1))')
+      call c_i1(IBSET(k,m2),ka,'IBSET(integer(1),integer(8))')
+      call c_i8(IBSET(m,1),ma,'IBSET(integer(8),integer)')
+      call c_i8(IBSET(m,j2),ma,'IBSET(integer(8),integer(2))')
+      call c_i8(IBSET(m,k2),ma,'IBSET(integer(8),integer(1))')
+      call c_i8(IBSET(m,m2),ma,'IBSET(integer(8),integer(8))')
+
+c     IEOR   - Section 13.13.45
+      j  = 3
+      j2 = 1
+      ja = 2
+      k  = 3
+      k2 = 1
+      ka = 2
+      m  = 3
+      m2 = 1
+      ma = 2
+      call c_i(IEOR(3,1),2,'IEOR(integer,integer)')
+      call c_i2(IEOR(j,j2),ja,'IEOR(integer(2),integer(2))')
+      call c_i1(IEOR(k,k2),ka,'IEOR(integer(1),integer(1))')
+      call c_i8(IEOR(m,m2),ma,'IEOR(integer(8),integer(8))')
+
+c     ISHFT  - Section 13.13.49
+      i  = 3
+      i2 = 1
+      i3 = 0
+      ia = 6
+      j  = 3
+      j2 = 1
+      j3 = 0
+      ja = 6
+      k  = 3
+      k2 = 1
+      k3 = 0
+      ka = 6
+      m  = 3
+      m2 = 1
+      m3 = 0
+      ma = 6
+      call c_i(ISHFT(i,i2),ia,'ISHFT(integer,integer)')
+      call c_i(ISHFT(i,BIT_SIZE(i)),i3,'ISHFT(integer,integer) 2')
+      call c_i(ISHFT(i,-BIT_SIZE(i)),i3,'ISHFT(integer,integer) 3')
+      call c_i(ISHFT(i,0),i,'ISHFT(integer,integer) 4')
+      call c_i2(ISHFT(j,j2),ja,'ISHFT(integer(2),integer(2))')
+      call c_i2(ISHFT(j,BIT_SIZE(j)),j3,
+     $     'ISHFT(integer(2),integer(2)) 2')
+      call c_i2(ISHFT(j,-BIT_SIZE(j)),j3,
+     $     'ISHFT(integer(2),integer(2)) 3')
+      call c_i2(ISHFT(j,0),j,'ISHFT(integer(2),integer(2)) 4')
+      call c_i1(ISHFT(k,k2),ka,'ISHFT(integer(1),integer(1))')
+      call c_i1(ISHFT(k,BIT_SIZE(k)),k3,
+     $     'ISHFT(integer(1),integer(1)) 2')
+      call c_i1(ISHFT(k,-BIT_SIZE(k)),k3,
+     $     'ISHFT(integer(1),integer(1)) 3')
+      call c_i1(ISHFT(k,0),k,'ISHFT(integer(1),integer(1)) 4')
+      call c_i8(ISHFT(m,m2),ma,'ISHFT(integer(8),integer(8))')
+      call c_i8(ISHFT(m,BIT_SIZE(m)),m3,
+     $     'ISHFT(integer(8),integer(8)) 2')
+      call c_i8(ISHFT(m,-BIT_SIZE(m)),m3,
+     $     'ISHFT(integer(8),integer(8)) 3')
+      call c_i8(ISHFT(m,0),m,'ISHFT(integer(8),integer(8)) 4')
+
+c     ISHFTC - Section 13.13.50
+c     The third argument is not optional in g77
+      i  = 3
+      i2 = 2
+      i3 = 3
+      ia = 5
+      j  = 3
+      j2 = 2
+      j3 = 3
+      ja = 5
+      k  = 3
+      k2 = 2
+      k3 = 3
+      ka = 5
+      m2 = 2
+      m3 = 3
+      ma = 5
+c     test all the combinations of arguments
+      call c_i(ISHFTC(i,i2,i3),5,'ISHFTC(integer,integer,integer)')
+      call c_i(ISHFTC(i,i2,j3),5,'ISHFTC(integer,integer,integer(2))')
+      call c_i(ISHFTC(i,i2,k3),5,'ISHFTC(integer,integer,integer(1))')
+      call c_i(ISHFTC(i,i2,m3),5,'ISHFTC(integer,integer,integer(8))')
+      call c_i(ISHFTC(i,j2,i3),5,'ISHFTC(integer,integer(2),integer)')
+      call c_i(ISHFTC(i,j2,j3),5,
+     &  'ISHFTC(integer,integer(2),integer(2))')
+      call c_i(ISHFTC(i,j2,k3),5,
+     &  'ISHFTC(integer,integer(2),integer(1))')
+      call c_i(ISHFTC(i,j2,m3),5,
+     &  'ISHFTC(integer,integer(2),integer(8))')
+      call c_i(ISHFTC(i,k2,i3),5,'ISHFTC(integer,integer(1),integer)')
+      call c_i(ISHFTC(i,k2,j3),5,
+     &  'ISHFTC(integer,integer(1),integer(2))')
+      call c_i(ISHFTC(i,k2,k3),5,
+     &  'ISHFTC(integer,integer(1),integer(1))')
+      call c_i(ISHFTC(i,k2,m3),5,
+     &  'ISHFTC(integer,integer(1),integer(8))')
+      call c_i(ISHFTC(i,m2,i3),5,'ISHFTC(integer,integer(8),integer)')
+      call c_i(ISHFTC(i,m2,j3),5,
+     &  'ISHFTC(integer,integer(8),integer(2))')
+      call c_i(ISHFTC(i,m2,k3),5,
+     &  'ISHFTC(integer,integer(8),integer(1))')
+      call c_i(ISHFTC(i,m2,m3),5,
+     &  'ISHFTC(integer,integer(8),integer(8))')
+
+      call c_i2(ISHFTC(j,i2,i3),ja,'ISHFTC(integer(2),integer,integer)')
+      call c_i2(ISHFTC(j,i2,j3),ja,
+     $     'ISHFTC(integer(2),integer,integer(2))')
+      call c_i2(ISHFTC(j,i2,k3),ja,
+     $     'ISHFTC(integer(2),integer,integer(1))')
+      call c_i2(ISHFTC(j,i2,m3),ja,
+     $     'ISHFTC(integer(2),integer,integer(8))')
+      call c_i2(ISHFTC(j,j2,i3),ja,
+     $     'ISHFTC(integer(2),integer(2),integer)')
+      call c_i2(ISHFTC(j,j2,j3),ja,
+     $     'ISHFTC(integer(2),integer(2),integer(2))')
+      call c_i2(ISHFTC(j,j2,k3),ja,
+     $     'ISHFTC(integer(2),integer(2),integer(1))')
+      call c_i2(ISHFTC(j,j2,m3),ja,
+     $     'ISHFTC(integer(2),integer(2),integer(8))')
+      call c_i2(ISHFTC(j,k2,i3),ja,
+     $     'ISHFTC(integer(2),integer(1),integer)')
+      call c_i2(ISHFTC(j,k2,j3),ja,
+     $     'ISHFTC(integer(2),integer(1),integer(2))')
+      call c_i2(ISHFTC(j,k2,k3),ja,
+     $     'ISHFTC(integer(2),integer(1),integer(1))')
+      call c_i2(ISHFTC(j,k2,m3),ja,
+     $     'ISHFTC(integer(2),integer(1),integer(8))')
+      call c_i2(ISHFTC(j,m2,i3),ja,
+     $     'ISHFTC(integer(2),integer(8),integer)')
+      call c_i2(ISHFTC(j,m2,j3),ja,
+     $     'ISHFTC(integer(2),integer(8),integer(2))')
+      call c_i2(ISHFTC(j,m2,k3),ja,
+     $     'ISHFTC(integer(2),integer(8),integer(1))')
+      call c_i2(ISHFTC(j,m2,m3),ja,
+     $     'ISHFTC(integer(2),integer(8),integer(8))')
+
+      call c_i1(ISHFTC(k,i2,i3),ka,'ISHFTC(integer(1),integer,integer)')
+      call c_i1(ISHFTC(k,i2,j3),ka,
+     $     'ISHFTC(integer(1),integer,integer(2))')
+      call c_i1(ISHFTC(k,i2,k3),ka,
+     $     'ISHFTC(integer(1),integer,integer(1))')
+      call c_i1(ISHFTC(k,i2,m3),ka,
+     $     'ISHFTC(integer(1),integer,integer(8))')
+      call c_i1(ISHFTC(k,j2,i3),ka,
+     $     'ISHFTC(integer(1),integer(2),integer)')
+      call c_i1(ISHFTC(k,j2,j3),ka,
+     $     'ISHFTC(integer(1),integer(2),integer(2))')
+      call c_i1(ISHFTC(k,j2,k3),ka,
+     $     'ISHFTC(integer(1),integer(2),integer(1))')
+      call c_i1(ISHFTC(k,j2,m3),ka,
+     $     'ISHFTC(integer(1),integer(2),integer(8))')
+      call c_i1(ISHFTC(k,k2,i3),ka,
+     $     'ISHFTC(integer(1),integer(1),integer)')
+      call c_i1(ISHFTC(k,k2,j3),ka,
+     $     'ISHFTC(integer(1),integer(1),integer(2))')
+      call c_i1(ISHFTC(k,k2,k3),ka,
+     $     'ISHFTC(integer(1),integer(1),integer(1))')
+      call c_i1(ISHFTC(k,k2,m3),ka,
+     $     'ISHFTC(integer(1),integer(1),integer(8))')
+      call c_i1(ISHFTC(k,m2,i3),ka,
+     $     'ISHFTC(integer(1),integer(8),integer)')
+      call c_i1(ISHFTC(k,m2,j3),ka,
+     $     'ISHFTC(integer(1),integer(8),integer(2))')
+      call c_i1(ISHFTC(k,m2,k3),ka,
+     $     'ISHFTC(integer(1),integer(8),integer(1))')
+      call c_i1(ISHFTC(k,m2,m3),ka,
+     $     'ISHFTC(integer(1),integer(8),integer(8))')
+
+      call c_i8(ISHFTC(m,i2,i3),ma,'ISHFTC(integer(8),integer,integer)')
+      call c_i8(ISHFTC(m,i2,j3),ma,
+     $     'ISHFTC(integer(8),integer,integer(2))')
+      call c_i8(ISHFTC(m,i2,k3),ma,
+     $     'ISHFTC(integer(8),integer,integer(1))')
+      call c_i8(ISHFTC(m,i2,m3),ma,
+     $     'ISHFTC(integer(8),integer,integer(8))')
+      call c_i8(ISHFTC(m,j2,i3),ma,
+     $     'ISHFTC(integer(8),integer(2),integer)')
+      call c_i8(ISHFTC(m,j2,j3),ma,
+     $     'ISHFTC(integer(8),integer(2),integer(2))')
+      call c_i8(ISHFTC(m,j2,k3),ma,
+     $     'ISHFTC(integer(8),integer(2),integer(1))')
+      call c_i8(ISHFTC(m,j2,m3),ma,
+     $     'ISHFTC(integer(8),integer(2),integer(8))')
+      call c_i8(ISHFTC(m,k2,i3),ma,
+     $     'ISHFTC(integer(8),integer(1),integer)')
+      call c_i8(ISHFTC(m,k2,j3),ma,
+     $     'ISHFTC(integer(1),integer(8),integer(2))')
+      call c_i8(ISHFTC(m,k2,k3),ma,
+     $     'ISHFTC(integer(1),integer(8),integer(1))')
+      call c_i8(ISHFTC(m,k2,m3),ma,
+     $     'ISHFTC(integer(1),integer(8),integer(8))')
+      call c_i8(ISHFTC(m,m2,i3),ma,
+     $     'ISHFTC(integer(8),integer(8),integer)')
+      call c_i8(ISHFTC(m,m2,j3),ma,
+     $     'ISHFTC(integer(8),integer(8),integer(2))')
+      call c_i8(ISHFTC(m,m2,k3),ma,
+     $     'ISHFTC(integer(8),integer(8),integer(1))')
+      call c_i8(ISHFTC(m,m2,m3),ma,
+     $     'ISHFTC(integer(8),integer(8),integer(8))')
+
+c     test the corner cases
+      call c_i(ISHFTC(i,BIT_SIZE(i),BIT_SIZE(i)),i,
+     $     'ISHFTC(i,BIT_SIZE(i),BIT_SIZE(i)) i = integer')
+      call c_i(ISHFTC(i,0,BIT_SIZE(i)),i,
+     $     'ISHFTC(i,0,BIT_SIZE(i)) i = integer')
+      call c_i(ISHFTC(i,-BIT_SIZE(i),BIT_SIZE(i)),i,
+     $     'ISHFTC(i,-BIT_SIZE(i),BIT_SIZE(i)) i = integer')
+      call c_i2(ISHFTC(j,BIT_SIZE(j),BIT_SIZE(j)),j,
+     $     'ISHFTC(j,BIT_SIZE(j),BIT_SIZE(j)) j = integer(2)')
+      call c_i2(ISHFTC(j,0,BIT_SIZE(j)),j,
+     $     'ISHFTC(j,0,BIT_SIZE(j)) j = integer(2)')
+      call c_i2(ISHFTC(j,-BIT_SIZE(j),BIT_SIZE(j)),j,
+     $     'ISHFTC(j,-BIT_SIZE(j),BIT_SIZE(j)) j = integer(2)')
+      call c_i1(ISHFTC(k,BIT_SIZE(k),BIT_SIZE(k)),k,
+     $     'ISHFTC(k,BIT_SIZE(k),BIT_SIZE(k)) k = integer(1)')
+      call c_i1(ISHFTC(k,0,BIT_SIZE(k)),k,
+     $     'ISHFTC(k,0,BIT_SIZE(k)) k = integer(1)')
+      call c_i1(ISHFTC(k,-BIT_SIZE(k),BIT_SIZE(k)),k,
+     $     'ISHFTC(k,-BIT_SIZE(k),BIT_SIZE(k)) k = integer(1)')
+      call c_i8(ISHFTC(m,BIT_SIZE(m),BIT_SIZE(m)),m,
+     $     'ISHFTC(m,BIT_SIZE(m),BIT_SIZE(m)) m = integer(8)')
+      call c_i8(ISHFTC(m,0,BIT_SIZE(m)),m,
+     $     'ISHFTC(m,0,BIT_SIZE(m)) m = integer(8)')
+      call c_i8(ISHFTC(m,-BIT_SIZE(m),BIT_SIZE(m)),m,
+     $     'ISHFTC(m,-BIT_SIZE(m),BIT_SIZE(m)) m = integer(8)')
+
+c     MVBITS - Section 13.13.74
+      i = 6
+      call MVBITS(7,2,2,i,0)
+      call c_i(i,5,'MVBITS 1')
+      j = 6
+      j2 = 7
+      ja = 5
+      call MVBITS(j2,2,2,j,0)
+      call c_i2(j,ja,'MVBITS 2')
+      k = 6
+      k2 = 7
+      ka = 5
+      call MVBITS(k2,2,2,k,0)
+      call c_i1(k,ka,'MVBITS 3')
+      m = 6
+      m2 = 7
+      ma = 5
+      call MVBITS(m2,2,2,m,0)
+      call c_i8(m,ma,'MVBITS 4')
+
+c     NOT    - Section 13.13.77
+c     Rather than assume integer sizes, mask off high bits
+      j  = 21
+      j2 = 31
+      ja = 10
+      k  = 21
+      k2 = 31
+      ka = 10
+      m  = 21
+      m2 = 31
+      ma = 10
+      call c_i(IAND(NOT(21),31),10,'NOT(integer)')
+      call c_i2(IAND(NOT(j),j2),ja,'NOT(integer(2))')
+      call c_i1(IAND(NOT(k),k2),ka,'NOT(integer(1))')
+      call c_i8(IAND(NOT(m),m2),ma,'NOT(integer(8))')
+
+      if ( fail ) call abort()
+      end
+
+      subroutine failure(label)
+c     Report failure and set flag
+      character*(*) label
+      logical fail
+      common /flags/ fail
+      write(6,'(a,a,a)') 'Test ',label,' FAILED'
+      fail = .true.
+      end
+
+      subroutine c_l(i,j,label)
+c     Check if LOGICAL i equals j, and fail otherwise
+      logical i,j
+      character*(*) label
+      if ( i .eqv. j ) then
+         call failure(label)
+         write(6,*) 'Got ',i,' expected ', j
+      end if
+      end
+
+      subroutine c_i(i,j,label)
+c     Check if INTEGER i equals j, and fail otherwise
+      integer i,j
+      character*(*) label
+      if ( i .ne. j ) then
+         call failure(label)
+         write(6,*) 'Got ',i,' expected ', j
+      end if
+      end
+
+      subroutine c_i2(i,j,label)
+c     Check if INTEGER(kind=2) i equals j, and fail otherwise
+      integer(kind=2) i,j
+      character*(*) label
+      if ( i .ne. j ) then
+         call failure(label)
+         write(6,*) 'Got ',i,' expected ', j
+      end if
+      end
+
+      subroutine c_i1(i,j,label)
+c     Check if INTEGER(kind=1) i equals j, and fail otherwise
+      integer(kind=1) i,j
+      character*(*) label
+      if ( i .ne. j ) then
+         call failure(label)
+         write(6,*) 'Got ',i,' expected ', j
+      end if
+      end
+
+      subroutine c_i8(i,j,label)
+c     Check if INTEGER(kind=8) i equals j, and fail otherwise
+      integer(kind=8) i,j
+      character*(*) label
+      if ( i .ne. j ) then
+         call failure(label)
+         write(6,*) 'Got ',i,' expected ', j
+      end if
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/f90-intrinsic-mathematical.f b/gcc/testsuite/gfortran.dg/g77/f90-intrinsic-mathematical.f
new file mode 100644
index 000000000..bb9849994
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/f90-intrinsic-mathematical.f
@@ -0,0 +1,138 @@
+c { dg-do run }
+c  f90-intrinsic-mathematical.f
+c
+c Test Fortran 90 intrinsic mathematical functions - Section 13.10.3 and
+c 13.13 
+c     David Billinghurst <David.Billinghurst@riotinto.com>
+c
+c Notes:
+c  * g77 does not fully comply with F90.  Noncompliances noted in comments.
+c  * Section 13.12: Specific names for intrinsic functions tested in
+c intrinsic77.f
+
+      logical fail
+      common /flags/ fail
+      fail = .false.
+
+c     ACOS - Section 13.13.3
+      call c_r(ACOS(0.54030231),1.0,'ACOS(real)')
+      call c_d(ACOS(0.54030231d0),1.d0,'ACOS(double)')
+
+c     ASIN - Section 13.13.12
+      call c_r(ASIN(0.84147098),1.0,'ASIN(real)')
+      call c_d(ASIN(0.84147098d0),1.d0,'ASIN(double)')
+
+c     ATAN - Section 13.13.14
+      call c_r(ATAN(1.5574077),1.0,'ATAN(real)')
+      call c_d(ATAN(1.5574077d0),1.d0,'ATAN(double)')
+      
+c     ATAN2 - Section 13.13.15
+      call c_r(ATAN2(1.5574077,1.),1.0,'ATAN2(real)')
+      call c_d(ATAN2(1.5574077d0,1.d0),1.d0,'ATAN2(double)')
+
+c     COS - Section 13.13.22
+      call c_r(COS(1.0),0.54030231,'COS(real)')
+      call c_d(COS(1.d0),0.54030231d0,'COS(double)')
+      call c_c(COS((1.,0.)),(0.54030231,0.),'COS(complex)')
+      call c_z(COS((1.d0,0.d0)),(0.54030231d0,0.d0),
+     $     'COS(complex(kind=8))')
+
+c     COSH - Section 13.13.23
+      call c_r(COSH(1.0),1.5430806,'COSH(real)')
+      call c_d(COSH(1.d0),1.5430806d0,'COSH(double)')
+
+c     EXP - Section 13.13.34
+      call c_r(EXP(1.0),2.7182818,'EXP(real)')
+      call c_d(EXP(1.d0),2.7182818d0,'EXP(double)')
+      call c_c(EXP((1.,0.)),(2.7182818,0.),'EXP(complex)')
+      call c_z(EXP((1.d0,0.d0)),(2.7182818d0,0.d0),
+     $     'EXP(complex(kind=8))')
+
+c     LOG - Section 13.13.59
+      call c_r(LOG(10.0),2.3025851,'LOG(real)')
+      call c_d(LOG(10.d0),2.3025851d0,'LOG(double)')
+      call c_c(LOG((10.,0.)),(2.3025851,0.),'LOG(complex)')
+      call c_z(LOG((10.d0,0.)),(2.3025851d0,0.d0),
+     $     'LOG(complex(kind=8))')
+
+c     LOG10 - Section 13.13.60
+      call c_r(LOG10(10.0),1.0,'LOG10(real)')
+      call c_d(LOG10(10.d0),1.d0,'LOG10(double)')
+
+c     SIN - Section 13.13.97
+      call c_r(SIN(1.0),0.84147098,'SIN(real)')
+      call c_d(SIN(1.d0),0.84147098d0,'SIN(double)')
+      call c_c(SIN((1.,0.)),(0.84147098,0.),'SIN(complex)')
+      call c_z(SIN((1.d0,0.d0)),(0.84147098d0,0.d0),
+     $     'SIN(complex(kind=8))')
+
+c     SINH - Section 13.13.98
+      call c_r(SINH(1.0),1.175201,'SINH(real)')
+      call c_d(SINH(1.d0),1.175201d0,'SINH(double)')
+
+c     SQRT - Section 13.13.102
+      call c_r(SQRT(4.0),2.0,'SQRT(real)')
+      call c_d(SQRT(4.d0),2.d0,'SQRT(double)')
+      call c_c(SQRT((4.,0.)),(2.,0.),'SQRT(complex)')
+      call c_z(SQRT((4.d0,0.)),(2.d0,0.),
+     $     'SQRT(complex(kind=8))')
+ 
+c     TAN - Section 13.13.105
+      call c_r(TAN(1.0),1.5574077,'TAN(real)')
+      call c_d(TAN(1.d0),1.5574077d0,'TAN(double)')
+     
+c     TANH - Section 13.13.106
+      call c_r(TANH(1.0),0.76159416,'TANH(real)')
+      call c_d(TANH(1.d0),0.76159416d0,'TANH(double)')
+
+      if ( fail ) call abort()
+      end
+
+      subroutine failure(label)
+c     Report failure and set flag
+      character*(*) label
+      logical fail
+      common /flags/ fail
+      write(6,'(a,a,a)') 'Test ',label,' FAILED'
+      fail = .true.
+      end
+
+      subroutine c_r(a,b,label)
+c     Check if REAL a equals b, and fail otherwise
+      real a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0e-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
+
+      subroutine c_d(a,b,label)
+c     Check if DOUBLE PRECISION a equals b, and fail otherwise
+      double precision a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0d-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
+
+      subroutine c_c(a,b,label)
+c     Check if COMPLEX a equals b, and fail otherwise
+      complex a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0e-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
+
+      subroutine c_z(a,b,label)
+c     Check if COMPLEX a equals b, and fail otherwise
+      complex(kind=8) a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0d-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/f90-intrinsic-numeric.f b/gcc/testsuite/gfortran.dg/g77/f90-intrinsic-numeric.f
new file mode 100644
index 000000000..41bf59694
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/f90-intrinsic-numeric.f
@@ -0,0 +1,283 @@
+c { dg-do run }
+c  f90-intrinsic-numeric.f
+c
+c Test Fortran 90 intrinsic numeric functions - Section 13.10.2 and 13.13 
+c     David Billinghurst <David.Billinghurst@riotinto.com>
+c
+c Notes:
+c  * g77 does not fully comply with F90.  Noncompliances noted in comments.
+c  * Section 13.12: Specific names for intrinsic functions tested in
+c intrinsic77.f
+
+      logical fail
+      integer(kind=2) j, j2, ja
+      integer(kind=1) k, k2, ka
+
+      common /flags/ fail
+      fail = .false.
+
+c     ABS - Section 13.13.1
+      j = -9
+      ja = 9
+      k = j
+      ka = ja
+      call c_i(ABS(-7),7,'ABS(integer)')
+      call c_i2(ABS(j),ja,'ABS(integer(2))')
+      call c_i1(ABS(k),ka,'ABS(integer(1))')
+      call c_r(ABS(-7.),7.,'ABS(real)')
+      call c_d(ABS(-7.d0),7.d0,'ABS(double)')
+      call c_r(ABS((3.,-4.)),5.0,'ABS(complex)')
+      call c_d(ABS((3.d0,-4.d0)),5.0d0,'ABS(complex(kind=8))')
+
+c     AIMAG - Section 13.13.6
+      call c_r(AIMAG((2.,-7.)),-7.,'AIMAG(complex)')
+c     g77: AIMAG(complex(kind=8)) does not comply with F90
+c     call c_d(AIMAG((2.d0,-7.d0)),-7.d0,'AIMAG(complex(kind=8))')
+
+c     AINT - Section 13.13.7
+      call c_r(AINT(2.783),2.0,'AINT(real) 1')
+      call c_r(AINT(-2.783),-2.0,'AINT(real) 2')
+      call c_d(AINT(2.783d0),2.0d0,'AINT(double precision) 1')
+      call c_d(AINT(-2.783d0),-2.0d0,'AINT(double precision) 2')
+c     Note:  g77 does not support optional argument KIND
+
+c     ANINT - Section 13.13.10
+      call c_r(ANINT(2.783),3.0,'ANINT(real) 1')
+      call c_r(ANINT(-2.783),-3.0,'ANINT(real) 2')
+      call c_d(ANINT(2.783d0),3.0d0,'ANINT(double precision) 1')
+      call c_d(ANINT(-2.783d0),-3.0d0,'ANINT(double precision) 2')  
+c     Note:  g77 does not support optional argument KIND
+
+c     CEILING - Section 13.13.18
+c     Not implemented
+
+c     CMPLX - Section 13.13.20
+      j = 1
+      ja = 2
+      k = 1
+      ka = 2
+      call c_c(CMPLX(1),(1.,0.),'CMPLX(integer)')
+      call c_c(CMPLX(1,2),(1.,2.),'CMPLX(integer, integer)')
+      call c_c(CMPLX(j),(1.,0.),'CMPLX(integer(2))')
+      call c_c(CMPLX(j,ja),(1.,2.),'CMPLX(integer(2), integer(2))')
+      call c_c(CMPLX(k),(1.,0.),'CMPLX(integer(1)')
+      call c_c(CMPLX(k,ka),(1.,2.),'CMPLX(integer(1), integer(1))')
+      call c_c(CMPLX(1.),(1.,0.),'CMPLX(real)')
+      call c_c(CMPLX(1.d0),(1.,0.),'CMPLX(double)')
+      call c_c(CMPLX(1.d0,2.d0),(1.,2.),'CMPLX(double,double)')
+      call c_c(CMPLX(1.,2.),(1.,2.),'CMPLX(complex)')
+      call c_c(CMPLX(1.d0,2.d0),(1.,2.),'CMPLX(complex(kind=8))')
+c     NOTE: g77 does not support optional argument KIND
+   
+c     CONJG - Section 13.13.21
+      call c_c(CONJG((2.,-7.)),(2.,7.),'CONJG(complex)')
+      call c_z(CONJG((2.d0,-7.d0)),(2.d0,7.d0),'CONJG(complex(kind=8))')
+
+c     DBLE - Section 13.13.27
+      j = 5
+      k = 5
+      call c_d(DBLE(5),5.0d0,'DBLE(integer)')
+      call c_d(DBLE(j),5.0d0,'DBLE(integer(2))')
+      call c_d(DBLE(k),5.0d0,'DBLE(integer(1))')
+      call c_d(DBLE(5.),5.0d0,'DBLE(real)')
+      call c_d(DBLE(5.0d0),5.0d0,'DBLE(double)')
+      call c_d(DBLE((5.0,0.5)),5.0d0,'DBLE(complex)')
+      call c_d(DBLE((5.0d0,0.5d0)),5.0d0,'DBLE(complex(kind=8))')
+
+c     DIM - Section 13.13.29
+      j = -8
+      j2 = -3
+      ja = 0
+      k = -8
+      k2 = -3
+      ka = 0
+      call c_i(DIM(-8,-3),0,'DIM(integer)')
+      call c_i2(DIM(j,j2),ja,'DIM(integer(2))')
+      call c_i1(DIM(k,k2),ka,'DIM(integer(1)')
+      call c_r(DIM(-8.,-3.),0.,'DIM(real,real)')
+      call c_d(DIM(-8.d0,-3.d0),0.d0,'DIM(double,double)')
+ 
+c     DPROD - Section 13.13.31
+      call c_d(DPROD(-8.,-3.),24.d0,'DPROD(real,real)')
+     
+c     FLOOR - Section 13.13.36
+c     Not implemented
+
+c     INT - Section 13.13.47
+      j = 5
+      k = 5
+      call c_i(INT(5),5,'INT(integer)')
+      call c_i(INT(j),5,'INT(integer(2))')
+      call c_i(INT(k),5,'INT(integer(1))')
+      call c_i(INT(5.01),5,'INT(real)')
+      call c_i(INT(5.01d0),5,'INT(double)')
+c     Note: Does not accept optional second argument KIND
+
+c     MAX - Section 13.13.63
+      j = 1
+      j2 = 2
+      ja = 2
+      k = 1
+      k2 = 2
+      ka = 2
+      call c_i(MAX(1,2,3),3,'MAX(integer,integer,integer)')
+      call c_i2(MAX(j,j2),ja,'MAX(integer(2),integer(2))')
+      call c_i1(MAX(k,k2),ka,'MAX(integer(1),integer(1))')
+      call c_r(MAX(1.,2.,3.),3.,'MAX(real,real,real)')
+      call c_d(MAX(1.d0,2.d0,3.d0),3.d0,'MAX(double,double,double)')
+
+c     MIN - Section 13.13.68
+      j = 1
+      j2 = 2
+      ja = 1
+      k = 1
+      k2 = 2
+      ka = 1
+      call c_i(MIN(1,2,3),1,'MIN(integer,integer,integer)')
+      call c_i2(MIN(j,j2),ja,'MIN(integer(2),integer(2))')
+      call c_i1(MIN(k,k2),ka,'MIN(integer(1),integer(1))')
+      call c_r(MIN(1.,2.,3.),1.,'MIN(real,real,real)')
+      call c_d(MIN(1.d0,2.d0,3.d0),1.d0,'MIN(double,double,double)')
+
+c     MOD - Section 13.13.72
+      call c_i(MOD(8,5),3,'MOD(integer,integer) 1')
+      call c_i(MOD(-8,5),-3,'MOD(integer,integer) 2')
+      call c_i(MOD(8,-5),3,'MOD(integer,integer) 3')
+      call c_i(MOD(-8,-5),-3,'MOD(integer,integer) 4')
+      j = 8
+      j2 = 5
+      ja = 3
+      call c_i2(MOD(j,j2),ja,'MOD(integer(2),integer(2)) 1')
+      call c_i2(MOD(-j,j2),-ja,'MOD(integer(2),integer(2)) 2')
+      call c_i2(MOD(j,-j2),ja,'MOD(integer(2),integer(2)) 3')
+      call c_i2(MOD(-j,-j2),-ja,'MOD(integer(2),integer(2)) 4')
+      k = 8
+      k2 = 5
+      ka = 3
+      call c_i1(MOD(k,k2),ka,'MOD(integer(1),integer(1)) 1')
+      call c_i1(MOD(-k,k2),-ka,'MOD(integer(1),integer(1)) 2')
+      call c_i1(MOD(k,-k2),ka,'MOD(integer(1),integer(1)) 3')
+      call c_i1(MOD(-k,-k2),-ka,'MOD(integer(1),integer(1)) 4')
+      call c_r(MOD(8.,5.),3.,'MOD(real,real) 1')
+      call c_r(MOD(-8.,5.),-3.,'MOD(real,real) 2')
+      call c_r(MOD(8.,-5.),3.,'MOD(real,real) 3')
+      call c_r(MOD(-8.,-5.),-3.,'MOD(real,real) 4')
+      call c_d(MOD(8.d0,5.d0),3.d0,'MOD(double,double) 1')
+      call c_d(MOD(-8.d0,5.d0),-3.d0,'MOD(double,double) 2')
+      call c_d(MOD(8.d0,-5.d0),3.d0,'MOD(double,double) 3')
+      call c_d(MOD(-8.d0,-5.d0),-3.d0,'MOD(double,double) 4')
+
+c     MODULO - Section 13.13.73
+c     Not implemented
+
+c     NINT - Section 13.13.76
+      call c_i(NINT(2.783),3,'NINT(real)')
+      call c_i(NINT(2.783d0),3,'NINT(double)')
+c     Optional second argument KIND not implemented
+
+c     REAL - Section 13.13.86
+      j = -2
+      k = -2
+      call c_r(REAL(-2),-2.0,'REAL(integer)')
+      call c_r(REAL(j),-2.0,'REAL(integer(2))')
+      call c_r(REAL(k),-2.0,'REAL(integer(1))')
+      call c_r(REAL(-2.0),-2.0,'REAL(real)')
+      call c_r(REAL(-2.0d0),-2.0,'REAL(double)')
+      call c_r(REAL((-2.,9.)),-2.0,'REAL(complex)')
+c     REAL(complex(kind=8)) not implemented
+c     call c_r(REAL((-2.d0,9.d0)),-2.0,'REAL(complex(kind=8))')
+
+c     SIGN - Section 13.13.96
+      j = -3
+      j2 = 2
+      ja = 3
+      k = -3
+      k2 = 2
+      ka = 3
+      call c_i(SIGN(-3,2),3,'SIGN(integer)')
+      call c_i2(SIGN(j,j2),ja,'SIGN(integer(2))')
+      call c_i1(SIGN(k,k2),ka,'SIGN(integer(1))')
+      call c_r(SIGN(-3.0,2.),3.,'SIGN(real,real)')
+      call c_d(SIGN(-3.d0,2.d0),3.d0,'SIGN(double,double)')
+ 
+      if ( fail ) call abort()
+      end
+
+      subroutine failure(label)
+c     Report failure and set flag
+      character*(*) label
+      logical fail
+      common /flags/ fail
+      write(6,'(a,a,a)') 'Test ',label,' FAILED'
+      fail = .true.
+      end
+
+      subroutine c_i(i,j,label)
+c     Check if INTEGER i equals j, and fail otherwise
+      integer i,j
+      character*(*) label
+      if ( i .ne. j ) then
+         call failure(label)
+         write(6,*) 'Got ',i,' expected ', j
+      end if
+      end
+
+      subroutine c_i2(i,j,label)
+c     Check if INTEGER(kind=2) i equals j, and fail otherwise
+      integer(kind=2) i,j
+      character*(*) label
+      if ( i .ne. j ) then
+         call failure(label)
+         write(6,*) 'Got ',i,' expected ', j
+      end if
+      end
+
+      subroutine c_i1(i,j,label)
+c     Check if INTEGER(kind=1) i equals j, and fail otherwise
+      integer(kind=1) i,j
+      character*(*) label
+      if ( i .ne. j ) then
+         call failure(label)
+         write(6,*) 'Got ',i,' expected ', j
+      end if
+      end
+
+      subroutine c_r(a,b,label)
+c     Check if REAL a equals b, and fail otherwise
+      real a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0e-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
+
+      subroutine c_d(a,b,label)
+c     Check if DOUBLE PRECISION a equals b, and fail otherwise
+      double precision a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0d-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
+
+      subroutine c_c(a,b,label)
+c     Check if COMPLEX a equals b, and fail otherwise
+      complex a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0e-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
+
+      subroutine c_z(a,b,label)
+c     Check if COMPLEX a equals b, and fail otherwise
+      complex(kind=8) a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0d-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/ffixed-form-1.f b/gcc/testsuite/gfortran.dg/g77/ffixed-form-1.f
new file mode 100644
index 000000000..4b5f72301
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/ffixed-form-1.f
@@ -0,0 +1,6 @@
+! Test compiler flags: -ffixed-form
+! Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+!
+! { dg-do compile }
+! { dg-options "-ffixed-form" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/ffixed-form-2.f b/gcc/testsuite/gfortran.dg/g77/ffixed-form-2.f
new file mode 100644
index 000000000..5f6980ca0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/ffixed-form-2.f
@@ -0,0 +1,12 @@
+! PR fortran/10843
+! Origin: Brad Davis <bdavis9659@comcast.net>
+!
+! { dg-do compile }
+! { dg-options "-ffixed-form" }
+      GO TO 3
+      GOTO 3
+ 3    CONTINUE
+      GOTO = 55
+      GO TO = 55
+      END
+
diff --git a/gcc/testsuite/gfortran.dg/g77/ffixed-line-length-0.f b/gcc/testsuite/gfortran.dg/g77/ffixed-line-length-0.f
new file mode 100644
index 000000000..80c4f3f56
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/ffixed-line-length-0.f
@@ -0,0 +1,7 @@
+C Test compiler flags: -ffixed-line-length-0
+C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+C
+C { dg-do compile }
+C { dg-options "-ffixed-line-length-0" }
+C The next line has length 257
+      en                                                                                                                                                           d
diff --git a/gcc/testsuite/gfortran.dg/g77/ffixed-line-length-132.f b/gcc/testsuite/gfortran.dg/g77/ffixed-line-length-132.f
new file mode 100644
index 000000000..610169675
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/ffixed-line-length-132.f
@@ -0,0 +1,7 @@
+C Test compiler flags: -ffixed-line-length-132
+C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+C
+C { dg-do compile }
+C { dg-options "-ffixed-line-length-132" }
+c23456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012
+      en                                                                                                                           d*
diff --git a/gcc/testsuite/gfortran.dg/g77/ffixed-line-length-72.f b/gcc/testsuite/gfortran.dg/g77/ffixed-line-length-72.f
new file mode 100644
index 000000000..8a2fad1fa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/ffixed-line-length-72.f
@@ -0,0 +1,7 @@
+C Test compiler flags: -ffixed-line-length-72
+C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+C
+C { dg-do compile }
+C { dg-options "-ffixed-line-length-72" }
+c2345678901234567890123456789012345678901234567890123456789012345678901234567890
+      en                                                               d*
diff --git a/gcc/testsuite/gfortran.dg/g77/ffixed-line-length-none.f b/gcc/testsuite/gfortran.dg/g77/ffixed-line-length-none.f
new file mode 100644
index 000000000..b4a50147f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/ffixed-line-length-none.f
@@ -0,0 +1,7 @@
+C Test compiler flags: -ffixed-line-length-none
+C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+C
+C { dg-do compile }
+C { dg-options "-ffixed-line-length-none" }
+C The next line has length 257
+      en                                                                                                                                                           d
diff --git a/gcc/testsuite/gfortran.dg/g77/ffree-form-1.f b/gcc/testsuite/gfortran.dg/g77/ffree-form-1.f
new file mode 100644
index 000000000..88ddeefb3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/ffree-form-1.f
@@ -0,0 +1,6 @@
+! Test compiler flags: -ffree-form
+! Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+!
+! { dg-do compile }
+! { dg-options "-ffree-form" }
+end
diff --git a/gcc/testsuite/gfortran.dg/g77/ffree-form-2.f b/gcc/testsuite/gfortran.dg/g77/ffree-form-2.f
new file mode 100644
index 000000000..b07db2187
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/ffree-form-2.f
@@ -0,0 +1,11 @@
+! PR fortran/10843
+! Origin: Brad Davis <bdavis9659@comcast.net>
+!
+! { dg-do compile }
+! { dg-options "-ffree-form" }
+      GO TO 3 
+      GOTO 3
+ 3    CONTINUE
+      GOTO = 55
+      END
+
diff --git a/gcc/testsuite/gfortran.dg/g77/ffree-form-3.f b/gcc/testsuite/gfortran.dg/g77/ffree-form-3.f
new file mode 100644
index 000000000..a30d60460
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/ffree-form-3.f
@@ -0,0 +1,20 @@
+! Test acceptance of keywords in free format
+! Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+!
+! { dg-do compile }
+! { dg-options "-ffree-form" }
+  integer i, j
+  i = 1
+  if ( i .eq. 1 ) then
+    go = 2
+  endif
+  if ( i .eq. 3 ) then
+     i = 4
+  end if
+  do i = 1, 3
+    j = i
+  end do
+  do j = 1, 3
+    i = j
+  enddo
+  end
diff --git a/gcc/testsuite/gfortran.dg/g77/fno-underscoring.f b/gcc/testsuite/gfortran.dg/g77/fno-underscoring.f
new file mode 100644
index 000000000..b91320b4c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/fno-underscoring.f
@@ -0,0 +1,8 @@
+C Test compiler flags: -fno-underscoring
+C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+C
+C { dg-do compile }
+C { dg-options "-fno-underscoring" }
+      call aaabbbccc
+      end
+C { dg-final { scan-assembler-not "aaabbbccc_" } }
diff --git a/gcc/testsuite/gfortran.dg/g77/funderscoring.f b/gcc/testsuite/gfortran.dg/g77/funderscoring.f
new file mode 100644
index 000000000..720b3a7e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/funderscoring.f
@@ -0,0 +1,8 @@
+C Test compiler flags: -funderscoring
+C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
+C
+C { dg-do compile }
+C { dg-options "-funderscoring" }
+      call aaabbbccc
+      end
+C { dg-final { scan-assembler "aaabbbccc_" } }
diff --git a/gcc/testsuite/gfortran.dg/g77/int8421.f b/gcc/testsuite/gfortran.dg/g77/int8421.f
new file mode 100644
index 000000000..0eb152002
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/int8421.f
@@ -0,0 +1,21 @@
+c { dg-do run }
+      integer(kind=1) i1, i11
+      integer(kind=2) i2, i22
+      integer         i, ii
+      integer(kind=4) i4, i44
+      integer(kind=8) i8, i88
+      real      r, rr
+      real(kind=4)    r4, r44
+      double precision d, dd
+      real(kind=8)   r8, r88
+      parameter (i1 = 1, i2 = 2, i4 = 4, i = 5, i8 = i + i4*i2 + i2*i1)
+      parameter (r = 3.0, r4 = 4.0, r8 = 8.d0, d = i8*r + r4*i2 + r8*i1)
+      if (i8 .ne. 15   ) call abort
+      if (d  .ne. 61.d0) call abort
+      i11 = 1; i22 = 2; i44 = 4; ii = 5
+      i88 = i + i4*i2 + i2*i1
+      if (i88 .ne. i8) call abort
+      rr = 3.0; r44 = 4.0; r88 = 8.0d0
+      dd = i88*rr + r44*i22 + r88*i11
+      if (dd .ne. d) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/intrinsic-unix-bessel.f b/gcc/testsuite/gfortran.dg/g77/intrinsic-unix-bessel.f
new file mode 100644
index 000000000..696392ffa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/intrinsic-unix-bessel.f
@@ -0,0 +1,109 @@
+c { dg-do run }
+c  intrinsic-unix-bessel.f
+c
+c Test Bessel function intrinsics.  
+c These functions are only available if provided by system
+c
+c     David Billinghurst <David.Billinghurst@riotinto.com>
+c
+      real x, a
+      double precision dx, da
+      integer i
+      integer(kind=2) j
+      integer(kind=1) k
+      integer(kind=8) m
+      logical fail
+      common /flags/ fail
+      fail = .false.
+
+      x = 2.0
+      dx = x 
+      i = 2
+      j = i
+      k = i
+      m = i
+c     BESJ0  - Bessel function of first kind of order zero
+      a = 0.22389077
+      da = a
+      call c_r(BESJ0(x),a,'BESJ0(real)')
+      call c_d(BESJ0(dx),da,'BESJ0(double)')
+      call c_d(DBESJ0(dx),da,'DBESJ0(double)')
+
+c     BESJ1  - Bessel function of first kind of order one
+      a = 0.57672480
+      da = a
+      call c_r(BESJ1(x),a,'BESJ1(real)')
+      call c_d(BESJ1(dx),da,'BESJ1(double)')
+      call c_d(DBESJ1(dx),da,'DBESJ1(double)')
+
+c     BESJN  - Bessel function of first kind of order N
+      a = 0.3528340
+      da = a
+      call c_r(BESJN(i,x),a,'BESJN(integer,real)')
+      call c_r(BESJN(j,x),a,'BESJN(integer(2),real)')
+      call c_r(BESJN(k,x),a,'BESJN(integer(1),real)')
+      call c_d(BESJN(i,dx),da,'BESJN(integer,double)')
+      call c_d(BESJN(j,dx),da,'BESJN(integer(2),double)')
+      call c_d(BESJN(k,dx),da,'BESJN(integer(1),double)')
+      call c_d(DBESJN(i,dx),da,'DBESJN(integer,double)')
+      call c_d(DBESJN(j,dx),da,'DBESJN(integer(2),double)')
+      call c_d(DBESJN(k,dx),da,'DBESJN(integer(1),double)')
+
+c     BESY0  - Bessel function of second kind of order zero
+      a = 0.51037567
+      da = a
+      call c_r(BESY0(x),a,'BESY0(real)')
+      call c_d(BESY0(dx),da,'BESY0(double)')
+      call c_d(DBESY0(dx),da,'DBESY0(double)')
+
+c     BESY1  - Bessel function of second kind of order one
+      a = 0.-0.1070324
+      da = a
+      call c_r(BESY1(x),a,'BESY1(real)')
+      call c_d(BESY1(dx),da,'BESY1(double)')
+      call c_d(DBESY1(dx),da,'DBESY1(double)')
+
+c     BESYN  - Bessel function of second kind of order N
+      a = -0.6174081
+      da = a
+      call c_r(BESYN(i,x),a,'BESYN(integer,real)')
+      call c_r(BESYN(j,x),a,'BESYN(integer(2),real)')
+      call c_r(BESYN(k,x),a,'BESYN(integer(1),real)')
+      call c_d(BESYN(i,dx),da,'BESYN(integer,double)')
+      call c_d(BESYN(j,dx),da,'BESYN(integer(2),double)')
+      call c_d(BESYN(k,dx),da,'BESYN(integer(1),double)')
+      call c_d(DBESYN(i,dx),da,'DBESYN(integer,double)')
+      call c_d(DBESYN(j,dx),da,'DBESYN(integer(2),double)')
+      call c_d(DBESYN(k,dx),da,'DBESYN(integer(1),double)')
+
+      if ( fail ) call abort()
+      end
+
+      subroutine failure(label)
+c     Report failure and set flag
+      character*(*) label
+      logical fail
+      common /flags/ fail
+      write(6,'(a,a,a)') 'Test ',label,' FAILED'
+      fail = .true.
+      end
+
+      subroutine c_r(a,b,label)
+c     Check if REAL a equals b, and fail otherwise
+      real a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0e-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
+
+      subroutine c_d(a,b,label)
+c     Check if DOUBLE PRECISION a equals b, and fail otherwise
+      double precision a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0d-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/intrinsic-unix-erf.f b/gcc/testsuite/gfortran.dg/g77/intrinsic-unix-erf.f
new file mode 100644
index 000000000..460ddeea4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/intrinsic-unix-erf.f
@@ -0,0 +1,61 @@
+c { dg-do run }
+c  intrinsic-unix-erf.f
+c
+c Test Bessel function intrinsics.  
+c These functions are only available if provided by system
+c
+c     David Billinghurst <David.Billinghurst@riotinto.com>
+c
+      real x, a
+      double precision dx, da
+      logical fail
+      common /flags/ fail
+      fail = .false.
+
+      x = 0.6
+      dx = x 
+c     ERF  - error function
+      a = 0.6038561
+      da = a
+      call c_r(ERF(x),a,'ERF(real)')
+      call c_d(ERF(dx),da,'ERF(double)')
+      call c_d(DERF(dx),da,'DERF(double)')
+
+c     ERFC  - complementary error function
+      a = 1.0 - a
+      da = a
+      call c_r(ERFC(x),a,'ERFC(real)')
+      call c_d(ERFC(dx),da,'ERFC(double)')
+      call c_d(DERFC(dx),da,'DERFC(double)')
+
+      if ( fail ) call abort()
+      end
+
+      subroutine failure(label)
+c     Report failure and set flag
+      character*(*) label
+      logical fail
+      common /flags/ fail
+      write(6,'(a,a,a)') 'Test ',label,' FAILED'
+      fail = .true.
+      end
+
+      subroutine c_r(a,b,label)
+c     Check if REAL a equals b, and fail otherwise
+      real a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0e-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
+
+      subroutine c_d(a,b,label)
+c     Check if DOUBLE PRECISION a equals b, and fail otherwise
+      double precision a, b
+      character*(*) label
+      if ( abs(a-b) .gt. 1.0d-5 ) then
+         call failure(label)
+         write(6,*) 'Got ',a,' expected ', b
+      end if
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/labug1.f b/gcc/testsuite/gfortran.dg/g77/labug1.f
new file mode 100644
index 000000000..d004f760e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/labug1.f
@@ -0,0 +1,58 @@
+c { dg-do run }
+      PROGRAM LABUG1
+
+*  This program core dumps on mips-sgi-irix6.2 when compiled
+*  with egcs-19981101, egcs-19981109 and egcs-19981122 snapshots
+*  with -O2
+*
+*  Originally derived from LAPACK test suite.
+*  Almost any change allows it to run.
+*
+*  David Billinghurst, (David.Billinghurst@riotinto.com.au)
+*  25 November 1998
+* 
+*     .. Parameters ..
+      INTEGER   LDA, LDE
+      PARAMETER ( LDA = 2500, LDE = 50  )
+      COMPLEX   CZERO 
+      PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ) )
+
+      INTEGER   I, J, M, N
+      REAL      V
+      COMPLEX   A(LDA),B(LDA),C(LDA),E(LDE,LDE),F(LDE,LDE)  
+      COMPLEX   Z
+
+      N=2
+      M=1
+*
+      do i = 1, m
+         do j = 1, n
+            e(i,j) = czero
+            f(i,j) = czero
+        end do
+      end do
+*
+      DO J = 1, N
+         DO I = 1, M
+            V =  ABS( E(I,J) - F(I,J) )
+         END DO
+      END DO
+ 
+      CALL SUB2(M,Z)
+
+      END
+
+      subroutine SUB2(I,A)
+      integer i
+      complex a
+      end
+
+
+
+
+
+
+
+
+
+
diff --git a/gcc/testsuite/gfortran.dg/g77/large_vec.f b/gcc/testsuite/gfortran.dg/g77/large_vec.f
new file mode 100644
index 000000000..f5ff87d0d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/large_vec.f
@@ -0,0 +1,4 @@
+c { dg-do run }
+      parameter (nmax=165000)
+      double precision x(nmax)
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/le.f b/gcc/testsuite/gfortran.dg/g77/le.f
new file mode 100644
index 000000000..c62ac46cd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/le.f
@@ -0,0 +1,30 @@
+c { dg-do run }
+      program fool
+
+      real     foo
+      integer  n
+      logical  t
+
+      foo = 2.5
+      n = 5
+
+      t = (n > foo)
+      if (t .neqv. .true.) call abort
+      t = (n >= foo)
+      if (t .neqv. .true.) call abort
+      t = (n < foo)
+      if (t .neqv. .false.) call abort
+      t = (n <= 5)
+      if (t .neqv. .true.) call abort
+      t = (n >= 5 )
+      if (t .neqv. .true.) call abort
+      t = (n == 5)
+      if (t .neqv. .true.) call abort
+      t = (n /= 5)
+      if (t .neqv. .false.) call abort
+      t = (n /= foo)
+      if (t .neqv. .true.) call abort
+      t = (n == foo)
+      if (t .neqv. .false.) call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/pr9258.f b/gcc/testsuite/gfortran.dg/g77/pr9258.f
new file mode 100644
index 000000000..621324556
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/pr9258.f
@@ -0,0 +1,18 @@
+C Test case for PR/9258
+C Origin: kmccarty@princeton.edu
+C
+C { dg-do compile }
+      SUBROUTINE FOO (B)
+
+  10  CALL BAR (A)
+      ASSIGN 20 TO M           !{ dg-warning "Deleted feature: ASSIGN" "" }
+      IF (100.LT.A) GOTO 10
+      GOTO 40
+C
+  20  IF (B.LT.ABS(A)) GOTO 10
+      ASSIGN 30 TO M           !{ dg-warning "Deleted feature: ASSIGN" "" }
+      GOTO 40
+C
+  30  ASSIGN 10 TO M           !{ dg-warning "Deleted feature: ASSIGN" "" }
+  40  GOTO M,(10,20,30)        !{ dg-warning "Deleted feature: Assigned GOTO" "" }
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/short.f b/gcc/testsuite/gfortran.dg/g77/short.f
new file mode 100644
index 000000000..330f0ac52
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/short.f
@@ -0,0 +1,60 @@
+c { dg-do run }
+c { dg-options "-std=legacy" }
+c
+      program short
+
+      parameter   (   N=2  )
+      common /chb/    pi,sig(0:N)
+      common /parm/   h(2,2)
+
+c  initialize some variables
+      h(2,2) = 1117
+      h(2,1) = 1178
+      h(1,2) = 1568
+      h(1,1) = 1621
+      sig(0) = -1.
+      sig(1) = 0.
+      sig(2) = 1.
+
+      call printout
+      stop
+      end
+
+c ******************************************************************
+
+      subroutine printout
+      parameter   (   N=2  )
+      common /chb/    pi,sig(0:N)
+      common /parm/   h(2,2)
+      dimension       yzin1(0:N), yzin2(0:N)
+
+c  function subprograms
+      z(i,j,k) = 0.5*h(i,j)*(sig(k)-1.)
+
+c  a four-way average of rhobar
+      do 260  k=0,N
+        yzin1(k) = 0.25 * 
+     &       ( z(2,2,k) + z(1,2,k) +
+     &         z(2,1,k) + z(1,1,k) )
+  260       continue
+
+c  another four-way average of rhobar
+      do 270  k=0,N
+         rtmp1 = z(2,2,k)
+         rtmp2 = z(1,2,k)
+         rtmp3 = z(2,1,k)
+         rtmp4 = z(1,1,k)
+         yzin2(k) = 0.25 * 
+     &       ( rtmp1 + rtmp2 + rtmp3 + rtmp4 )
+  270       continue
+
+      do k=0,N
+         if (yzin1(k) .ne. yzin2(k)) call abort
+      enddo
+      if (yzin1(0) .ne. -1371.) call abort
+      if (yzin1(1) .ne. -685.5) call abort
+      if (yzin1(2) .ne. 0.) call abort
+
+      return
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/g77/strlen0.f b/gcc/testsuite/gfortran.dg/g77/strlen0.f
new file mode 100644
index 000000000..765c8b611
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/strlen0.f
@@ -0,0 +1,95 @@
+C     Substring range checking test program, to check behavior with respect
+C     to X3J3/90.4 paragraph 5.7.1.
+C
+C     Patches relax substring checking for subscript expressions in order to
+C     simplify coding (elimination of length checks for strings passed as
+C     parameters) and to avoid contradictory behavior of subscripted substring
+C     expressions with respect to unsubscripted string expressions.
+C
+C     Key part of 5.7.1 interpretation comes down to statement that in the
+C     substring expression,
+C        v ( e1 : e2 )
+C     1 <= e1 <= e2 <= len to be valid, yet the expression
+C        v ( : )
+C     is equivalent to
+C        v(1:len(v))
+C
+C     meaning that any statement that reads
+C        str = v // 'tail'
+C     (where v is a string passed as a parameter) would require coding as
+C        if (len(v) .gt. 0) then
+C           str = v // 'tail'
+C        else
+C           str = 'tail'
+C        endif
+C     to comply with the standard specification.  Under the stricter
+C     interpretation, functions strcat and strlat would be incorrect as
+C     written for null values of str1 and/or str2.
+C
+C     This code compiles and runs without error on
+C       SunOS 4.1.3 f77 (-C option)
+C       SUNWspro SPARCcompiler 4.2 f77 (-C option)
+C       (and with proposed patches, gcc-2.9.2 -fbounds-check except for test 6,
+C        which is a genuine, deliberate error - comment out to make further
+C        tests)
+C
+C { dg-do run }
+C { dg-options "-fbounds-check" }
+C
+C     G. Helffrich/Tokyo Inst. Technology Jul 24 2001
+
+      character str*8,strres*16,strfun*16,strcat*16,strlat*16
+
+      str='Hi there'
+
+C     Test 1 - (current+patched) two char substring result
+      strres=strfun(str,1,2)
+      write(*,*) 'strres is ',strres
+
+C     Test 2 - (current+patched) null string result
+      strres=strfun(str,5,4)
+      write(*,*) 'strres is ',strres
+
+C     Test 3 - (current+patched) null string result
+      strres=strfun(str,8,7)
+      write(*,*) 'strres is ',strres
+
+C     Test 4 - (current) error; (patched) null string result
+      strres=strfun(str,9,8)
+      write(*,*) 'strres is ',strres
+
+C     Test 5 - (current) error; (patched) null string result
+      strres=strfun(str,1,0)
+      write(*,*) 'strres is ',strres
+
+C     Test 6 - (current+patched) error
+C     strres=strfun(str,20,20)
+C     write(*,*) 'strres is ',strres
+
+C     Test 7 - (current+patched) str result
+      strres=strcat(str,'')
+      write(*,*) 'strres is ',strres
+
+C     Test 8 - (current) error; (patched) str result
+      strres=strlat('',str)
+      write(*,*) 'strres is ',strres
+
+      end
+
+      character*(*) function strfun(str,i,j)
+      character str*(*)
+
+      strfun = str(i:j)
+      end
+
+      character*(*) function strcat(str1,str2)
+      character str1*(*), str2*(*)
+
+      strcat = str1 // str2
+      end
+
+      character*(*) function strlat(str1,str2)
+      character str1*(*), str2*(*)
+
+      strlat = str1(1:len(str1)) // str2(1:len(str2))
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77/toon_1.f b/gcc/testsuite/gfortran.dg/g77/toon_1.f
new file mode 100644
index 000000000..fcdeb427d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/toon_1.f
@@ -0,0 +1,4 @@
+c { dg-do compile }
+      SUBROUTINE AAP(NOOT)
+      DIMENSION NOOT(*)
+      END
diff --git a/gcc/testsuite/gfortran.dg/g77/xformat.f b/gcc/testsuite/gfortran.dg/g77/xformat.f
new file mode 100644
index 000000000..9b2769a03
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/xformat.f
@@ -0,0 +1,4 @@
+c { dg-do compile }
+       PRINT 10, 2, 3
+10     FORMAT (I1, X, I1) ! { dg-warning "Extension: X descriptor" "Extension: X descriptor"  }
+       END
diff --git a/gcc/testsuite/gfortran.dg/g77_intrinsics_funcs.f b/gcc/testsuite/gfortran.dg/g77_intrinsics_funcs.f
new file mode 100644
index 000000000..f9e0195bc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77_intrinsics_funcs.f
@@ -0,0 +1,53 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! Testing g77 intrinsics as subroutines
+      integer(kind=8) i8
+      integer i4
+      integer i
+      character*80 c
+
+      i8 = time ()
+      i4 = time ()
+      i8 = time8 ()
+      i4 = time8 ()
+
+      i8 = hostnm (c)
+      i4 = hostnm (c)
+      i = hostnm (c)
+
+      i8 = ierrno ()
+      i4 = ierrno ()
+      i = ierrno ()
+
+      i8 = kill (i8, i8)
+      i8 = kill (i8, i4)
+      i8 = kill (i4, i8)
+      i8 = kill (i4, i4)
+      i4 = kill (i8, i8)
+      i4 = kill (i8, i4)
+      i4 = kill (i4, i8)
+      i4 = kill (i4, i4)
+
+      i8 = link ('foo', 'bar')
+      i4 = link ('foo', 'bar')
+      i = link ('foo', 'bar')
+
+      i8 = rename ('foo', 'bar')
+      i4 = rename ('foo', 'bar')
+      i = rename ('foo', 'bar')
+      
+      i8 = symlnk ('foo', 'bar')
+      i4 = symlnk ('foo', 'bar')
+      i = symlnk ('foo', 'bar')
+      
+! Cleaning our mess
+      call unlink ('bar')
+
+! This should be the last test, unless you want garbage everywhere in
+! your filesystem.
+      i8 = chdir ('..')
+      i4 = chdir ('..')
+      i = chdir ('..')
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/g77_intrinsics_sub.f b/gcc/testsuite/gfortran.dg/g77_intrinsics_sub.f
new file mode 100644
index 000000000..6ee5f837c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77_intrinsics_sub.f
@@ -0,0 +1,84 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! Testing g77 intrinsics as subroutines
+      integer(kind=8) i8, j8
+      integer i4, j4
+      integer i, j
+      character*80 c
+
+      call gerror (c)
+      call getlog (c)
+
+      call hostnm (c, status = i8)
+      call hostnm (c, i8)
+      call hostnm (c, status = i4)
+      call hostnm (c, i4)
+      call hostnm (c, status = i)
+      call hostnm (c, i)
+      call hostnm (c)
+
+      call kill (i8, i8, status = i8)
+      call kill (i8, i8, i8)
+      call kill (i4, i8, i8)
+      call kill (i8, i4, i8)
+      call kill (i8, i8, i4)
+      call kill (i4, i4, i8)
+      call kill (i4, i8, i4)
+      call kill (i8, i4, i4)
+      call kill (i4, i4, i4)
+      call kill (i, i, i)
+      call kill (i8, i8)
+      call kill (i4, i8)
+      call kill (i8, i4)
+      call kill (i4, i4)
+      call kill (i, i)
+
+      call link ('foo', 'bar', status = i8)
+      call link ('foo', 'bar', status = i4)
+      call link ('foo', 'bar', status = i)
+      call link ('foo', 'bar', i8)
+      call link ('foo', 'bar', i4)
+      call link ('foo', 'bar', i)
+      call link ('foo', 'bar')
+
+      call perror (c)
+      
+      call rename ('foo', 'bar', status = i8)
+      call rename ('foo', 'bar', status = i4)
+      call rename ('foo', 'bar', status = i)
+      call rename ('foo', 'bar', i8)
+      call rename ('foo', 'bar', i4)
+      call rename ('foo', 'bar', i)
+      call rename ('foo', 'bar')
+
+      i = 1
+      i4 = 1
+      i8 = 1
+      call sleep (i)
+      call sleep (i4)
+      call sleep (i8)
+      call sleep (-1)
+
+      call symlnk ('foo', 'bar', status = i8)
+      call symlnk ('foo', 'bar', status = i4)
+      call symlnk ('foo', 'bar', status = i)
+      call symlnk ('foo', 'bar', i8)
+      call symlnk ('foo', 'bar', i4)
+      call symlnk ('foo', 'bar', i)
+      call symlnk ('foo', 'bar')
+
+! Cleaning our mess
+      call unlink ('bar')
+
+! This should be the last test, unless you want garbage everywhere in
+! your filesystem.
+      call chdir ('..', status = i8)
+      call chdir ('..', i8)
+      call chdir ('..', status = i4)
+      call chdir ('..', i4)
+      call chdir ('..', status = i)
+      call chdir ('..', i)
+      call chdir ('..')
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/gamma_1.f90 b/gcc/testsuite/gfortran.dg/gamma_1.f90
new file mode 100644
index 000000000..994616695
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gamma_1.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+!
+! Test the vendor intrinsic (d)gamma, lgamma and algama/dlgama
+! gamma is also part of the Fortran 2008 draft; lgamma is called
+! log_gamma in the Fortran 2008 draft.
+!
+! PR fortran/32980
+!
+program gamma_test
+implicit none
+intrinsic :: gamma, lgamma, log_gamma
+integer, parameter :: sp = kind(1.0)
+integer, parameter :: dp = kind(1.0d0)
+
+real(sp) :: rsp
+real(dp) :: rdp
+
+if (abs(gamma(1.0_sp)  - 1.0_sp) > tiny(1.0_sp)) call abort()
+if (abs(gamma(1.0_dp)  - 1.0_dp) > tiny(1.0_dp)) call abort()
+if (abs(dgamma(1.0_dp) - 1.0_dp) > tiny(1.0_dp)) call abort()
+
+if (abs(lgamma(1.0_sp)) > tiny(1.0_sp)) call abort()
+if (abs(lgamma(1.0_dp)) > tiny(1.0_dp)) call abort()
+if (abs(log_gamma(1.0_sp)) > tiny(1.0_sp)) call abort()
+if (abs(log_gamma(1.0_dp)) > tiny(1.0_dp)) call abort()
+if (abs(algama(1.0_sp)) > tiny(1.0_sp)) call abort()
+if (abs(dlgama(1.0_dp)) > tiny(1.0_dp)) call abort()
+end program gamma_test
+
diff --git a/gcc/testsuite/gfortran.dg/gamma_2.f90 b/gcc/testsuite/gfortran.dg/gamma_2.f90
new file mode 100644
index 000000000..5b0e922cb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gamma_2.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! { dg-options "-std=f2003 -Wall" }
+!
+! Test the vendor intrinsic (d)gamma, lgamma and algama/dlgama
+! gamma is also part of the Fortran 2008 draft; lgamma is called
+! log_gamma in the Fortran 2008 draft.
+!
+! PR fortran/32980
+!
+subroutine foo()
+intrinsic :: gamma ! { dg-error "Fortran 2008" }
+intrinsic :: dgamma ! { dg-error "extension" }
+intrinsic :: lgamma ! { dg-error "extension" }
+intrinsic :: algama ! { dg-error "extension" }
+intrinsic :: dlgama ! { dg-error "extension" }
+
+integer, parameter :: sp = kind(1.0)
+integer, parameter :: dp = kind(1.0d0)
+
+real(sp) :: rsp = 1.0_sp
+real(dp) :: rdp = 1.0_dp
+
+rsp = gamma(rsp)
+rdp = gamma(rdp)
+rdp = dgamma(rdp)
+
+rsp = lgamma(rsp)
+rdp = lgamma(rdp)
+rsp = algama(rsp)
+rdp = dlgama(rdp)
+end subroutine foo
+end
diff --git a/gcc/testsuite/gfortran.dg/gamma_3.f90 b/gcc/testsuite/gfortran.dg/gamma_3.f90
new file mode 100644
index 000000000..ca3d30db9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gamma_3.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+!
+! Test the vendor intrinsic (d)gamma, lgamma and algama/dlgama
+! gamma is also part of the Fortran 2008 draft; lgamma is called
+! log_gamma in the Fortran 2008 draft.
+!
+! PR fortran/32980
+!
+program gamma_test
+implicit none
+intrinsic :: gamma, lgamma
+real :: x
+
+x = gamma(cmplx(1.0,0.0))            ! { dg-error "is not consistent with a specific intrinsic interface" }
+x = dgamma(cmplx(1.0,0.0,kind(0d0))) ! { dg-error "must be REAL" }
+x = gamma(int(1))                    ! { dg-error "is not consistent with a specific intrinsic interface" }
+x = dgamma(int(1))                   ! { dg-error "must be REAL" }
+
+x = lgamma(cmplx(1.0,0.0))           ! { dg-error "must be REAL" }
+x = algama(cmplx(1.0,0.0))           ! { dg-error "must be REAL" }
+x = dlgama(cmplx(1.0,0.0,kind(0d0))) ! { dg-error "must be REAL" }
+
+x = lgamma(int(1))                   ! { dg-error "must be REAL" }
+x = algama(int(1))                   ! { dg-error "must be REAL" }
+x = dlgama(int(1))                   ! { dg-error "must be REAL" }
+end program gamma_test
+
diff --git a/gcc/testsuite/gfortran.dg/gamma_4.f90 b/gcc/testsuite/gfortran.dg/gamma_4.f90
new file mode 100644
index 000000000..67e9e2314
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gamma_4.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+!
+! Test the Fortran 2008 intrinsics gamma and log_gamma
+!
+! PR fortran/32980
+!
+program gamma_test
+implicit none
+intrinsic :: gamma, log_gamma
+integer, parameter :: qp = selected_real_kind(precision (0.0_8) + 1)
+
+real(qp) :: rqp
+
+if (abs(gamma(1.0_qp)  - 1.0_qp) > tiny(1.0_qp)) call abort()
+if (abs(log_gamma(1.0_qp)) > tiny(1.0_qp)) call abort()
+end program gamma_test
+
diff --git a/gcc/testsuite/gfortran.dg/gamma_5.f90 b/gcc/testsuite/gfortran.dg/gamma_5.f90
new file mode 100644
index 000000000..467c57962
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gamma_5.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+! PR 33683 - we used to pick up the wrong gamma function
+! from the library on some systems.
+program main
+  implicit none
+  integer, parameter :: n_max = 20
+  double precision, dimension(0:n_max) :: c
+  double precision :: pi
+  integer :: n
+  double precision :: td, xd
+  real :: ts,xs
+
+  pi = 4 * atan(1.d0)
+  c(0) = 1.
+  do n=1, n_max
+     c(n) = (2*n-1)*c(n-1)*0.5d0
+  end do
+
+  do n=1, n_max
+     xs = n + 0.5
+     xd = n + 0.5d0
+     td = c(n)*sqrt(pi)
+     ts = c(n)*sqrt(pi)
+     if (abs(gamma(xs)-ts)/ts > 9e-6) call abort
+     if (abs(gamma(xd)-td)/td > 5e-14) call abort
+  end do
+  call tst_s(2.3, gamma(2.3))
+  call tst_s(3.7, gamma(3.7))
+  call tst_s(5.5, gamma(5.5))
+  call tst_d(4.2d0, gamma(4.2d0))
+  call tst_d(8.1d0, gamma(8.1d0))
+contains
+  subroutine tst_s(a, b)
+    real :: a, b
+    if (abs(gamma(a) - b)/b > 1e-6) call abort
+  end subroutine tst_s
+
+  subroutine tst_d(a, b)
+    double precision :: a,b
+    if (abs(gamma(a) - b)/b > 5e-14) call abort
+  end subroutine tst_d
+end program main
diff --git a/gcc/testsuite/gfortran.dg/generic_1.f90 b/gcc/testsuite/gfortran.dg/generic_1.f90
new file mode 100644
index 000000000..12077dab5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_1.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! reduced testcase from PR 17535
+module FOO
+  interface BAR
+
+    subroutine BAR1(X)
+      integer :: X
+    end subroutine
+
+    subroutine BAR2(X)
+      real :: X
+    end subroutine
+
+  end interface
+end module
+
+subroutine BAZ(X)
+  use FOO
+end subroutine
+
+! { dg-final { cleanup-modules "FOO" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_10.f90 b/gcc/testsuite/gfortran.dg/generic_10.f90
new file mode 100644
index 000000000..8f9ff6fcb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_10.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! Test the patch for PR30081 in which non-generic intrinsic
+! procedures could not be overloaded by generic interfaces.
+!
+! Contributed by Harald Anlauf  <anlauf@gmx.de>
+!
+module gfcbug46
+  interface random_seed
+     module procedure put_seed
+  end interface
+  interface random_number
+     module procedure random_vector
+  end interface
+  type t_t
+     real :: x(2)
+  end type t_t
+contains
+  subroutine put_seed (n, seed)
+    integer, intent(inout) :: n
+    integer, intent(in)    :: seed
+    call random_seed (size=n)
+  end subroutine put_seed
+  subroutine random_vector (t)
+    type(t_t) :: t
+    call random_number (t% x)
+  end subroutine random_vector
+end module gfcbug46
+
+  use gfcbug46
+  type(t_t) :: z
+  integer :: n = 2, seed = 1
+  call put_seed (n, seed)
+  call random_number (z)
+  print *, z
+end
+! { dg-final { cleanup-modules "gfcbug46" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_11.f90 b/gcc/testsuite/gfortran.dg/generic_11.f90
new file mode 100644
index 000000000..7547a43da
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_11.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! Test the fix for PR25135 in which the ambiguity between subroutine
+! foo in m_foo and interface foo in m_bar was not recognised.
+!
+!Contributed by Yusuke IGUCHI <iguchi@coral.t.u-tokyo.ac.jp>
+!
+module m_foo
+contains
+  subroutine foo
+    print *, "foo"
+  end subroutine
+end module
+
+module m_bar
+  interface foo
+    module procedure bar
+  end interface
+contains
+  subroutine bar
+    print *, "bar"
+  end subroutine
+end module
+
+use m_foo
+use m_bar
+
+call foo ! { dg-error "is an ambiguous reference" } 
+end
+! { dg-final { cleanup-modules "m_foo m_bar" } }
+
+
diff --git a/gcc/testsuite/gfortran.dg/generic_12.f90 b/gcc/testsuite/gfortran.dg/generic_12.f90
new file mode 100644
index 000000000..59c3c96e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_12.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! Test the fix for PR30476 in which the generic interface hello
+! was found incorrectly to be ambiguous.
+!
+!Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+SUBROUTINE hello_x(dum)
+   IMPLICIT NONE
+   INTEGER :: dum
+   WRITE(0,*) "Hello world: ", dum
+END SUBROUTINE hello_x
+
+MODULE interfaces
+IMPLICIT NONE
+INTERFACE hello
+   SUBROUTINE hello_x(dum)
+      IMPLICIT NONE
+      INTEGER :: dum
+   END SUBROUTINE hello_x
+END INTERFACE
+END MODULE interfaces
+
+MODULE global_module
+  USE interfaces
+END MODULE global_module
+
+PROGRAM main
+  USE global_module
+  IMPLICIT NONE
+  CALL hello(10)
+END PROGRAM main
+! { dg-final { cleanup-modules "interfaces global_module" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_13.f90 b/gcc/testsuite/gfortran.dg/generic_13.f90
new file mode 100644
index 000000000..566134511
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_13.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! tests the patch for PR30870, in which the generic XX was rejected
+! because the specific with the same name was not looked for.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+MODULE TEST
+ INTERFACE xx
+   MODULE PROCEDURE xx
+ END INTERFACE
+ public :: xx
+CONTAINS
+ SUBROUTINE xx(i)
+  INTEGER :: I
+  I=7
+ END SUBROUTINE
+END
+MODULE TOO
+CONTAINS
+ SUBROUTINE SUB(xx,I)
+  INTERFACE
+    SUBROUTINE XX(I)
+        INTEGER :: I
+    END SUBROUTINE
+  END INTERFACE
+  CALL XX(I)
+ END SUBROUTINE
+END MODULE TOO
+PROGRAM TT
+ USE TEST
+ USE TOO
+ INTEGER :: I
+ CALL SUB(xx,I)
+ IF (I.NE.7) CALL ABORT()
+END PROGRAM
+! { dg-final { cleanup-modules "test too" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_14.f90 b/gcc/testsuite/gfortran.dg/generic_14.f90
new file mode 100644
index 000000000..e95f6f2ed
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_14.f90
@@ -0,0 +1,105 @@
+! { dg-do compile }
+!
+! Check whether MODULE PROCEDUREs are properly treated
+! They need to be contained in a procedure, i.e. an
+! interface in another procedure is invalid; they may, however,
+! come from a use-associated procedure.
+! (The PROCEDURE statement allows also for non-module procedures
+!  if there is an explicit interface.)
+!
+! PR fortran/33228
+!
+module inclmod
+  implicit none
+  interface
+    subroutine wrong1(a)
+      integer :: a
+    end subroutine wrong1
+  end interface
+  interface gen_incl
+    module procedure ok1
+  end interface gen_incl
+  external wrong2
+  external wrong3
+  real wrong3
+contains
+  subroutine ok1(f)
+    character :: f
+  end subroutine ok1
+end module inclmod
+
+module a
+  use inclmod
+  implicit none
+  interface gen
+    subroutine ok1_a(a,b)
+      integer :: a,b
+    end subroutine ok1_a
+    module procedure ok1, ok2_a
+  end interface gen
+contains
+  subroutine ok2_a(a,b,c)
+     integer :: a,b,c
+  end subroutine ok2_a
+end module a
+
+module b
+  use inclmod
+  interface gen_wrong_0
+    module procedure gen_incl  ! { dg-error "Cannot change attributes" }
+  end interface gen_wrong_0
+end module b
+
+module c
+  use inclmod
+  interface gen_wrong_1
+    module procedure wrong1  ! { dg-error "is not a module procedure" }
+  end interface gen_wrong_1
+end module c
+
+module d
+  use inclmod
+  interface gen_wrong_2
+    module procedure wrong2  ! { dg-error "Cannot change attributes" }
+  end interface gen_wrong_2
+end module d
+
+module e
+  use inclmod
+  interface gen_wrong_3
+    module procedure wrong3  ! { dg-error "Cannot change attributes" }
+  end interface gen_wrong_3
+end module e
+
+module f
+  implicit none
+  interface
+    subroutine wrong_a(a)
+      integer :: a
+    end subroutine wrong_a
+  end interface
+  interface gen_wrong_4
+    module procedure wrong_a  ! { dg-error "is not a module procedure" }
+  end interface gen_wrong_4
+end module f
+
+module g
+  implicit none
+  external wrong_b
+  interface gen_wrong_5
+    module procedure wrong_b  ! { dg-error "has no explicit interface" }
+  end interface gen_wrong_5
+end module g
+
+module h
+  implicit none
+  external wrong_c
+  real wrong_c
+  interface gen_wrong_6
+    module procedure wrong_c  ! { dg-error "has no explicit interface" }
+  end interface gen_wrong_6
+end module h
+
+end
+
+! { dg-final { cleanup-modules "a inclmod" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_15.f90 b/gcc/testsuite/gfortran.dg/generic_15.f90
new file mode 100644
index 000000000..127868473
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_15.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+! Test the fix for PR34231, in which the assumed size 'cnames'
+! would be wrongly associated with the scalar argument.
+!
+! Contributed by <francois.jacq@irsn.fr>
+!
+MODULE test
+
+   TYPE odbase ; INTEGER :: value ; END TYPE
+
+   INTERFACE odfname
+      MODULE PROCEDURE odfamilycname,odfamilycnames
+   END INTERFACE
+
+   CONTAINS
+
+   SUBROUTINE odfamilycnames(base,nfam,cnames)
+      TYPE(odbase),INTENT(in)  :: base
+      INTEGER     ,INTENT(out) :: nfam
+      CHARACTER(*),INTENT(out) :: cnames(*)
+      cnames(1:nfam)='odfamilycnames'
+   END SUBROUTINE
+
+   SUBROUTINE odfamilycname(base,pos,cname)
+      TYPE(odbase),INTENT(in)  :: base
+      INTEGER     ,INTENT(in)  :: pos
+      CHARACTER(*),INTENT(out) :: cname
+      cname='odfamilycname'
+   END SUBROUTINE
+
+END MODULE
+
+PROGRAM main
+  USE test
+  TYPE(odbase) :: base
+  INTEGER :: i=1
+  CHARACTER(14) :: cname
+  CHARACTER(14) :: cnames(1)
+  CALL odfname(base,i,cname)
+  if (trim (cname) .ne. "odfamilycname") call abort
+  CALL odfname(base,i,cnames)
+  if (trim (cnames(1)) .ne. "odfamilycnames") call abort
+END PROGRAM
+! { dg-final { cleanup-modules "test" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_16.f90 b/gcc/testsuite/gfortran.dg/generic_16.f90
new file mode 100644
index 000000000..501e146bc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_16.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! PR35478 internal compiler error: Segmentation fault
+MODULE auxiliary
+  IMPLICIT NONE
+  INTEGER, PARAMETER, PRIVATE :: dp = SELECTED_REAL_KIND(15)
+  INTERFACE median
+     MODULE PROCEDURE R_valmed, I_valmed, D_valmed
+  END INTERFACE
+  PUBLIC  :: median
+  PRIVATE :: R_valmed, I_valmed, D_valmed
+CONTAINS
+  RECURSIVE FUNCTION D_valmed (XDONT) RESULT (res_med)
+    Real (kind=dp), Dimension (:), Intent (In) :: XDONT
+    Real (kind=dp) :: res_med
+    res_med = 0.0d0
+  END FUNCTION D_valmed
+  RECURSIVE FUNCTION R_valmed (XDONT) RESULT (res_med)
+    Real, Dimension (:), Intent (In) :: XDONT
+    Real :: res_med
+    res_med = 0.0
+  END FUNCTION R_valmed
+  RECURSIVE FUNCTION I_valmed (XDONT) RESULT (res_med)
+    Integer, Dimension (:), Intent (In)  :: XDONT
+    Integer :: res_med
+    res_med = 0
+  END FUNCTION I_valmed
+END MODULE auxiliary
+PROGRAM main
+  USE auxiliary
+  IMPLICIT NONE
+  INTEGER, PARAMETER    :: dp = SELECTED_REAL_KIND(15)
+  REAL(kind=dp) :: rawData(2), data, work(3)
+  data = median(rawData, work) ! { dg-error "no specific function" }
+END PROGRAM main
+! { dg-final { cleanup-modules "auxiliary" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_17.f90 b/gcc/testsuite/gfortran.dg/generic_17.f90
new file mode 100644
index 000000000..968d9c10c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_17.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+! Test the patch for PR36374 in which the different
+! symbols for 'foobar' would be incorrectly flagged as
+! ambiguous in foo_mod.
+!
+! Contributed by Salvatore Filippone  <sfilippone@uniroma2.it>
+!
+module s_foo_mod

+  type s_foo_type

+    real(kind(1.e0)) :: v

+  end type s_foo_type

+  interface foobar

+    subroutine s_foobar(x)

+      import 

+      type(s_foo_type), intent (inout) :: x

+    end subroutine s_foobar

+  end interface

+end module s_foo_mod

+

+module d_foo_mod

+  type d_foo_type

+    real(kind(1.d0)) :: v

+  end type d_foo_type

+  interface foobar

+    subroutine d_foobar(x)

+      import  

+      type(d_foo_type), intent (inout) :: x

+    end subroutine d_foobar

+  end interface

+end module d_foo_mod

+

+module foo_mod

+  use s_foo_mod

+  use d_foo_mod

+end module foo_mod

+

+subroutine s_foobar(x)  

+  use foo_mod

+end subroutine s_foobar

+! { dg-final { cleanup-modules "s_foo_mod d_foo_mod foo_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_18.f90 b/gcc/testsuite/gfortran.dg/generic_18.f90
new file mode 100644
index 000000000..1e23838d7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_18.f90
@@ -0,0 +1,54 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for PR40443 in which the final call to the generic
+! 'SpecElem' was resolved to the elemental rather than the specific
+! procedure, which is required by the second part of 12.4.4.1.
+!
+! Contributed by Ian Harvey <ian_harvey@bigpond.com>
+!
+MODULE SomeOptions
+  IMPLICIT NONE  
+  INTERFACE ElemSpec
+    MODULE PROCEDURE ElemProc
+    MODULE PROCEDURE SpecProc
+  END INTERFACE ElemSpec  
+  INTERFACE SpecElem
+    MODULE PROCEDURE SpecProc
+    MODULE PROCEDURE ElemProc
+  END INTERFACE SpecElem
+CONTAINS
+  ELEMENTAL SUBROUTINE ElemProc(a)  
+    CHARACTER, INTENT(OUT) :: a
+    !****
+    a = 'E'            
+  END SUBROUTINE ElemProc
+
+  SUBROUTINE SpecProc(a)  
+    CHARACTER, INTENT(OUT) :: a(:)
+    !****    
+    a = 'S'    
+  END SUBROUTINE SpecProc
+END MODULE SomeOptions
+
+PROGRAM MakeAChoice
+  USE SomeOptions  
+  IMPLICIT NONE
+  CHARACTER scalar, array(2)    
+  !****
+  CALL ElemSpec(scalar) ! Should choose the elemental (and does)
+  WRITE (*, 100) scalar
+  CALL ElemSpec(array)  ! Should choose the specific (and does)
+  WRITE (*, 100) array
+  !----
+  CALL SpecElem(scalar) ! Should choose the elemental (and does)
+  WRITE (*, 100) scalar
+  CALL SpecElem(array)  ! Should choose the specific (but didn't)
+  WRITE (*, 100) array  
+  !----
+  100 FORMAT(A,:,', ',A)
+END PROGRAM MakeAChoice
+! { dg-final { scan-tree-dump-times "specproc" 3 "original" } }
+! { dg-final { scan-tree-dump-times "elemproc" 3 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-modules "SomeOptions" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_19.f90 b/gcc/testsuite/gfortran.dg/generic_19.f90
new file mode 100644
index 000000000..f023c5e63
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_19.f90
@@ -0,0 +1,37 @@
+! { dg-do compile }
+! Test the fix for PR42481, in which 'sub' was not recognised as
+! a generic interface.
+!
+! Contributed by William Mitchell < william.mitchell@nist.gov>
+!
+module mod1
+contains
+  subroutine sub(x, chr)
+    real x
+    character(8) chr
+    if (trim (chr) .ne. "real") call abort
+    if (int (x) .ne. 1) call abort
+  end subroutine sub
+end module mod1
+
+module mod2
+  use mod1
+  interface sub
+    module procedure sub, sub_int
+  end interface sub
+contains
+  subroutine sub_int(i, chr)
+    character(8) chr
+    integer i
+    if (trim (chr) .ne. "integer") call abort
+    if (i .ne. 1) call abort
+  end subroutine sub_int
+end module mod2
+
+program prog
+  use mod1
+  use mod2
+  call sub(1, "integer ")
+  call sub(1.0, "real    ")
+end program prog
+! { dg-final { cleanup-modules "mod1 mod2" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_2.f90 b/gcc/testsuite/gfortran.dg/generic_2.f90
new file mode 100644
index 000000000..459dd7ec8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_2.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! testcase from PR 17583
+module bidon 
+ 
+ interface 
+  subroutine drivexc(nspden,rho_updn) 
+   integer,  intent(in) :: nspden 
+   integer, intent(in) :: rho_updn(nspden) 
+  end subroutine drivexc 
+ end interface 
+ 
+end module bidon 
+ 
+ subroutine nonlinear(nspden) 
+ 
+ use bidon 
+  
+ integer,intent(in) :: nspden 
+ 
+ end subroutine nonlinear
+
+! { dg-final { cleanup-modules "bidon" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_20.f90 b/gcc/testsuite/gfortran.dg/generic_20.f90
new file mode 100644
index 000000000..04a57b090
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_20.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+!
+! PR fortran/39304
+!
+! matmul checking was checking the wrong specific function
+! ("one" instead of "two")
+!
+module m
+  implicit none
+  interface one
+    module procedure one, two
+  end interface one
+contains
+  function one()
+    real :: one(1)
+    one = 0.0
+  end function one
+  function two(x)
+    real :: x
+    real :: two(1,1)
+    two = reshape ( (/ x /), (/ 1, 1 /) )
+  end function two
+end module m
+
+use m
+real :: res(1)
+res = matmul (one(2.0), (/ 2.0/))
+if (abs (res(1)-4.0) > epsilon (res)) call abort ()
+end
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_21.f90 b/gcc/testsuite/gfortran.dg/generic_21.f90
new file mode 100644
index 000000000..c651e6394
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_21.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+!
+! PR fortran/42858
+!
+! Contributed by Harald Anlauf
+!
+module gfcbug102
+  implicit none
+  type t_vector_segm
+     real ,pointer :: x(:) => NULL()
+  end type t_vector_segm
+
+  type t_vector
+     integer                       :: n_s     =  0
+     type (t_vector_segm) ,pointer :: s (:)   => NULL()
+  end type t_vector
+
+  interface sqrt
+     module procedure sqrt_vector
+  end interface sqrt
+
+contains
+  function sqrt_vector (x) result (y)
+    type (t_vector)             :: y
+    type (t_vector) ,intent(in) :: x
+    integer :: i
+    do i = 1, y% n_s
+       y% s(i)% x = sqrt (x% s(i)% x)
+    end do
+  end function sqrt_vector
+end module gfcbug102
+
+! { dg-final { cleanup-modules "gfcbug102" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_22.f03 b/gcc/testsuite/gfortran.dg/generic_22.f03
new file mode 100644
index 000000000..1da49dee9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_22.f03
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! Test the fix for PR43492, in which the generic call caused and ICE.
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+!
+module base_mod
+  
+  type  :: base_mat
+    integer, private     :: m, n
+  contains 
+    procedure, pass(a) :: transp1 => base_transp1
+    generic, public    :: transp => transp1
+    procedure, pass(a) :: transc1 => base_transc1
+    generic, public    :: transc => transc1
+  end type base_mat
+
+contains
+
+  subroutine base_transp1(a)
+    implicit none 
+    
+    class(base_mat), intent(inout) :: a
+    integer :: itmp
+    itmp        = a%m
+    a%m         = a%n
+    a%n         = itmp
+  end subroutine base_transp1
+  subroutine base_transc1(a)
+    implicit none 
+    class(base_mat), intent(inout) :: a
+    
+    call a%transp() 
+!!$    call a%transp1() 
+  end subroutine base_transc1
+
+
+end module base_mod
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_23.f03 b/gcc/testsuite/gfortran.dg/generic_23.f03
new file mode 100644
index 000000000..eab185b48
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_23.f03
@@ -0,0 +1,67 @@
+! { dg-do run }
+! Test the fix for PR43945 in which the over-ridding of 'doit' and
+! 'getit' in type 'foo2' was missed in the specific binding to 'do' and 'get'.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+! and reported to clf by Salvatore Filippone <sfilippone@uniroma2.it>
+!
+module foo_mod
+  type foo
+    integer :: i
+  contains
+    procedure, pass(a) :: doit
+    procedure, pass(a) :: getit
+    generic, public :: do  => doit
+    generic, public :: get => getit
+  end type foo
+  private doit,getit
+contains
+  subroutine  doit(a)
+    class(foo) :: a
+    a%i = 1
+    write(*,*) 'FOO%DOIT base version'
+  end subroutine doit
+  function getit(a) result(res)
+    class(foo) :: a
+    integer :: res
+    res = a%i
+  end function getit
+end module foo_mod
+
+module foo2_mod
+  use foo_mod
+  type, extends(foo) :: foo2
+    integer :: j
+  contains
+    procedure, pass(a) :: doit  => doit2
+    procedure, pass(a) :: getit => getit2
+!!$    generic, public :: do  => doit
+!!$    generic, public :: get => getit
+  end type foo2
+  private doit2, getit2
+
+contains
+
+  subroutine  doit2(a)
+    class(foo2) :: a
+    a%i = 2
+    a%j = 3
+  end subroutine doit2
+  function getit2(a) result(res)
+    class(foo2) :: a
+    integer :: res
+    res = a%j
+  end function getit2
+end module foo2_mod
+
+program testd15
+  use foo2_mod
+  type(foo2) :: af2
+
+  call af2%do()
+  if (af2%i .ne. 2) call abort
+  if (af2%get() .ne. 3) call abort
+
+end program testd15
+
+! { dg-final { cleanup-modules "foo_mod foo2_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_24.f90 b/gcc/testsuite/gfortran.dg/generic_24.f90
new file mode 100644
index 000000000..2388722b5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_24.f90
@@ -0,0 +1,100 @@
+! { dg-do compile }
+!
+! PR fortran/48889
+!
+! Thanks for
+! reporting to Lawrence Mitchell
+! for the test case to David Ham
+!
+module sparse_tools
+  implicit none
+  private
+  
+  type csr_foo
+     integer, dimension(:), pointer :: colm=>null()
+  end type csr_foo
+  
+  type block_csr_matrix
+     type(csr_foo) :: sparsity
+  end type block_csr_matrix
+
+  interface attach_block
+     module procedure block_csr_attach_block
+  end interface
+
+  interface size
+     module procedure  sparsity_size 
+  end interface
+  
+  public :: size, attach_block
+contains
+  subroutine block_csr_attach_block(matrix, val)
+    type(block_csr_matrix), intent(inout) :: matrix
+    real, dimension(size(matrix%sparsity%colm)), intent(in), target :: val
+  end subroutine block_csr_attach_block
+
+  pure function sparsity_size(sparsity, dim)
+    integer :: sparsity_size
+    type(csr_foo), intent(in) :: sparsity
+    integer, optional, intent(in) :: dim
+  end function sparsity_size
+end module sparse_tools
+
+module global_numbering
+  use sparse_tools
+  implicit none
+  
+  type ele_numbering_type
+     integer :: boundaries
+  end type ele_numbering_type
+
+  type element_type
+     integer :: loc 
+     type(ele_numbering_type), pointer :: numbering=>null()
+  end type element_type
+
+  type csr_sparsity
+  end type csr_sparsity
+  
+  interface size
+     module procedure sparsity_size
+  end interface size
+contains
+  pure function sparsity_size(sparsity, dim)
+    integer :: sparsity_size
+    type(csr_sparsity), intent(in) :: sparsity
+    integer, optional, intent(in) :: dim
+  end function sparsity_size
+
+  subroutine make_boundary_numbering(EEList, xndglno, ele_n)
+    type(csr_sparsity), intent(in) :: EEList
+    type(element_type), intent(in) :: ele_n
+    integer, dimension(size(EEList,1)*ele_n%loc), intent(in), target ::&
+         & xndglno 
+    integer, dimension(ele_n%numbering%boundaries) :: neigh
+    integer :: j
+    j=size(neigh)
+  end subroutine make_boundary_numbering
+end module global_numbering
+
+module sparse_matrices_fields
+  use sparse_tools
+implicit none
+   type scalar_field
+      real, dimension(:), pointer :: val
+   end type scalar_field
+contains  
+  subroutine csr_mult_T_scalar(x)
+    type(scalar_field), intent(inout) :: x
+    real, dimension(:), allocatable :: tmp
+    integer :: i
+    i=size(x%val)
+  end subroutine csr_mult_T_scalar
+end module sparse_matrices_fields
+
+program test
+  use sparse_matrices_fields
+  use global_numbering
+end program test
+
+! { dg-final { cleanup-modules "sparse_tools sparse_matrices_fields global_numbering" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_3.f90 b/gcc/testsuite/gfortran.dg/generic_3.f90
new file mode 100644
index 000000000..549260385
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_3.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! Testcase from PR 17713
+module fit_functions
+  implicit none
+contains
+  subroutine gauss( x, a, y, dy, ma )
+    double precision, intent(in)     :: x
+    double precision, intent(in)     :: a(:)
+    double precision, intent(out)    :: y
+    double precision, intent(out)    :: dy(:)
+    integer,          intent(in)     :: ma
+  end subroutine gauss
+end module fit_functions
+
+subroutine mrqcof( x, y, sig, ndata, a, ia, ma )
+  use fit_functions
+  
+  implicit none
+  double precision, intent(in)   :: x(:), y(:), sig(:)
+  integer,   intent(in)          :: ndata
+  double precision, intent(in)   :: a(:)
+  integer,   intent(in)          :: ia(:), ma
+  
+  integer                           i
+  double precision                  yan, dyda(ma)
+  
+  do i = 1, ndata
+     call gauss( x(i), a, yan, dyda, ma )
+  end do
+end subroutine mrqcof
+
+! { dg-final { cleanup-modules "fit_functions" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_4.f90 b/gcc/testsuite/gfortran.dg/generic_4.f90
new file mode 100644
index 000000000..48c32a674
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_4.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! reduced testcase from PR 17740
+module FOO
+
+  interface BAR
+     module procedure BAR2
+  end interface
+
+contains
+
+  elemental integer function BAR2(X)
+    integer, intent(in) :: X
+    BAR2 = X
+  end function
+
+  subroutine BAZ(y,z)
+    integer :: Y(3), Z(3)
+    Z = BAR(Y)
+  end subroutine
+
+end module
+
+use foo
+integer :: y(3), z(3)
+y = (/1,2,3/)
+call baz(y,z)
+if (any (y /= z)) call abort ()
+end
+
+! { dg-final { cleanup-modules "FOO" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_5.f90 b/gcc/testsuite/gfortran.dg/generic_5.f90
new file mode 100644
index 000000000..cb7209803
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_5.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! Tests the patch for PR28201, in which the call to ice would cause an ICE
+! because resolve.c(resolve_generic_s) would try to look in the parent
+! namespace to see if the subroutine was part of a legal generic interface.
+! In this case, there is nothing to test, hence the ICE.
+!
+! Contributed by Daniel Franke  <franke.daniel@gmail.com>
+!
+!
+MODULE ice_gfortran
+  INTERFACE ice
+    MODULE PROCEDURE ice_i
+  END INTERFACE
+
+CONTAINS
+  SUBROUTINE ice_i(i)
+    INTEGER, INTENT(IN) :: i
+    ! do nothing
+  END SUBROUTINE
+END MODULE
+
+MODULE provoke_ice
+CONTAINS
+  SUBROUTINE provoke
+    USE ice_gfortran
+    CALL ice(23.0)   ! { dg-error "no specific subroutine" }
+  END SUBROUTINE
+END MODULE
+! { dg-final { cleanup-modules "ice_gfortran provoke_ice" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_6.f90 b/gcc/testsuite/gfortran.dg/generic_6.f90
new file mode 100644
index 000000000..9d08ac223
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_6.f90
@@ -0,0 +1,49 @@
+! { dg-do compile }
+! Tests the patch for PR28873, in which the call create () would cause an
+! error because resolve.c(resolve_generic_s) was failing to look in the
+! parent namespace for a matching specific subroutine. This, in fact, was
+! a regression due to the fix for PR28201.
+!
+! Contributed by Drew McCormack  <drewmccormack@mac.com> 
+!
+module A
+  private 
+  interface create
+    module procedure create1 
+  end interface
+  public :: create
+contains
+  subroutine create1
+    print *, "module A"
+  end subroutine
+end module
+
+module B
+  private 
+  interface create
+    module procedure create1 
+  end interface
+  public :: create
+contains
+  subroutine create1(a)
+    integer a
+    print *, "module B"
+  end subroutine
+end module
+
+module C
+  use A
+  private
+  public useCreate
+contains
+  subroutine useCreate
+    use B
+    call create()
+    call create(1)
+  end subroutine
+end module
+
+  use c
+  call useCreate
+end
+! { dg-final { cleanup-modules "A B C" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_7.f90 b/gcc/testsuite/gfortran.dg/generic_7.f90
new file mode 100644
index 000000000..e520c0973
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_7.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! Tests the fix for PR29652, in which ambiguous interfaces were not detected
+! with more than two specific procedures in the interface.
+!
+! Contributed by Daniel Franke  <franke.daniel@gmail.com>
+!
+MODULE global
+INTERFACE iface
+  MODULE PROCEDURE sub_a
+  MODULE PROCEDURE sub_b ! { dg-error "Ambiguous interfaces" }
+  MODULE PROCEDURE sub_c
+END INTERFACE
+CONTAINS
+  SUBROUTINE sub_a(x)
+    INTEGER, INTENT(in) :: x
+    WRITE (*,*) 'A: ', x
+  END SUBROUTINE
+  SUBROUTINE sub_b(y)
+    INTEGER, INTENT(in) :: y
+    WRITE (*,*) 'B: ', y
+  END SUBROUTINE
+  SUBROUTINE sub_c(x, y)
+    REAL, INTENT(in) :: x, y
+    WRITE(*,*) x, y
+  END SUBROUTINE
+END MODULE
+
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_8.f90 b/gcc/testsuite/gfortran.dg/generic_8.f90
new file mode 100644
index 000000000..a129efe4c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_8.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! Tests the fix for PR29837, in which the following valid code
+! would emit an error because of mistaken INTENT; the wrong
+! specific interface would be used for the comparison.
+!
+! Contributed by 
+!
+MODULE M
+  IMPLICIT NONE
+  INTERFACE A
+    MODULE PROCEDURE A1,A2
+  END INTERFACE
+CONTAINS
+
+  SUBROUTINE A2(X)
+    INTEGER, INTENT(INOUT) :: X
+  END SUBROUTINE A2
+
+  SUBROUTINE A1(X,Y)
+    INTEGER, INTENT(IN) :: X
+    INTEGER, INTENT(OUT) :: Y
+    Y=X
+  END SUBROUTINE A1
+
+  SUBROUTINE T(X)
+    INTEGER, INTENT(IN) :: X(:)
+    INTEGER Y
+    CALL A(MAXVAL(X),Y)
+  END SUBROUTINE T
+END MODULE M
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_9.f90 b/gcc/testsuite/gfortran.dg/generic_9.f90
new file mode 100644
index 000000000..92dd65096
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_9.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! Test the patch for PR29992. The standard requires that a
+! module procedure be contained in the same scope as the
+! interface or is use associated to it(12.3.2.1).
+!
+! Contributed by Daniel Franke  <franke.daniel@gmail.com>
+!
+MODULE class_foo_type
+  TYPE :: foo
+    INTEGER :: dummy
+  END TYPE
+contains
+  SUBROUTINE bar_init_set_int(this, value)
+    TYPE(foo), INTENT(out) :: this
+    integer, intent(in) :: value
+    this%dummy = value
+  END SUBROUTINE
+END MODULE
+
+MODULE class_foo
+USE class_foo_type, ONLY: foo, bar_init_set_int
+
+INTERFACE foo_init
+  MODULE PROCEDURE foo_init_default  ! { dg-error "is not a module procedure" }
+END INTERFACE
+
+INTERFACE bar_init
+  MODULE PROCEDURE bar_init_default, bar_init_set_int  ! These are OK
+END INTERFACE
+
+INTERFACE
+  SUBROUTINE foo_init_default(this)
+    USE class_foo_type, ONLY: foo
+    TYPE(foo), INTENT(out) :: this
+  END SUBROUTINE
+END INTERFACE
+
+contains
+  SUBROUTINE bar_init_default(this)
+    TYPE(foo), INTENT(out) :: this
+    this%dummy = 42
+  END SUBROUTINE
+
+END MODULE
+! { dg-final { cleanup-modules "class_foo_type class_foo" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_actual_arg.f90 b/gcc/testsuite/gfortran.dg/generic_actual_arg.f90
new file mode 100644
index 000000000..17c50627f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_actual_arg.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! Tests fix for PR20886 in which the passing of a generic procedure as
+! an actual argument was not detected.
+!
+! The second module and the check that CALCULATION2 is a good actual
+! argument was added following the fix for PR26374.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk> 
+!
+MODULE TEST
+INTERFACE CALCULATION
+  MODULE PROCEDURE C1, C2
+END INTERFACE
+CONTAINS
+SUBROUTINE C1(r)
+ INTEGER :: r
+END SUBROUTINE
+SUBROUTINE C2(r)
+ REAL :: r
+END SUBROUTINE
+END MODULE TEST
+
+MODULE TEST2
+INTERFACE CALCULATION2
+  MODULE PROCEDURE CALCULATION2, C3
+END INTERFACE
+CONTAINS
+SUBROUTINE CALCULATION2(r)
+ INTEGER :: r
+END SUBROUTINE
+SUBROUTINE C3(r)
+ REAL :: r
+END SUBROUTINE
+END MODULE TEST2
+    
+USE TEST
+USE TEST2
+CALL F(CALCULATION)  ! { dg-error "GENERIC procedure" } 
+
+CALL F(CALCULATION2) ! OK because there is a same name specific, but: ! { dg-error "More actual than formal arguments" }
+END
+
+SUBROUTINE F()
+END SUBROUTINE
+! { dg-final { cleanup-modules "TEST TEST2" } }
diff --git a/gcc/testsuite/gfortran.dg/generic_typebound_operator_1.f90 b/gcc/testsuite/gfortran.dg/generic_typebound_operator_1.f90
new file mode 100644
index 000000000..76c15e97b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_typebound_operator_1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! PR fortran/45916
+! ICE with generic type-bound operator
+
+module m_sort
+  implicit none
+  type, abstract :: sort_t
+  contains
+    generic :: operator(.gt.) => gt_cmp
+    procedure(gt_cmp), deferred :: gt_cmp
+  end type sort_t
+  interface
+    logical function gt_cmp(a,b)
+      import
+      class(sort_t), intent(in) :: a, b
+    end function gt_cmp
+  end interface
+end module m_sort
diff --git a/gcc/testsuite/gfortran.dg/getenv_1.f90 b/gcc/testsuite/gfortran.dg/getenv_1.f90
new file mode 100644
index 000000000..fb0a809e6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/getenv_1.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! Test the getenv and get_environment_variable intrinsics.
+! Ignore the return value because it's not supported/meaningful on all targets
+program getenv_1
+  implicit none
+  character(len=101) ::  var
+  character(len=*), parameter :: home = 'HOME'
+  integer :: len, stat
+  call getenv(name=home, value=var)
+  call get_environment_variable(name=home, value=var, &
+       length=len, status=stat)
+end program getenv_1
diff --git a/gcc/testsuite/gfortran.dg/global_references_1.f90 b/gcc/testsuite/gfortran.dg/global_references_1.f90
new file mode 100644
index 000000000..7e0a5bd0a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/global_references_1.f90
@@ -0,0 +1,100 @@
+! { dg-do compile }
+! This program tests the patch for PRs 20881, 23308, 25538 & 25710
+! Assembled from PRs by Paul Thomas  <pault@gcc.gnu.org>
+module m
+contains
+  subroutine g(x)   ! Local entity
+    REAL :: x
+    x = 1.0
+  end subroutine g
+end module m
+! Error only appears once but testsuite associates with both lines.
+function f(x)       ! { dg-error "is already being used as a FUNCTION" }
+  REAL :: f, x
+  f = x
+end function f
+
+function g(x)       ! Global entity
+  REAL :: g, x
+  g = x
+
+! PR25710==========================================================
+! Lahey -2607-S: "SOURCE.F90", line 26: 
+! Function 'f' cannot be referenced as a subroutine. The previous
+! definition is in 'line 12'.
+
+  call f(g) ! { dg-error "is already being used as a FUNCTION" }
+end function g
+! Error only appears once but testsuite associates with both lines.
+function h(x)       ! { dg-error "is already being used as a FUNCTION" }
+  REAL :: h, x
+  h = x
+end function h
+
+SUBROUTINE TT()
+  CHARACTER(LEN=10), EXTERNAL :: j ! { dg-error "Return type mismatch" }
+  CHARACTER(LEN=10)          :: T
+! PR20881=========================================================== 
+! Error only appears once but testsuite associates with both lines.
+  T = j (1.0) ! { dg-error "is already being used as a SUBROUTINE" }
+  print *, T
+END SUBROUTINE TT
+
+  use m             ! Main program
+  real x
+  integer a(10)
+
+! PR23308===========================================================
+! Lahey - 2604-S: "SOURCE.F90", line 52:
+! The name 'foo' cannot be specified as both external procedure name
+! and common block name. The previous appearance is in 'line 68'.
+! Error only appears once but testsuite associates with both lines.
+  common /foo/ a    ! { dg-error "is already being used as a COMMON" }
+
+  call f (x)        ! OK - reference to local entity
+  call g (x)        !             -ditto-
+
+! PR25710===========================================================
+! Lahey - 2607-S: "SOURCE.F90", line 62:
+! Function 'h' cannot be referenced as a subroutine. The previous
+! definition is in 'line 29'.
+
+  call h (x) ! { dg-error "is already being used as a FUNCTION" }
+
+! PR23308===========================================================
+! Lahey - 2521-S: "SOURCE.F90", line 68: Intrinsic procedure name or
+! external procedure name same as common block name 'foo'.
+
+  call foo () ! { dg-error "is already being used as a COMMON" }
+
+contains
+  SUBROUTINE f (x)  ! Local entity
+    real x
+    x = 2
+  end SUBROUTINE f
+end
+
+! PR20881=========================================================== 
+! Lahey - 2636-S: "SOURCE.F90", line 81:
+! Subroutine 'j' is previously referenced as a function in 'line 39'.
+
+SUBROUTINE j (x)    ! { dg-error "is already being used as a SUBROUTINE" }
+  integer a(10)
+  common /bar/ a    ! Global entity foo
+  real x
+  x = bar(1.0)      ! OK for local procedure to have common block name
+contains
+  function bar (x)
+    real bar, x
+    bar = 2.0*x
+  end function bar
+END SUBROUTINE j
+
+! PR25538===========================================================
+! would ICE with entry and procedure having same names.
+  subroutine link2 (namef) ! { dg-error "is already being used as a SUBROUTINE" }
+    entry link2 (nameg)    ! { dg-error "is already being used as a SUBROUTINE" }
+    return
+  end
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/global_references_2.f90 b/gcc/testsuite/gfortran.dg/global_references_2.f90
new file mode 100644
index 000000000..bf2528006
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/global_references_2.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! This program tests the patch for PR25964. This is a
+! regression that would not allow a common block and a statement
+! to share the same name.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+  common /foo/ a, b, c
+  foo (x) = x + 1.0
+  print *, foo (0.0)
+  end
+
diff --git a/gcc/testsuite/gfortran.dg/global_vars_c_init.f90 b/gcc/testsuite/gfortran.dg/global_vars_c_init.f90
new file mode 100644
index 000000000..15f28f5bd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/global_vars_c_init.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-additional-sources global_vars_c_init_driver.c }
+module global_vars_c_init
+  use, intrinsic :: iso_c_binding, only: c_int
+  implicit none
+
+  integer(c_int), bind(c, name='i') :: I
+
+contains
+  subroutine test_globals() bind(c)
+    ! the value of I is initialized above
+    if(I .ne. 2) then
+       call abort()
+    endif
+  end subroutine test_globals
+end module global_vars_c_init
+
+! { dg-final { cleanup-modules "global_vars_c_init" } }
diff --git a/gcc/testsuite/gfortran.dg/global_vars_c_init_driver.c b/gcc/testsuite/gfortran.dg/global_vars_c_init_driver.c
new file mode 100644
index 000000000..b58c2c966
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/global_vars_c_init_driver.c
@@ -0,0 +1,13 @@
+int i = 2;
+void test_globals(void);
+
+extern void abort(void);
+
+int main(int argc, char **argv)
+{
+   /* verify that i has been initialized by f90 */
+   if(i != 2)
+      abort();
+   test_globals();
+   return 0;
+}/* end main() */
diff --git a/gcc/testsuite/gfortran.dg/global_vars_f90_init.f90 b/gcc/testsuite/gfortran.dg/global_vars_f90_init.f90
new file mode 100644
index 000000000..aa1a60ba4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/global_vars_f90_init.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-additional-sources global_vars_f90_init_driver.c }
+module global_vars_f90_init
+  use, intrinsic :: iso_c_binding, only: c_int
+  implicit none
+
+  integer(c_int), bind(c, name='i') :: I = 2
+
+contains
+  subroutine test_globals() bind(c)
+    ! the value of I is initialized above
+    if(I .ne. 2) then
+       call abort()
+    endif
+  end subroutine test_globals
+end module global_vars_f90_init
+
+! { dg-final { cleanup-modules "global_vars_f90_init" } }
diff --git a/gcc/testsuite/gfortran.dg/global_vars_f90_init_driver.c b/gcc/testsuite/gfortran.dg/global_vars_f90_init_driver.c
new file mode 100644
index 000000000..7869c83f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/global_vars_f90_init_driver.c
@@ -0,0 +1,14 @@
+/* initialized by fortran */
+int i;
+void test_globals(void);
+
+extern void abort(void);
+
+int main(int argc, char **argv)
+{
+   /* verify that i has been initialized by f90 */
+   if(i != 2)
+      abort();
+   test_globals();
+   return 0;
+}/* end main() */
diff --git a/gcc/testsuite/gfortran.dg/gnu_logical_1.F b/gcc/testsuite/gfortran.dg/gnu_logical_1.F
new file mode 100644
index 000000000..3c4a18609
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gnu_logical_1.F
@@ -0,0 +1,91 @@
+! Testcases for the AND, OR and XOR functions (GNU intrinsics).
+! { dg-do run }
+! { dg-options "-ffixed-line-length-none" }
+      integer(kind=1) i1, j1
+      integer(kind=2) i2, j2
+      integer         i4, j4
+      integer(kind=8) i8, j8
+      logical(kind=1) l1, k1
+      logical(kind=2) l2, k2
+      logical         l4, k4
+      logical(kind=8) l8, k8
+
+#define TEST_INTEGER(u,ukind,v,vkind) \
+      ukind = u;\
+      vkind = v;\
+      if (iand(u,v) /= and(ukind, vkind)) call abort;\
+      if (iand(u,v) /= and(vkind, ukind)) call abort;\
+      if (ieor(u,v) /= xor(ukind, vkind)) call abort;\
+      if (ieor(u,v) /= xor(vkind, ukind)) call abort;\
+      if (ior(u,v) /= or(ukind, vkind)) call abort;\
+      if (ior(u,v) /= or(vkind, ukind)) call abort
+
+      TEST_INTEGER(19,i1,6,j1)
+      TEST_INTEGER(19,i1,6,j2)
+      TEST_INTEGER(19,i1,6,j4)
+      TEST_INTEGER(19,i1,6,j8)
+
+      TEST_INTEGER(19,i2,6,j1)
+      TEST_INTEGER(19,i2,6,j2)
+      TEST_INTEGER(19,i2,6,j4)
+      TEST_INTEGER(19,i2,6,j8)
+
+      TEST_INTEGER(19,i4,6,j1)
+      TEST_INTEGER(19,i4,6,j2)
+      TEST_INTEGER(19,i4,6,j4)
+      TEST_INTEGER(19,i4,6,j8)
+
+      TEST_INTEGER(19,i8,6,j1)
+      TEST_INTEGER(19,i8,6,j2)
+      TEST_INTEGER(19,i8,6,j4)
+      TEST_INTEGER(19,i8,6,j8)
+
+
+
+#define TEST_LOGICAL(u,ukind,v,vkind) \
+      ukind = u;\
+      vkind = v;\
+      if ((u .and. v) .neqv. and(ukind, vkind)) call abort;\
+      if ((u .and. v) .neqv. and(vkind, ukind)) call abort;\
+      if (((u .and. .not. v) .or. (.not. u .and. v)) .neqv. xor(ukind, vkind)) call abort;\
+      if (((u .and. .not. v) .or. (.not. u .and. v)) .neqv. xor(vkind, ukind)) call abort;\
+      if ((u .or. v) .neqv. or(ukind, vkind)) call abort;\
+      if ((u .or. v) .neqv. or(vkind, ukind)) call abort
+
+      TEST_LOGICAL(.true.,l1,.false.,k1)
+      TEST_LOGICAL(.true.,l1,.true.,k1)
+      TEST_LOGICAL(.true.,l1,.false.,k2)
+      TEST_LOGICAL(.true.,l1,.true.,k2)
+      TEST_LOGICAL(.true.,l1,.false.,k4)
+      TEST_LOGICAL(.true.,l1,.true.,k4)
+      TEST_LOGICAL(.true.,l1,.false.,k8)
+      TEST_LOGICAL(.true.,l1,.true.,k8)
+
+      TEST_LOGICAL(.true.,l2,.false.,k1)
+      TEST_LOGICAL(.true.,l2,.true.,k1)
+      TEST_LOGICAL(.true.,l2,.false.,k2)
+      TEST_LOGICAL(.true.,l2,.true.,k2)
+      TEST_LOGICAL(.true.,l2,.false.,k4)
+      TEST_LOGICAL(.true.,l2,.true.,k4)
+      TEST_LOGICAL(.true.,l2,.false.,k8)
+      TEST_LOGICAL(.true.,l2,.true.,k8)
+
+      TEST_LOGICAL(.true.,l4,.false.,k1)
+      TEST_LOGICAL(.true.,l4,.true.,k1)
+      TEST_LOGICAL(.true.,l4,.false.,k2)
+      TEST_LOGICAL(.true.,l4,.true.,k2)
+      TEST_LOGICAL(.true.,l4,.false.,k4)
+      TEST_LOGICAL(.true.,l4,.true.,k4)
+      TEST_LOGICAL(.true.,l4,.false.,k8)
+      TEST_LOGICAL(.true.,l4,.true.,k8)
+
+      TEST_LOGICAL(.true.,l8,.false.,k1)
+      TEST_LOGICAL(.true.,l8,.true.,k1)
+      TEST_LOGICAL(.true.,l8,.false.,k2)
+      TEST_LOGICAL(.true.,l8,.true.,k2)
+      TEST_LOGICAL(.true.,l8,.false.,k4)
+      TEST_LOGICAL(.true.,l8,.true.,k4)
+      TEST_LOGICAL(.true.,l8,.false.,k8)
+      TEST_LOGICAL(.true.,l8,.true.,k8)
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/gnu_logical_2.f90 b/gcc/testsuite/gfortran.dg/gnu_logical_2.f90
new file mode 100644
index 000000000..4ff70fac2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gnu_logical_2.f90
@@ -0,0 +1,29 @@
+! Testcases for the AND, OR and XOR functions (GNU intrinsics).
+! { dg-do compile }
+  integer i
+  logical l
+  real r
+  complex c
+
+  print *, and(i,i)
+  print *, and(l,l)
+  print *, and(i,r) ! { dg-error "must be INTEGER or LOGICAL" }
+  print *, and(c,l) ! { dg-error "must be INTEGER or LOGICAL" }
+  print *, and(i,l) ! { dg-error "must have the same type" }
+  print *, and(l,i) ! { dg-error "must have the same type" }
+
+  print *, or(i,i)
+  print *, or(l,l)
+  print *, or(i,r) ! { dg-error "must be INTEGER or LOGICAL" }
+  print *, or(c,l) ! { dg-error "must be INTEGER or LOGICAL" }
+  print *, or(i,l) ! { dg-error "must have the same type" }
+  print *, or(l,i) ! { dg-error "must have the same type" }
+
+  print *, xor(i,i)
+  print *, xor(l,l)
+  print *, xor(i,r) ! { dg-error "must be INTEGER or LOGICAL" }
+  print *, xor(c,l) ! { dg-error "must be INTEGER or LOGICAL" }
+  print *, xor(i,l) ! { dg-error "must have the same type" }
+  print *, xor(l,i) ! { dg-error "must have the same type" }
+
+  end
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocatable_components_1.f90 b/gcc/testsuite/gfortran.dg/gomp/allocatable_components_1.f90
new file mode 100644
index 000000000..225d0a2b5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocatable_components_1.f90
@@ -0,0 +1,59 @@
+! { dg-do compile }
+!
+! PR fortran/32467
+! Derived types with allocatable components
+!
+
+MODULE test_allocatable_components
+  type :: t
+    integer, allocatable :: a(:)
+  end type
+
+CONTAINS
+  SUBROUTINE test_copyin()
+    TYPE(t), SAVE :: a
+
+    !$omp threadprivate(a)
+    !$omp parallel copyin(a)        ! { dg-error "has ALLOCATABLE components" }
+      ! do something
+    !$omp end parallel
+  END SUBROUTINE
+
+  SUBROUTINE test_copyprivate()
+    TYPE(t) :: a
+
+    !$omp single                    ! { dg-error "has ALLOCATABLE components" }
+      ! do something
+    !$omp end single copyprivate (a)
+  END SUBROUTINE
+
+  SUBROUTINE test_firstprivate
+    TYPE(t) :: a
+
+    !$omp parallel firstprivate(a)  ! { dg-error "has ALLOCATABLE components" }
+      ! do something
+    !$omp end parallel
+  END SUBROUTINE
+
+  SUBROUTINE test_lastprivate
+    TYPE(t) :: a
+    INTEGER :: i
+
+    !$omp parallel do lastprivate(a)  ! { dg-error "has ALLOCATABLE components" }
+      DO i = 1, 1
+      END DO
+    !$omp end parallel do
+  END SUBROUTINE
+
+  SUBROUTINE test_reduction
+    TYPE(t) :: a(10)
+    INTEGER :: i
+
+    !$omp parallel do reduction(+: a)   ! { dg-error "must be of numeric type" }
+    DO i = 1, SIZE(a)
+    END DO
+    !$omp end parallel do
+  END SUBROUTINE
+END MODULE
+
+! { dg-final { cleanup-modules "test_allocatable_components" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.1.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.1.1.f90
new file mode 100644
index 000000000..fd83131b5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.1.1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+      SUBROUTINE A1(N, A, B)
+      INTEGER I, N
+      REAL B(N), A(N)
+!$OMP PARALLEL DO !I is private by default
+      DO I=2,N
+          B(I) = (A(I) + A(I-1)) / 2.0
+      ENDDO
+!$OMP END PARALLEL DO
+      END SUBROUTINE A1
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.1.f90
new file mode 100644
index 000000000..eb8455e19
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+      SUBROUTINE A11_1(AA, BB, CC, DD, EE, FF, N)
+      INTEGER N
+      REAL AA(N,N), BB(N,N), CC(N,N), DD(N,N), EE(N,N), FF(N,N)
+!$OMP PARALLEL
+!$OMP WORKSHARE
+            AA = BB
+            CC = DD
+            EE = FF
+!$OMP END WORKSHARE
+!$OMP END PARALLEL
+      END SUBROUTINE A11_1
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.2.f90
new file mode 100644
index 000000000..11fdc1caa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.2.f90
@@ -0,0 +1,16 @@
+! { do-do compile }
+
+      SUBROUTINE A11_2(AA, BB, CC, DD, EE, FF, N)
+      INTEGER N
+      REAL AA(N,N), BB(N,N), CC(N,N)
+      REAL DD(N,N), EE(N,N), FF(N,N)
+!$OMP PARALLEL
+!$OMP WORKSHARE
+            AA = BB
+            CC = DD
+!$OMP END WORKSHARE NOWAIT
+!$OMP WORKSHARE
+            EE = FF
+!$OMP END WORKSHARE
+!$OMP END PARALLEL
+      END SUBROUTINE A11_2
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.3.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.3.f90
new file mode 100644
index 000000000..b87232f9c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.3.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+      SUBROUTINE A11_3(AA, BB, CC, DD, N)
+      INTEGER N
+      REAL AA(N,N), BB(N,N), CC(N,N), DD(N,N)
+      REAL R
+        R=0
+!$OMP PARALLEL
+!$OMP WORKSHARE
+             AA = BB
+!$OMP ATOMIC
+               R = R + SUM(AA)
+             CC = DD
+!$OMP END WORKSHARE
+!$OMP END PARALLEL
+      END SUBROUTINE A11_3
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.4.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.4.f90
new file mode 100644
index 000000000..ae95c1f98
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.4.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+
+      SUBROUTINE A11_4(AA, BB, CC, DD, EE, FF, GG, HH, N)
+      INTEGER N
+      REAL AA(N,N), BB(N,N), CC(N,N)
+      REAL DD(N,N), EE(N,N), FF(N,N)
+      REAL GG(N,N), HH(N,N)
+!$OMP PARALLEL
+!$OMP WORKSHARE
+            AA = BB
+            CC = DD
+            WHERE (EE .ne. 0) FF = 1 / EE
+            GG = HH
+!$OMP END WORKSHARE
+!$OMP END PARALLEL
+      END SUBROUTINE A11_4
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.5.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.5.f90
new file mode 100644
index 000000000..6b8e4fa3d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.5.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+        SUBROUTINE A11_5(AA, BB, CC, DD, N)
+        INTEGER N
+        REAL AA(N,N), BB(N,N), CC(N,N), DD(N,N)
+        INTEGER SHR
+!$OMP PARALLEL SHARED(SHR)
+!$OMP WORKSHARE
+            AA = BB
+            SHR = 1
+            CC = DD * SHR
+!$OMP END WORKSHARE
+!$OMP END PARALLEL
+      END SUBROUTINE A11_5
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.6.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.6.f90
new file mode 100644
index 000000000..fa31bcffc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.6.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+
+      SUBROUTINE A11_6_WRONG(AA, BB, CC, DD, N)
+      INTEGER N
+      REAL AA(N,N), BB(N,N), CC(N,N), DD(N,N)
+        INTEGER PRI
+!$OMP PARALLEL PRIVATE(PRI)
+!$OMP WORKSHARE
+            AA = BB
+            PRI = 1
+            CC = DD * PRI
+!$OMP END WORKSHARE
+!$OMP END PARALLEL
+      END SUBROUTINE A11_6_WRONG
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.7.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.7.f90
new file mode 100644
index 000000000..86b8c7bc5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.7.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+      SUBROUTINE A11_7(AA, BB, CC, N)
+      INTEGER N
+      REAL AA(N), BB(N), CC(N)
+!$OMP PARALLEL
+!$OMP WORKSHARE
+            AA(1:50) = BB(11:60)
+            CC(11:20) = AA(1:10)
+!$OMP END WORKSHARE
+!$OMP END PARALLEL
+      END SUBROUTINE A11_7
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.12.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.12.1.f90
new file mode 100644
index 000000000..38389e4f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.12.1.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+      SUBROUTINE A12( X, XOLD, N, TOL )
+      REAL X(*), XOLD(*), TOL
+      INTEGER N
+      INTEGER C, I, TOOBIG
+      REAL ERROR, Y, AVERAGE
+      EXTERNAL AVERAGE
+      C=0
+      TOOBIG = 1
+!$OMP PARALLEL
+        DO WHILE( TOOBIG > 0 )
+!$OMP DO PRIVATE(I)
+            DO I = 2, N-1
+               XOLD(I) = X(I)
+            ENDDO
+!$OMP SINGLE
+            TOOBIG = 0
+!$OMP END SINGLE
+!$OMP DO PRIVATE(I,Y,ERROR), REDUCTION(+:TOOBIG)
+            DO I = 2, N-1
+               Y = X(I)
+               X(I) = AVERAGE( XOLD(I-1), X(I), XOLD(I+1) )
+               ERROR = Y-X(I)
+               IF( ERROR > TOL .OR. ERROR < -TOL ) TOOBIG = TOOBIG+1
+            ENDDO
+!$OMP MASTER
+            C=C+1
+            PRINT *, "Iteration ", C, " TOOBIG=", TOOBIG
+!$OMP END MASTER
+        ENDDO
+!$OMP END PARALLEL
+      END SUBROUTINE A12
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.13.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.13.1.f90
new file mode 100644
index 000000000..57f5b8912
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.13.1.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+        SUBROUTINE A13(X, Y)
+        REAL X(*), Y(*)
+        INTEGER IX_NEXT, IY_NEXT
+!$OMP PARALLEL SHARED(X, Y) PRIVATE(IX_NEXT, IY_NEXT)
+!$OMP CRITICAL(XAXIS)
+        CALL DEQUEUE(IX_NEXT, X)
+!$OMP END CRITICAL(XAXIS)
+        CALL WORK(IX_NEXT, X)
+!$OMP CRITICAL(YAXIS)
+        CALL DEQUEUE(IY_NEXT,Y)
+!$OMP END CRITICAL(YAXIS)
+        CALL WORK(IY_NEXT, Y)
+!$OMP END PARALLEL
+      END SUBROUTINE A13
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.14.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.14.1.f90
new file mode 100644
index 000000000..6db107afa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.14.1.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+      SUBROUTINE A14()
+        INTEGER I
+        I=1
+!$OMP PARALLEL SECTIONS
+!$OMP SECTION
+!$OMP CRITICAL (NAME)
+!$OMP PARALLEL
+!$OMP SINGLE
+                  I=I+1
+!$OMP END SINGLE
+!$OMP END PARALLEL
+!$OMP END CRITICAL (NAME)
+!$OMP END PARALLEL SECTIONS
+      END SUBROUTINE A14
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.1.f90
new file mode 100644
index 000000000..8fd600176
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.1.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+      SUBROUTINE A17_1_WRONG()
+        INTEGER:: I
+        REAL:: R
+        EQUIVALENCE(I,R)
+!$OMP PARALLEL
+!$OMP ATOMIC
+            I=I+1
+!$OMP ATOMIC
+            R = R + 1.0
+! incorrect because I and R reference the same location
+! but have different types
+!$OMP END PARALLEL
+        END SUBROUTINE A17_1_WRONG
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.2.f90
new file mode 100644
index 000000000..a19db8c0d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.2.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+
+      SUBROUTINE SUB()
+        COMMON /BLK/ R
+        REAL R
+!$OMP ATOMIC
+        R = R + 1.0
+      END SUBROUTINE SUB
+
+      SUBROUTINE A17_2_WRONG()
+      COMMON /BLK/ I
+      INTEGER I
+!$OMP PARALLEL
+!$OMP ATOMIC
+            I=I+1
+          CALL SUB()
+!$OMP END PARALLEL
+      END SUBROUTINE A17_2_WRONG
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.3.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.3.f90
new file mode 100644
index 000000000..4f4f55c09
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.3.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+      SUBROUTINE A17_3_WRONG
+        INTEGER:: I
+        REAL:: R
+        EQUIVALENCE(I,R)
+!$OMP PARALLEL
+!$OMP ATOMIC
+            I=I+1
+! incorrect because I and R reference the same location
+! but have different types
+!$OMP END PARALLEL
+!$OMP PARALLEL
+!$OMP ATOMIC
+            R = R + 1.0
+! incorrect because I and R reference the same location
+! but have different types
+!$OMP END PARALLEL
+      END SUBROUTINE A17_3_WRONG
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.21.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.21.2.f90
new file mode 100644
index 000000000..87359a152
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.21.2.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+
+      SUBROUTINE WORK(I)
+      INTEGER I
+      END SUBROUTINE WORK
+      SUBROUTINE A21_WRONG(N)
+      INTEGER N
+        INTEGER I
+!$OMP DO ORDERED
+        DO I = 1, N
+! incorrect because an iteration may not execute more than one
+! ordered region
+!$OMP ORDERED
+            CALL WORK(I)
+!$OMP END ORDERED
+!$OMP ORDERED
+            CALL WORK(I+1)
+!$OMP END ORDERED
+        END DO
+      END SUBROUTINE A21_WRONG
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.21.3.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.21.3.f90
new file mode 100644
index 000000000..97ca8f458
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.21.3.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+
+      SUBROUTINE A21_GOOD(N)
+      INTEGER N
+!$OMP DO ORDERED
+        DO I = 1,N
+          IF (I <= 10) THEN
+!$OMP ORDERED
+              CALL WORK(I)
+!$OMP END ORDERED
+          ENDIF
+          IF (I > 10) THEN
+!$OMP ORDERED
+              CALL WORK(I+1)
+!$OMP END ORDERED
+          ENDIF
+        ENDDO
+      END SUBROUTINE A21_GOOD
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.1.f90
new file mode 100644
index 000000000..cc94b1403
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+
+      INTEGER FUNCTION INCREMENT_COUNTER()
+        COMMON/A22_COMMON/COUNTER
+!$OMP THREADPRIVATE(/A22_COMMON/)
+        COUNTER = COUNTER +1
+        INCREMENT_COUNTER = COUNTER
+        RETURN
+      END FUNCTION INCREMENT_COUNTER
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.4.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.4.f90
new file mode 100644
index 000000000..2a637580b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.4.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+
+      MODULE A22_MODULE
+      COMMON /T/ A
+      END MODULE A22_MODULE
+      SUBROUTINE A22_4_WRONG()
+        USE A22_MODULE
+!$OMP THREADPRIVATE(/T/)	! { dg-error "COMMON block" }
+      !non-conforming because /T/ not declared in A22_4_WRONG
+      END SUBROUTINE A22_4_WRONG
+! { dg-final { cleanup-modules "A22_MODULE" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.5.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.5.f90
new file mode 100644
index 000000000..6531d826c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.5.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+
+      SUBROUTINE A22_5_WRONG()
+        COMMON /T/ A
+!$OMP THREADPRIVATE(/T/)
+        CONTAINS
+          SUBROUTINE A22_5S_WRONG()
+!$OMP PARALLEL COPYIN(/T/)	! { dg-error "COMMON block" }
+      !non-conforming because /T/ not declared in A22_5S_WRONG
+!$OMP END PARALLEL		! { dg-error "Unexpected" }
+          END SUBROUTINE A22_5S_WRONG
+      END SUBROUTINE A22_5_WRONG
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.6.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.6.f90
new file mode 100644
index 000000000..0a2e6a683
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.6.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+
+       SUBROUTINE A22_6_GOOD()
+             COMMON /T/ A
+!$OMP THREADPRIVATE(/T/)
+       CONTAINS
+         SUBROUTINE A22_6S_GOOD()
+           COMMON /T/ A
+!$OMP THREADPRIVATE(/T/)
+!$OMP PARALLEL COPYIN(/T/)
+!$OMP END PARALLEL
+        END SUBROUTINE A22_6S_GOOD
+      END SUBROUTINE A22_6_GOOD
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.1.f90
new file mode 100644
index 000000000..6eab68729
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+      SUBROUTINE A23_1_GOOD()
+        COMMON /C/ X,Y
+        REAL X, Y
+!$OMP PARALLEL PRIVATE (/C/)
+          ! do work here
+!$OMP END PARALLEL
+!$OMP PARALLEL SHARED (X,Y)
+          ! do work here
+!$OMP END PARALLEL
+      END SUBROUTINE A23_1_GOOD
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.2.f90
new file mode 100644
index 000000000..ecfdbe5a2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.2.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+      SUBROUTINE A23_2_GOOD()
+         COMMON /C/ X,Y
+         REAL X, Y
+         INTEGER I
+!$OMP PARALLEL
+!$OMP DO PRIVATE(/C/)
+           DO I=1,1000
+             ! do work here
+           ENDDO
+!$OMP END DO
+!
+!$OMP DO PRIVATE(X)
+           DO I=1,1000
+             ! do work here
+           ENDDO
+!$OMP END DO
+!$OMP END PARALLEL
+       END SUBROUTINE A23_2_GOOD
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.3.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.3.f90
new file mode 100644
index 000000000..abd804102
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.3.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+
+      SUBROUTINE A23_3_GOOD()
+        COMMON /C/ X,Y
+!$OMP PARALLEL PRIVATE (/C/)
+          ! do work here
+!$OMP END PARALLEL
+!$OMP PARALLEL SHARED (/C/)
+          ! do work here
+!$OMP END PARALLEL
+      END SUBROUTINE A23_3_GOOD
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.4.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.4.f90
new file mode 100644
index 000000000..8c6e2281d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.4.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+
+        SUBROUTINE A23_4_WRONG()
+        COMMON /C/ X,Y
+! Incorrect because X is a constituent element of C
+!$OMP PARALLEL PRIVATE(/C/), SHARED(X)	! { dg-error "Symbol 'x' present" }
+          ! do work here
+!$OMP END PARALLEL
+      END SUBROUTINE A23_4_WRONG
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.5.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.5.f90
new file mode 100644
index 000000000..732c15f23
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.5.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+
+      SUBROUTINE A23_5_WRONG()
+        COMMON /C/ X,Y
+! Incorrect: common block C cannot be declared both
+! shared and private
+!$OMP PARALLEL PRIVATE (/C/), SHARED(/C/)
+          ! { dg-error "Symbol 'y' present" "" { target *-*-* } 7 }
+          ! { dg-error "Symbol 'x' present" "" { target *-*-* } 7 }
+          ! do work here
+!$OMP END PARALLEL
+      END SUBROUTINE A23_5_WRONG
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.24.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.24.1.f90
new file mode 100644
index 000000000..e5b95450d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.24.1.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+
+      SUBROUTINE A24(A)
+      INTEGER A
+      INTEGER X, Y, Z(1000)
+      INTEGER OMP_GET_NUM_THREADS
+      COMMON/BLOCKX/X
+      COMMON/BLOCKY/Y
+      COMMON/BLOCKZ/Z
+!$OMP THREADPRIVATE(/BLOCKX/)
+      INTEGER I, J
+      i=1
+!$OMP PARALLEL DEFAULT(NONE) PRIVATE(A) SHARED(Z) PRIVATE(J)
+      J = OMP_GET_NUM_THREADS();
+               ! O.K. - J is listed in PRIVATE clause
+      A = Z(J) ! O.K. - A is listed in PRIVATE clause
+               !       - Z is listed in SHARED clause
+      X=1      ! O.K. - X is THREADPRIVATE
+      Z(I) = Y ! Error - cannot reference I or Y here
+! { dg-error "'i' not specified" "" { target *-*-* } 20 } */
+! { dg-error "enclosing parallel" "" { target *-*-* } 14 } */
+! { dg-error "'y' not specified" "" { target *-*-* } 20 }  */
+!$OMP DO firstprivate(y)
+      DO I = 1,10
+        Z(I) = Y ! O.K. - I is the loop iteration variable
+                 ! Y is listed in FIRSTPRIVATE clause
+      END DO
+      Z(I) = Y    ! Error - cannot reference I or Y here
+!$OMP END PARALLEL
+      END SUBROUTINE A24
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.25.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.25.1.f90
new file mode 100644
index 000000000..66bfba80e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.25.1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+
+        SUBROUTINE A25
+        INTEGER OMP_GET_THREAD_NUM
+        REAL A(20)
+        INTEGER MYTHREAD
+        !$OMP PARALLEL SHARED(A) PRIVATE(MYTHREAD)
+        MYTHREAD = OMP_GET_THREAD_NUM()
+        IF (MYTHREAD .EQ. 0) THEN
+            CALL SUB(A(1:10)) ! compiler may introduce writes to A(6:10)
+        ELSE
+            A(6:10) = 12
+        ENDIF
+        !$OMP END PARALLEL
+        END SUBROUTINE A25
+        SUBROUTINE SUB(X)
+        REAL X(*)
+        X(1:5) = 4
+        END SUBROUTINE SUB
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.26.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.26.2.f90
new file mode 100644
index 000000000..3d43424b6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.26.2.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+
+       MODULE A26_2
+       REAL A
+       CONTAINS
+         SUBROUTINE G(K)
+           REAL K
+           A = K ! This is A in module A26_2, not the private
+                  ! A in F
+         END SUBROUTINE G
+         SUBROUTINE F(N)
+         INTEGER N
+         REAL A
+            INTEGER I
+!$OMP PARALLEL DO PRIVATE(A)
+              DO I = 1,N
+                A=I
+                CALL G(A*2)
+              ENDDO
+!$OMP END PARALLEL DO
+          END SUBROUTINE F
+      END MODULE A26_2
+! { dg-final { cleanup-modules "A26_2" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.27.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.27.1.f90
new file mode 100644
index 000000000..f564bd380
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.27.1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+
+       SUBROUTINE A27()
+         INTEGER I, A
+!$OMP PARALLEL PRIVATE(A)
+!$OMP PARALLEL DO PRIVATE(A)
+           DO I = 1, 10
+              ! do work here
+          END DO
+!$OMP END PARALLEL DO
+!$OMP END PARALLEL
+      END SUBROUTINE A27
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.30.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.30.1.f90
new file mode 100644
index 000000000..e62cbf81b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.30.1.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+
+      SUBROUTINE A30(N, A, B)
+       INTEGER N
+       REAL A(*), B(*)
+        INTEGER I
+!$OMP PARALLEL
+!$OMP DO LASTPRIVATE(I)
+        DO I=1,N-1
+          A(I) = B(I) + B(I+1)
+        ENDDO
+!$OMP END PARALLEL
+        A(I) = B(I)      ! I has the value of N here
+      END SUBROUTINE A30
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.1.f90
new file mode 100644
index 000000000..7459897eb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.1.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+
+      SUBROUTINE A31_1(A, B, X, Y, N)
+        INTEGER N
+        REAL X(*), Y(*), A, B
+!$OMP PARALLEL DO PRIVATE(I) SHARED(X, N) REDUCTION(+:A) &
+!$OMP& REDUCTION(MIN:B)
+        DO I=1,N
+           A = A + X(I)
+           B = MIN(B, Y(I))
+!  Note that some reductions can be expressed in
+!  other forms. For example, the MIN could be expressed as
+!  IF (B > Y(I)) B = Y(I)
+         END DO
+      END SUBROUTINE A31_1
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.2.f90
new file mode 100644
index 000000000..f78188c7c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.2.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+
+       SUBROUTINE A31_2 (A, B, X, Y, N)
+         INTEGER N
+         REAL X(*), Y(*), A, B, A_P, B_P
+!$OMP PARALLEL SHARED(X, Y, N, A, B) PRIVATE(A_P, B_P)
+        A_P = 0.0
+        B_P = HUGE(B_P)
+!$OMP DO PRIVATE(I)
+        DO I=1,N
+          A_P = A_P + X(I)
+          B_P = MIN(B_P, Y(I))
+        ENDDO
+!$OMP END DO
+!$OMP CRITICAL
+          A = A + A_P
+          B = MIN(B, B_P)
+!$OMP END CRITICAL
+!$OMP END PARALLEL
+      END SUBROUTINE A31_2
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.3.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.3.f90
new file mode 100644
index 000000000..f67c91c21
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.3.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+        PROGRAM A31_3_WRONG
+        MAX = HUGE(0)
+        M=0
+        !$OMP PARALLEL DO REDUCTION(MAX: M) ! MAX is no longer the
+                                            ! intrinsic so this
+                                            ! is non-conforming
+! { dg-error "is not INTRINSIC procedure name" "" { target *-*-* } 5 } */
+        DO I = 1, 100
+        CALL SUB(M,I)
+        END DO
+        END PROGRAM A31_3_WRONG
+        SUBROUTINE SUB(M,I)
+        M = MAX(M,I)
+        END SUBROUTINE SUB
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.32.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.32.1.f90
new file mode 100644
index 000000000..498a6d324
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.32.1.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+
+      MODULE M
+        REAL, POINTER, SAVE :: WORK(:)
+        INTEGER :: SIZE
+        REAL :: TOL
+!$OMP THREADPRIVATE(WORK,SIZE,TOL)
+      END MODULE M
+      SUBROUTINE A32( T, N )
+        USE M
+        REAL :: T
+        INTEGER :: N
+        TOL = T
+        SIZE = N
+!$OMP PARALLEL COPYIN(TOL,SIZE)
+        CALL BUILD
+!$OMP END PARALLEL
+      END SUBROUTINE A32
+      SUBROUTINE BUILD
+        USE M
+        ALLOCATE(WORK(SIZE))
+        WORK = TOL
+      END SUBROUTINE BUILD
+! { dg-final { cleanup-modules "M" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.1.f90
new file mode 100644
index 000000000..05145b171
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+
+      SUBROUTINE INIT(A,B)
+      REAL A, B
+        COMMON /XY/ X,Y
+!$OMP THREADPRIVATE (/XY/)
+!$OMP SINGLE
+          READ (11) A,B,X,Y
+!$OMP END SINGLE COPYPRIVATE (A,B,/XY/)
+      END SUBROUTINE INIT
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.2.f90
new file mode 100644
index 000000000..ced23c856
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.2.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+
+      REAL FUNCTION READ_NEXT()
+        REAL, POINTER :: TMP
+!$OMP SINGLE
+          ALLOCATE (TMP)
+!$OMP END SINGLE COPYPRIVATE (TMP) ! copies the pointer only
+!$OMP MASTER
+          READ (11) TMP
+!$OMP END MASTER
+!$OMP BARRIER
+          READ_NEXT = TMP
+!$OMP BARRIER
+!$OMP SINGLE
+          DEALLOCATE (TMP)
+!$OMP END SINGLE NOWAIT
+      END FUNCTION READ_NEXT
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.4.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.4.f90
new file mode 100644
index 000000000..7a9e1840b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.4.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+        SUBROUTINE S(N)
+        INTEGER N
+        REAL, DIMENSION(:), ALLOCATABLE :: A
+        REAL, DIMENSION(:), POINTER :: B
+        ALLOCATE (A(N))
+!$OMP SINGLE
+            ALLOCATE (B(N))
+        READ (11) A,B
+!$OMP END SINGLE COPYPRIVATE(A,B)
+        ! Variable A designates a private object
+        !   which has the same value in each thread
+        ! Variable B designates a shared object
+!$OMP BARRIER
+!$OMP SINGLE
+          DEALLOCATE (B)
+!$OMP END SINGLE NOWAIT
+      END SUBROUTINE S
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.34.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.34.1.f90
new file mode 100644
index 000000000..29ea952cb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.34.1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+      SUBROUTINE WORK(I, J)
+      INTEGER I, J
+      END SUBROUTINE WORK
+      SUBROUTINE GOOD_NESTING(N)
+      INTEGER N
+        INTEGER I
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP DO
+          DO I = 1, N
+!$OMP PARALLEL SHARED(I,N)
+!$OMP DO
+               DO J = 1, N
+                  CALL WORK(I,J)
+               END DO
+!$OMP END PARALLEL
+          END DO
+!$OMP END PARALLEL
+      END SUBROUTINE GOOD_NESTING
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.34.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.34.2.f90
new file mode 100644
index 000000000..980a62372
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.34.2.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+      SUBROUTINE WORK(I, J)
+      INTEGER I, J
+      END SUBROUTINE WORK
+      SUBROUTINE WORK1(I, N)
+      INTEGER J
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP DO
+         DO J = 1, N
+           CALL WORK(I,J)
+         END DO
+!$OMP END PARALLEL
+      END SUBROUTINE WORK1
+      SUBROUTINE GOOD_NESTING2(N)
+      INTEGER N
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP DO
+      DO I = 1, N
+          CALL WORK1(I, N)
+      END DO
+!$OMP END PARALLEL
+      END SUBROUTINE GOOD_NESTING2
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.1.f90
new file mode 100644
index 000000000..7431a6579
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+
+      SUBROUTINE WORK(I, J)
+      INTEGER I, J
+      END SUBROUTINE WORK
+      SUBROUTINE WRONG1(N)
+      INTEGER N
+        INTEGER I,J
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP DO
+          DO I = 1, N
+	     ! incorrect nesting of loop regions
+!$OMP DO     ! { dg-warning "may not be closely nested" }
+             DO J = 1, N
+                CALL WORK(I,J)
+             END DO
+          END DO
+!$OMP END PARALLEL
+      END SUBROUTINE WRONG1
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.2.f90
new file mode 100644
index 000000000..5fad2c05f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.2.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+
+      SUBROUTINE WORK1(I,N)
+      INTEGER I, N
+        INTEGER J
+!$OMP DO        ! incorrect nesting of loop regions
+        DO J = 1, N
+           CALL WORK(I,J)
+        END DO
+      END SUBROUTINE WORK1
+      SUBROUTINE WRONG2(N)
+      INTEGER N
+        INTEGER I
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP DO
+           DO I = 1, N
+              CALL WORK1(I,N)
+           END DO
+!$OMP END PARALLEL
+      END SUBROUTINE WRONG2
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.3.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.3.f90
new file mode 100644
index 000000000..bb3e02fef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.3.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+
+      SUBROUTINE WRONG3(N)
+      INTEGER N
+        INTEGER I
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP DO
+          DO I = 1, N
+	       ! incorrect nesting of regions
+!$OMP SINGLE   ! { dg-warning "may not be closely nested" }
+               CALL WORK(I, 1)
+!$OMP END SINGLE
+          END DO
+!$OMP END PARALLEL
+      END SUBROUTINE WRONG3
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.4.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.4.f90
new file mode 100644
index 000000000..f130dd5f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.4.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+
+      SUBROUTINE WRONG4(N)
+      INTEGER N
+        INTEGER I
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP DO
+          DO I = 1, N
+             CALL WORK(I, 1)
+! incorrect nesting of barrier region in a loop region
+!$OMP BARRIER	! { dg-warning "may not be closely nested" }
+             CALL WORK(I, 2)
+          END DO
+!$OMP END PARALLEL
+      END SUBROUTINE WRONG4
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.5.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.5.f90
new file mode 100644
index 000000000..083c0b3b7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.5.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+
+      SUBROUTINE WRONG5(N)
+      INTEGER N
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP CRITICAL
+            CALL WORK(N,1)
+! incorrect nesting of barrier region in a critical region
+!$OMP BARRIER
+            CALL WORK(N,2)
+!$OMP END CRITICAL
+!$OMP END PARALLEL
+      END SUBROUTINE WRONG5
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.6.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.6.f90
new file mode 100644
index 000000000..62ba24523
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.6.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+
+         SUBROUTINE WRONG6(N)
+         INTEGER N
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP SINGLE
+           CALL WORK(N,1)
+! incorrect nesting of barrier region in a single region
+!$OMP BARRIER	! { dg-warning "may not be closely nested" }
+            CALL WORK(N,2)
+!$OMP END SINGLE
+!$OMP END PARALLEL
+      END SUBROUTINE WRONG6
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.36.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.36.1.f90
new file mode 100644
index 000000000..be68188ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.36.1.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+
+      SUBROUTINE DO_BY_16(X, IAM, IPOINTS)
+        REAL X(*)
+        INTEGER IAM, IPOINTS
+      END SUBROUTINE DO_BY_16
+      SUBROUTINE SUBA36(X, NPOINTS)
+        INTEGER NPOINTS
+        REAL X(NPOINTS)
+        INTEGER IAM, IPOINTS
+        EXTERNAL OMP_SET_DYNAMIC, OMP_SET_NUM_THREADS
+        INTEGER OMP_GET_NUM_THREADS, OMP_GET_THREAD_NUM
+        CALL OMP_SET_DYNAMIC(.FALSE.)
+        CALL OMP_SET_NUM_THREADS(16)
+!$OMP PARALLEL SHARED(X,NPOINTS) PRIVATE(IAM, IPOINTS)
+          IF (OMP_GET_NUM_THREADS() .NE. 16) THEN
+            STOP
+          ENDIF
+          IAM = OMP_GET_THREAD_NUM()
+          IPOINTS = NPOINTS/16
+          CALL DO_BY_16(X,IAM,IPOINTS)
+!$OMP END PARALLEL
+      END SUBROUTINE SUBA36
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.37.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.37.1.f90
new file mode 100644
index 000000000..473c1fec8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.37.1.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+      SUBROUTINE WORK(I)
+      INTEGER I
+        I=I+1
+      END SUBROUTINE WORK
+      SUBROUTINE INCORRECT()
+        INTEGER OMP_GET_NUM_THREADS
+        INTEGER I, NP
+        NP = OMP_GET_NUM_THREADS()   !misplaced: will return 1
+!$OMP PARALLEL DO SCHEDULE(STATIC)
+          DO I = 0, NP-1
+            CALL WORK(I)
+          ENDDO
+!$OMP END PARALLEL DO
+      END SUBROUTINE INCORRECT
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.37.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.37.2.f90
new file mode 100644
index 000000000..c5fbcbbd0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.37.2.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+      SUBROUTINE WORK(I)
+        INTEGER I
+        I=I+1
+      END SUBROUTINE WORK
+      SUBROUTINE CORRECT()
+        INTEGER OMP_GET_THREAD_NUM
+        INTEGER I
+!$OMP PARALLEL PRIVATE(I)
+          I = OMP_GET_THREAD_NUM()
+          CALL WORK(I)
+!$OMP END PARALLEL
+      END SUBROUTINE CORRECT
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.6.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.6.1.f90
new file mode 100644
index 000000000..f1c6c6596
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.6.1.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+
+      SUBROUTINE WORK(I, J)
+      INTEGER I,J
+      END SUBROUTINE WORK
+      SUBROUTINE A6_GOOD()
+        INTEGER I, J
+        REAL A(1000)
+        DO 100 I = 1,10
+!$OMP DO
+           DO 100 J = 1,10
+              CALL WORK(I,J)
+            100     CONTINUE        ! !$OMP ENDDO implied here
+!$OMP DO
+        DO 200 J = 1,10
+200        A(I) = I + 1
+!$OMP ENDDO
+!$OMP DO
+        DO 300 I = 1,10
+           DO 300 J = 1,10
+              CALL WORK(I,J)
+300     CONTINUE
+!$OMP ENDDO
+      END SUBROUTINE A6_GOOD
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.6.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.6.2.f90
new file mode 100644
index 000000000..e13880899
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.6.2.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+
+        SUBROUTINE WORK(I, J)
+        INTEGER I,J
+        END SUBROUTINE WORK
+
+        SUBROUTINE A6_WRONG
+        INTEGER I, J
+        DO 100 I = 1,10
+!$OMP DO
+        DO 100 J = 1,10
+        CALL WORK(I,J)
+        100      CONTINUE
+!$OMP ENDDO	! { dg-error "Unexpected ..OMP END DO statement" }
+        END SUBROUTINE A6_WRONG
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.7.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.7.1.f90
new file mode 100644
index 000000000..9f3b08d2e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.7.1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+SUBROUTINE A7_1(A,N)
+INTEGER OMP_GET_THREAD_NUM
+REAL A(*)
+INTEGER I, MYOFFSET, N
+!$OMP PARALLEL PRIVATE(MYOFFSET)
+       MYOFFSET = OMP_GET_THREAD_NUM()*N
+       DO I = 1, N
+          A(MYOFFSET+I) = FLOAT(I)
+       ENDDO
+!$OMP END PARALLEL
+END SUBROUTINE A7_1
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.7.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.7.2.f90
new file mode 100644
index 000000000..23f231876
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.7.2.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+
+SUBROUTINE A7_2(A,B,N,I1,I2)
+REAL A(*), B(*)
+INTEGER I1, I2, N
+!$OMP PARALLEL SHARED(A,B,I1,I2)
+!$OMP SECTIONS
+!$OMP SECTION
+     DO I1 = I1, N
+       IF (A(I1).NE.0.0) EXIT
+     ENDDO
+!$OMP SECTION
+     DO I2 = I2, N
+       IF (B(I2).NE.0.0) EXIT
+     ENDDO
+!$OMP END SECTIONS
+!$OMP SINGLE
+    IF (I1.LE.N) PRINT *, "ITEMS IN A UP TO ", I1, " ARE ALL ZERO."
+    IF (I2.LE.N) PRINT *, "ITEMS IN B UP TO ", I2, " ARE ALL ZERO."
+!$OMP END SINGLE
+!$OMP END PARALLEL
+END SUBROUTINE A7_2
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.8.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.8.1.f90
new file mode 100644
index 000000000..f499e7f89
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.8.1.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+      SUBROUTINE A8(N, M, A, B, Y, Z)
+         INTEGER N, M
+         REAL A(*), B(*), Y(*), Z(*)
+         INTEGER I
+!$OMP PARALLEL
+!$OMP DO
+         DO I=2,N
+           B(I) = (A(I) + A(I-1)) / 2.0
+         ENDDO
+!$OMP END DO NOWAIT
+!$OMP DO
+         DO I=1,M
+           Y(I) = SQRT(Z(I))
+         ENDDO
+!$OMP END DO NOWAIT
+!$OMP END PARALLEL
+      END SUBROUTINE A8
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.9.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.9.1.f90
new file mode 100644
index 000000000..fc7b67de5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.9.1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+      SUBROUTINE A9()
+!$OMP PARALLEL SECTIONS
+!$OMP SECTION
+        CALL XAXIS()
+!$OMP SECTION
+        CALL YAXIS()
+!$OMP SECTION
+        CALL ZAXIS()
+!$OMP END PARALLEL SECTIONS
+      END SUBROUTINE A9
diff --git a/gcc/testsuite/gfortran.dg/gomp/block-1.f90 b/gcc/testsuite/gfortran.dg/gomp/block-1.f90
new file mode 100644
index 000000000..04c39a40a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/block-1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+
+!$omp parallel
+!$omp critical
+       goto 10		! { dg-error "invalid (exit|branch)" }
+!$omp end critical
+ 10    x = 1
+!$omp end parallel
+
+       end
diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
new file mode 100644
index 000000000..f16a780ad
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
@@ -0,0 +1,57 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+subroutine collapse1
+  integer :: i, j, k, a(1:3, 4:6, 5:7)
+  real :: r
+  logical :: l
+  integer, save :: thr
+  !$omp threadprivate (thr)
+  l = .false.
+  a(:, :, :) = 0
+  !$omp parallel do collapse(4) schedule(static, 4) ! { dg-error "not enough DO loops for collapsed" }
+    do i = 1, 3
+      do j = 4, 6
+        do k = 5, 7
+          a(i, j, k) = i + j + k
+        end do
+      end do
+    end do
+  !$omp parallel do collapse(2)
+    do i = 1, 5, 2
+      do j = i + 1, 7, i	! { dg-error "collapsed loops don.t form rectangular iteration space" }
+      end do
+    end do
+  !$omp parallel do collapse(2) shared(j)
+    do i = 1, 3
+      do j = 4, 6		! { dg-error "iteration variable present on clause other than PRIVATE or LASTPRIVATE" }
+      end do
+    end do
+  !$omp parallel do collapse(2)
+    do i = 1, 3
+      do j = 4, 6
+      end do
+      k = 4
+    end do
+  !$omp parallel do collapse(2)
+    do i = 1, 3
+      do			! { dg-error "cannot be a DO WHILE or DO without loop control" }
+      end do
+    end do
+  !$omp parallel do collapse(2)
+    do i = 1, 3
+      do r = 4, 6		! { dg-warning "must be integer" }
+      end do
+    end do
+end subroutine collapse1
+
+subroutine collapse1_2
+  integer :: i
+  !$omp parallel do collapse(2)
+    do i = -6, 6		! { dg-error "cannot be redefined inside loop beginning" }
+      do i = 4, 6		! { dg-error "collapsed loops don.t form rectangular iteration space|cannot be redefined" }
+      end do
+    end do
+end subroutine collapse1_2
+
+! { dg-error "iteration variable must be of type integer" "integer" { target *-*-* } 43 }
diff --git a/gcc/testsuite/gfortran.dg/gomp/crayptr1.f90 b/gcc/testsuite/gfortran.dg/gomp/crayptr1.f90
new file mode 100644
index 000000000..fca5606e0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/crayptr1.f90
@@ -0,0 +1,51 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fcray-pointer" }
+
+  integer :: a, b, c, d, i
+  pointer (ip1, a)
+  pointer (ip2, b)
+  pointer (ip3, c)
+  pointer (ip4, d)
+
+!$omp parallel shared (a)	! { dg-error "Cray pointee 'a' in SHARED clause" }
+!$omp end parallel
+
+!$omp parallel private (b)	! { dg-error "Cray pointee 'b' in PRIVATE clause" }
+!$omp end parallel
+
+!$omp parallel firstprivate (c)	! { dg-error "Cray pointee 'c' in FIRSTPRIVATE clause" }
+!$omp end parallel
+
+!$omp parallel do lastprivate (d) ! { dg-error "Cray pointee 'd' in LASTPRIVATE clause" }
+  do i = 1, 10
+    if (i .eq. 10) d = 1
+  end do
+!$omp end parallel do
+
+!$omp parallel reduction (+: a)	! { dg-error "Cray pointee 'a' in REDUCTION clause" }
+!$omp end parallel
+
+  ip1 = loc (i)
+!$omp parallel shared (ip1)
+  a = 2
+!$omp end parallel
+
+!$omp parallel private (ip2, i)
+  ip2 = loc (i)
+  b = 1
+!$omp end parallel
+
+  ip3 = loc (i)
+!$omp parallel firstprivate (ip3) ! { dg-error "Cray pointer 'ip3' in FIRSTPRIVATE clause" }
+!$omp end parallel
+
+!$omp parallel do lastprivate (ip4) ! { dg-error "Cray pointer 'ip4' in LASTPRIVATE clause" }
+  do i = 1, 10
+    if (i .eq. 10) ip4 = loc (i)
+  end do
+!$omp end parallel do
+
+!$omp parallel reduction (+: ip1) ! { dg-error "Cray pointer 'ip1' in REDUCTION clause" }
+!$omp end parallel
+
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/crayptr2.f90 b/gcc/testsuite/gfortran.dg/gomp/crayptr2.f90
new file mode 100644
index 000000000..476d7b9e7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/crayptr2.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fcray-pointer" }
+! { dg-require-effective-target tls }
+
+module crayptr2
+  integer :: e		! { dg-error "CRAY POINTEE attribute conflicts with THREADPRIVATE" }
+  pointer (ip5, e)
+
+! The standard is not very clear about this.
+! Certainly, Cray pointees can't be SAVEd, nor they can be
+! in COMMON, so the only way to make threadprivate Cray pointees would
+! be if they are module variables.  But threadprivate pointees don't
+! make any sense anyway.
+
+!$omp threadprivate (e)
+
+end module crayptr2
diff --git a/gcc/testsuite/gfortran.dg/gomp/crayptr3.f90 b/gcc/testsuite/gfortran.dg/gomp/crayptr3.f90
new file mode 100644
index 000000000..be8f5a0f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/crayptr3.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fcray-pointer" }
+
+  integer :: a, b
+  pointer (ip, a)
+
+  b = 2
+  ip = loc (b)
+!$omp parallel default (none) shared (ip)
+  a = 1
+!$omp end parallel
+
+!$omp parallel default (none) private (ip, b)
+  b = 3
+  ip = loc (b)
+  a = 1
+!$omp end parallel
+
+!$omp parallel default (none)	! { dg-error "enclosing parallel" }
+  a = 1		! { dg-error "'ip' not specified in enclosing parallel" }
+!$omp end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/crayptr4.f90 b/gcc/testsuite/gfortran.dg/gomp/crayptr4.f90
new file mode 100644
index 000000000..d7da0bd8c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/crayptr4.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fcray-pointer" }
+
+subroutine foo (n)
+  integer :: a, b (38), n
+  pointer (ip, a (n + 1))
+
+  b = 2
+  n = 36
+  ip = loc (b)
+!$omp parallel default (none) shared (ip)
+!$omp parallel default (none) shared (ip)
+  a = 1
+!$omp end parallel
+!$omp end parallel
+
+!$omp parallel default (none)
+!$omp parallel default (none) private (ip, b)
+  b = 3
+  ip = loc (b)
+  a = 1
+!$omp end parallel
+!$omp end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/crayptr5.f90 b/gcc/testsuite/gfortran.dg/gomp/crayptr5.f90
new file mode 100644
index 000000000..5ade16c83
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/crayptr5.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fcray-pointer" }
+!
+! PR fortran/43985
+
+subroutine pete(A)
+  real(8) :: A
+  print *, 'pete got ',A
+  if (A /= 3.0) call abort()
+end subroutine pete
+
+       subroutine bob()
+         implicit none
+         real(8) peted
+         pointer (ipeted, peted(*))
+         integer(4) sz
+         ipeted = malloc(5*8)
+         peted(1:5) = [ 1.,2.,3.,4.,5.]
+         sz = 3
+!$omp parallel default(shared)
+         call pete(peted(sz))
+!$omp end parallel
+         return
+       end subroutine bob
+
+call bob()
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/do-1.f90 b/gcc/testsuite/gfortran.dg/gomp/do-1.f90
new file mode 100644
index 000000000..a9c9cf11d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/do-1.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-O -fopenmp -fdump-tree-omplower" }
+
+subroutine foo (i, j, k, s, a)
+  integer :: i, j, k, s, a(100), l
+!$omp parallel do schedule (dynamic, s * 2)
+  do 100, l = j, k
+100 a(l) = i
+!$omp parallel do schedule (dynamic, s * 2)
+  do 101, l = j, k, 3
+101 a(l) = i + 1
+end subroutine foo
+
+subroutine bar (i, j, k, s, a)
+  integer :: i, j, k, s, a(100), l
+!$omp parallel do schedule (guided, s * 2)
+  do 100, l = j, k
+100 a(l) = i
+!$omp parallel do schedule (guided, s * 2)
+  do 101, l = j, k, 3
+101 a(l) = i + 1
+end subroutine bar
+
+! { dg-final { scan-tree-dump-times "GOMP_parallel_loop_dynamic_start" 2 "omplower" { xfail *-*-* } } }
+! { dg-final { scan-tree-dump-times "GOMP_parallel_loop_guided_start" 2 "omplower" { xfail *-*-* } } }
+! { dg-final { cleanup-tree-dump "omplower" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/fixed-1.f b/gcc/testsuite/gfortran.dg/gomp/fixed-1.f
new file mode 100644
index 000000000..d61f2ba63
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/fixed-1.f
@@ -0,0 +1,22 @@
+C PR fortran/24493
+C { dg-do compile }
+C { dg-require-effective-target tls }
+      INTEGER I, J, K, L, M
+C$OMP THREADPRIVATE(I)
+C SOME COMMENT
+      SAVE I ! ANOTHER COMMENT
+C$OMP THREADPRIVATE
+C$OMP+(J) ! OMP DIRECTIVE COMMENT
+* NORMAL COMMENT
+c$OMP THREAD! COMMENT
+C$OMP&PRIVATE! COMMENT
+*$OMP+    (K)
+C$OMP THREADPRIVATE (L ! COMMENT
+*$OMP& , M)
+      SAVE J, K, L, M
+      I = 1
+      J = 2
+      K = 3
+      L = 4
+      M = 5
+      END
diff --git a/gcc/testsuite/gfortran.dg/gomp/free-1.f90 b/gcc/testsuite/gfortran.dg/gomp/free-1.f90
new file mode 100644
index 000000000..f6f9de444
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/free-1.f90
@@ -0,0 +1,8 @@
+! { dg-require-effective-target tls }
+
+subroutine foo
+integer, save :: i ! Some comment
+!$omp threadpri&
+      !$omp&vate (i)
+i = 1
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/free-2.f90 b/gcc/testsuite/gfortran.dg/gomp/free-2.f90
new file mode 100644
index 000000000..60bac66b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/free-2.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+!
+! PR fortran/33445
+!
+!$OMP&foo ! { dg-warning "starts a commented line" }
+!
+!$OMP parallel 
+!$OMP& default(shared) ! { dg-warning "starts a commented line" }
+!$OMP end parallel
+!
+!$OMP parallel 
+!$OMP+ default(shared) ! { dg-warning "starts a commented line" }
+!$OMP end parallel
+       end
diff --git a/gcc/testsuite/gfortran.dg/gomp/gomp.exp b/gcc/testsuite/gfortran.dg/gomp/gomp.exp
new file mode 100644
index 000000000..e12864b4f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/gomp.exp
@@ -0,0 +1,36 @@
+# Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+#
+# This file is part of GCC.
+#
+# GCC is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3, or (at your option)
+# any later version.
+#
+# GCC is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# GCC testsuite that uses the `dg.exp' driver.
+
+# Load support procs.
+load_lib gfortran-dg.exp
+
+if ![check_effective_target_fopenmp] {
+  return
+}
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+gfortran-dg-runtest [lsort \
+       [find $srcdir/$subdir *.\[fF\]{,90,95,03,08} ] ] " -fopenmp"
+
+# All done.
+dg-finish
diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_atomic1.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_atomic1.f90
new file mode 100644
index 000000000..247f8ae50
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/omp_atomic1.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+subroutine test_atomic
+    integer (kind = 4) :: a
+    integer :: b
+    real :: c, f
+    double precision :: d
+    integer, dimension (10) :: e
+    a = 1
+    b = 2
+    c = 3
+    d = 4
+    e = 5
+    f = 6
+!$omp atomic
+    a = a + 4
+!$omp atomic
+    b = 4 - b
+!$omp atomic
+    c = c * 2
+!$omp atomic
+    d = 2 / d
+!$omp atomic
+    e = 1 ! { dg-error "must set a scalar variable" }
+!$omp atomic
+    a = a ** 8 ! { dg-error "assignment operator must be" }
+!$omp atomic
+    b = b + 3 + b ! { dg-error "cannot reference" }
+!$omp atomic
+    c = c - f + 1 ! { dg-error "not mathematically equivalent to" }
+!$omp atomic
+    a = ishft (a, 1) ! { dg-error "assignment intrinsic must be" }
+!$omp atomic
+    c = min (c, 2.1, c) ! { dg-error "intrinsic arguments except one" }
+!$omp atomic
+    a = max (b, e(1)) ! { dg-error "intrinsic argument must be 'a'" }
+!$omp atomic
+    d = 12 ! { dg-error "assignment must have an operator" }
+end subroutine test_atomic
diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_clauses1.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_clauses1.f90
new file mode 100644
index 000000000..8851101b9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/omp_clauses1.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+      subroutine test1
+	integer :: i, j, k, l
+	common /b/ j, k
+!$omp parallel shared (i) private (/b/)
+!$omp end parallel
+!$omp parallel do shared (/b/), firstprivate (i), lastprivate (i)
+	do l = 1, 10
+	end do
+!$omp end parallel do
+!$omp parallel shared (j) private (/b/) ! { dg-error "'j' present on multiple clauses" }
+!$omp end parallel
+!$omp parallel shared (j, j) private (i) ! { dg-error "'j' present on multiple clauses" }
+!$omp end parallel
+!$omp parallel firstprivate (i, j, i) ! { dg-error "'i' present on multiple clauses" }
+!$omp end parallel
+!$omp parallel shared (i) private (/b/, /b/) ! { dg-error "'\[jk\]' present on multiple clauses" }
+!$omp end parallel
+!$omp parallel shared (i) reduction (+ : i, j) ! { dg-error "'i' present on multiple clauses" }
+!$omp end parallel
+!$omp parallel do shared (/b/), firstprivate (/b/), lastprivate (i) ! { dg-error "'\[jk\]' present on multiple clauses" }
+	do l = 1, 10
+	end do
+!$omp end parallel do
+      end subroutine test1
diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_do1.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_do1.f90
new file mode 100644
index 000000000..c97af1ddb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/omp_do1.f90
@@ -0,0 +1,57 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -std=gnu" }
+subroutine foo
+  integer :: i, j
+  integer, dimension (30) :: a
+  double precision :: d
+  i = 0
+!$omp do private (i)
+  do 100 ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+    if (i .gt. 0) exit ! { dg-error "EXIT statement" }
+100 i = i + 1
+  i = 0
+!$omp do private (i)
+  do ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+    if (i .gt. 0) exit ! { dg-error "EXIT statement" }
+    i = i + 1
+  end do
+  i = 0
+!$omp do private (i)
+  do 200 while (i .lt. 4) ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+200 i = i + 1
+!$omp do private (i)
+  do while (i .lt. 8) ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+    i = i + 1
+  end do
+!$omp do
+  do 300 d = 1, 30, 6 ! { dg-warning "Deleted feature: Loop variable" }
+    i = d
+300 a(i) = 1
+!$omp do
+  do d = 1, 30, 5 ! { dg-warning "Deleted feature: Loop variable" }
+    i = d
+    a(i) = 2
+  end do
+!$omp do
+  do i = 1, 30
+    if (i .eq. 16) exit ! { dg-error "EXIT statement" }
+  end do
+!$omp do
+outer: do i = 1, 30
+    do j = 5, 10
+      if (i .eq. 6 .and. j .eq. 7) exit outer ! { dg-error "EXIT statement" }
+    end do
+  end do outer
+last: do i = 1, 30
+!$omp parallel
+    if (i .eq. 21) exit last ! { dg-error "leaving OpenMP structured block" }
+!$omp end parallel
+  end do last
+!$omp parallel do shared (i)
+  do i = 1, 30, 2 ! { dg-error "iteration variable present on clause" }
+    a(i) = 5
+  end do
+!$omp end parallel do
+end subroutine
+! { dg-error "iteration variable must be of type integer" "" { target *-*-* } 27 }
+! { dg-error "iteration variable must be of type integer" "" { target *-*-* } 31 }
diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_parse1.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_parse1.f90
new file mode 100644
index 000000000..3ab436707
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/omp_parse1.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-omplower" }
+  !$omp  parallel
+call bar
+	!$omp end parallel
+  !$omp 	 	p&
+!$omp&arallel
+call bar
+!$omp e&
+!$omp&ndparallel
+!$omp  &
+!$omp  &  &
+!$omp pa&
+!$omp rallel
+call bar
+!$omp end parallel
+end
+
+! { dg-final { scan-tree-dump-times "pragma omp parallel" 3 "omplower" } }
+! { dg-final { cleanup-tree-dump "omplower" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_parse2.f b/gcc/testsuite/gfortran.dg/gomp/omp_parse2.f
new file mode 100644
index 000000000..510d33795
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/omp_parse2.f
@@ -0,0 +1,14 @@
+c { dg-do compile }
+c { dg-options "-fopenmp -fdump-tree-omplower" }
+!$omp  parallel
+      call bar
+c$omp	end parallel
+C$omp 	 	p
+*$omp+arallel
+      call bar
+!$omp e
+!$omp+ndparallel
+      end
+
+! { dg-final { scan-tree-dump-times "pragma omp parallel" 2 "omplower" } }
+! { dg-final { cleanup-tree-dump "omplower" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_threadprivate1.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_threadprivate1.f90
new file mode 100644
index 000000000..2ccf93cac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/omp_threadprivate1.f90
@@ -0,0 +1,18 @@
+! { dg-require-effective-target tls }
+      module omp_threadprivate1
+	common /T/ a
+      end module omp_threadprivate1
+      subroutine bad1
+	use omp_threadprivate1
+!$omp threadprivate (/T/)	! { dg-error "not found" }
+      end subroutine bad1
+      subroutine bad2
+	common /S/ b
+!$omp threadprivate (/S/)
+      contains
+	subroutine bad3
+!$omp parallel copyin (/T/)	! { dg-error "not found" }
+!$omp end parallel		! { dg-error "" }
+	end subroutine bad3
+      end subroutine bad2
+! { dg-final { cleanup-modules "omp_threadprivate1" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_threadprivate2.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_threadprivate2.f90
new file mode 100644
index 000000000..cd1ab5cd6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/omp_threadprivate2.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+      subroutine bad1
+	double precision :: d	! { dg-error "isn't SAVEd" }
+!$omp threadprivate (d)
+      end subroutine bad1
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr26224.f b/gcc/testsuite/gfortran.dg/gomp/pr26224.f
new file mode 100644
index 000000000..0446d5254
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr26224.f
@@ -0,0 +1,8 @@
+C PR fortran/26224
+C { dg-do compile }
+
+      PROGRAM PR26224
+      INTEGER FOO
+C$OMP SINGLE
+C$OMP END SINGLE COPYPRIVATE (FOO, BAR)
+      END
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr27573.f90 b/gcc/testsuite/gfortran.dg/gomp/pr27573.f90
new file mode 100644
index 000000000..1d3d3b751
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr27573.f90
@@ -0,0 +1,13 @@
+! PR middle-end/27573
+! { dg-do compile }
+! { dg-options "-O2 -fopenmp -fprofile-generate" }
+
+program pr27573
+  integer i,j
+  j = 8
+  !$omp parallel
+    print *, "foo"
+    do i = 1, j - 1
+    end do
+  !$omp end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr29759.f90 b/gcc/testsuite/gfortran.dg/gomp/pr29759.f90
new file mode 100644
index 000000000..b723eeb3c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr29759.f90
@@ -0,0 +1,42 @@
+! PR fortran/29759
+! { dg-do compile }
+
+PROGRAM test_omp
+!$OMP PARALLEL &
+!$OMP NUM_THREADS(2)
+!$OMP END PARALLEL
+
+!$OMP PARALLEL &
+!$OMP & NUM_THREADS(2)
+!$OMP END PARALLEL
+
+!$OMP PARALLEL &
+!
+!$OMP NUM_THREADS(2)
+!$OMP END PARALLEL
+
+!$OMP PARALLEL &
+!
+!$OMP & NUM_THREADS(2)
+!$OMP END PARALLEL
+
+
+!$OMP PARALLEL &		! { dg-error "Unclassifiable OpenMP" }
+!$    NUM_THREADS(2)		! { dg-error "Unclassifiable|Invalid character" }
+!$OMP END PARALLEL		! { dg-error "Unexpected" }
+
+!$OMP PARALLEL &		! { dg-error "Unclassifiable OpenMP" }
+!$    & NUM_THREADS(2)		! { dg-error "Unclassifiable|Invalid character" }
+!$OMP END PARALLEL		! { dg-error "Unexpected" }
+
+!$OMP PARALLEL &		! { dg-error "Unclassifiable OpenMP" }
+!
+!$    NUM_THREADS(2)		! { dg-error "Unclassifiable|Invalid character" }
+!$OMP END PARALLEL		! { dg-error "Unexpected" }
+
+!$OMP PARALLEL &		! { dg-error "Unclassifiable OpenMP" }
+!
+!$    & NUM_THREADS(2)		! { dg-error "Unclassifiable|Invalid character" }
+!$OMP END PARALLEL		! { dg-error "Unexpected" }
+
+END PROGRAM
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr33439.f90 b/gcc/testsuite/gfortran.dg/gomp/pr33439.f90
new file mode 100644
index 000000000..f7db7593d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr33439.f90
@@ -0,0 +1,38 @@
+! PR fortran/33439
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+subroutine pr33439_1
+  integer :: s, i
+  s = 4
+!$omp parallel default(none)	! { dg-error "enclosing parallel" }
+  call somethingelse
+!$omp do schedule(static, s)	! { dg-error "not specified in enclosing parallel" }
+  do i = 1, 8
+    call something
+  end do
+!$omp end do
+!$omp end parallel
+end subroutine pr33439_1
+
+subroutine pr33439_2
+  integer :: s, i
+  s = 4
+!$omp parallel default(none)	! { dg-error "enclosing parallel" }
+!$omp do schedule(static, s)	! { dg-error "not specified in enclosing parallel" }
+  do i = 1, 8
+    call something
+  end do
+!$omp end do
+!$omp end parallel
+end subroutine pr33439_2
+
+subroutine pr33439_3
+  integer :: s, i
+  s = 4
+!$omp parallel do default(none) schedule(static, s) ! { dg-error "enclosing parallel" }
+  do i = 1, 8
+    call something
+  end do
+!$omp end parallel do
+end subroutine pr33439_3
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr35786-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pr35786-1.f90
new file mode 100644
index 000000000..c8639abdb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr35786-1.f90
@@ -0,0 +1,74 @@
+! PR fortran/35786
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+module pr35768
+  real, parameter :: one = 1.0
+contains
+  subroutine fn1
+    !$omp parallel firstprivate (one)	! { dg-error "is not a variable" }
+    !$omp end parallel
+  end subroutine fn1
+  subroutine fn2 (doit)
+    external doit
+    !$omp parallel firstprivate (doit)	! { dg-error "is not a variable" }
+      call doit ()
+    !$omp end parallel
+  end subroutine fn2
+  subroutine fn3
+    interface fn4
+      subroutine fn4 ()
+      end subroutine fn4
+    end interface
+    !$omp parallel private (fn4)	! { dg-error "is not a variable" }
+      call fn4 ()
+    !$omp end parallel
+  end subroutine fn3
+  subroutine fn5
+    interface fn6
+      function fn6 ()
+        integer :: fn6
+      end function fn6
+    end interface
+    integer :: x
+    !$omp parallel private (fn6, x)	! { dg-error "is not a variable" }
+      x = fn6 ()
+    !$omp end parallel
+  end subroutine fn5
+  function fn7 () result (re7)
+    integer :: re7
+    !$omp parallel private (fn7)	! { dg-error "is not a variable" }
+    !$omp end parallel
+  end function fn7
+  function fn8 () result (re8)
+    integer :: re8
+    call fn9
+  contains
+    subroutine fn9
+      !$omp parallel private (fn8)	! { dg-error "is not a variable" }
+      !$omp end parallel
+    end subroutine fn9
+  end function fn8
+  function fn10 () result (re10)
+    integer :: re10, re11
+    entry fn11 () result (re11)
+    !$omp parallel private (fn10)	! { dg-error "is not a variable" }
+    !$omp end parallel
+    !$omp parallel private (fn11)	! { dg-error "is not a variable" }
+    !$omp end parallel
+  end function fn10
+  function fn12 () result (re12)
+    integer :: re12, re13
+    entry fn13 () result (re13)
+    call fn14
+  contains
+    subroutine fn14
+      !$omp parallel private (fn12)	! { dg-error "is not a variable" }
+      !$omp end parallel
+      !$omp parallel private (fn13)	! { dg-error "is not a variable" }
+      !$omp end parallel
+    end subroutine fn14
+  end function fn12
+end module
+
+! { dg-final { cleanup-modules "pr35768" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr35786-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pr35786-2.f90
new file mode 100644
index 000000000..beb1a828d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr35786-2.f90
@@ -0,0 +1,48 @@
+! PR fortran/35786
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+function fn7 ()
+  integer :: fn7
+  !$omp parallel private (fn7)
+    fn7 = 6
+  !$omp end parallel
+  fn7 = 7
+end function fn7
+function fn8 ()
+  integer :: fn8
+  call fn9
+contains
+  subroutine fn9
+    !$omp parallel private (fn8)
+      fn8 = 6
+    !$omp end parallel
+    fn8 = 7
+  end subroutine fn9
+end function fn8
+function fn10 ()
+  integer :: fn10, fn11
+  entry fn11 ()
+  !$omp parallel private (fn10)
+    fn10 = 6
+  !$omp end parallel
+  !$omp parallel private (fn11)
+    fn11 = 6
+  !$omp end parallel
+  fn10 = 7
+end function fn10
+function fn12 ()
+  integer :: fn12, fn13
+  entry fn13 ()
+  call fn14
+contains
+  subroutine fn14
+    !$omp parallel private (fn12)
+      fn12 = 6
+    !$omp end parallel
+    !$omp parallel private (fn13)
+      fn13 = 6
+    !$omp end parallel
+    fn12 = 7
+  end subroutine fn14
+end function fn12
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr36726.f90 b/gcc/testsuite/gfortran.dg/gomp/pr36726.f90
new file mode 100644
index 000000000..99e170ad7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr36726.f90
@@ -0,0 +1,20 @@
+! PR middle-end/36726
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+subroutine foo
+  integer, allocatable :: vs(:)
+  !$omp parallel private (vs)
+  allocate (vs(10))
+  vs = 2
+  deallocate (vs)
+  !$omp end parallel
+end subroutine foo
+subroutine bar
+  integer, allocatable :: vs(:)
+  !$omp parallel private (vs)
+  allocate (vs(10))
+  vs = 2
+  deallocate (vs)
+  !$omp end parallel
+end subroutine bar
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr39152.f90 b/gcc/testsuite/gfortran.dg/gomp/pr39152.f90
new file mode 100644
index 000000000..ff088b5ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr39152.f90
@@ -0,0 +1,32 @@
+! { dg-do compile { target { { i?86-*-* x86_64-*-* } && ilp32 } } }
+! { dg-options "-march=i486 -fopenmp -mavx -O3 -funroll-all-loops" } 
+
+  call test_workshare
+
+contains
+  subroutine test_workshare
+    integer :: i, j, k, l, m
+    double precision, dimension (64) :: d, e
+    integer, dimension (10) :: f, g
+    integer, dimension (16, 16) :: a, b, c
+    integer, dimension (16) :: n
+!$omp parallel num_threads (4) private (j, k)
+!$omp barrier
+!$omp workshare
+    where (g .lt. 0)
+      f = 100
+    elsewhere
+      where (g .gt. 6) f = f + sum (g)
+      f = 300 + f
+    end where
+!$omp end workshare nowait
+!$omp workshare
+    forall (j = 1:16, k = 1:16) b (k, j) = a (j, k)
+    forall (j = 2:16, n (17 - j) / 4 * 4 .ne. n (17 - j))
+      n (j) = n (j - 1) * n (j)
+    end forall
+!$omp endworkshare
+!$omp end parallel
+
+  end subroutine test_workshare
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr39354.f90 b/gcc/testsuite/gfortran.dg/gomp/pr39354.f90
new file mode 100644
index 000000000..3b9c32784
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr39354.f90
@@ -0,0 +1,37 @@
+! PR fortran/39354
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+      SUBROUTINE ltest(l1, l2, l3, l4, r1, r2, r3, r4)
+      LOGICAL l1, l2, l3, l4, r1, r2, r3, r4
+!$OMP ATOMIC
+      l1 = l1 .and. r1
+!$OMP ATOMIC
+      l2 = l2 .or. r2
+!$OMP ATOMIC
+      l3 = l3 .eqv. r3
+!$OMP ATOMIC
+      l4 = l4 .neqv. r4
+      END
+      SUBROUTINE itest(l1, l2, l3, l4, l5, l6, l7, l8, l9, &
+&                      r1, r2, r3, r4, r5, r6, r7, r8, r9)
+      INTEGER l1, l2, l3, l4, l5, l6, l7, l8, l9, &
+&             r1, r2, r3, r4, r5, r6, r7, r8, r9
+!$OMP ATOMIC
+      l1 = l1 + r1
+!$OMP ATOMIC
+      l2 = l2 - r2
+!$OMP ATOMIC
+      l3 = l3 * r3
+!$OMP ATOMIC
+      l4 = l4 / r4
+!$OMP ATOMIC
+      l5 = max (l5, r1, r5)
+!$OMP ATOMIC
+      l6 = min (r1, r6, l6)
+!$OMP ATOMIC
+      l7 = iand (l7, r7)
+!$OMP ATOMIC
+      l8 = ior (r8, l8)
+!$OMP ATOMIC
+      l9 = ieor (l9, r9)
+      END
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr40878-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pr40878-1.f90
new file mode 100644
index 000000000..86202ab5d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr40878-1.f90
@@ -0,0 +1,63 @@
+! PR fortran/40878
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+subroutine test1
+  integer :: j, k
+  integer :: m = 2
+!$omp parallel do collapse(m) schedule (static,1) ! { dg-error "Constant expression required" }
+  do k = 1, 2
+    do j = 1, 6
+    enddo
+  enddo
+!$omp end parallel do
+end
+subroutine test2
+  integer :: j, k
+  integer :: m
+  m = 2
+!$omp parallel do collapse(m) schedule (static,1) ! { dg-error "Constant expression required" }
+  do k = 1, 2
+    do j = 1, 6
+    enddo
+  enddo
+!$omp end parallel do
+end
+subroutine test3
+  integer :: j, k
+  integer, parameter :: m = 0
+!$omp parallel do collapse(m) schedule (static,1) ! { dg-error "not constant positive integer" }
+  do k = 1, 2
+    do j = 1, 6
+    enddo
+  enddo
+!$omp end parallel do
+end
+subroutine test4
+  integer :: j, k
+  integer, parameter :: m = -2
+!$omp parallel do collapse(m) schedule (static,1) ! { dg-error "not constant positive integer" }
+  do k = 1, 2
+    do j = 1, 6
+    enddo
+  enddo
+!$omp end parallel do
+end
+subroutine test5
+  integer :: j, k
+!$omp parallel do collapse(0) schedule (static,1) ! { dg-error "not constant positive integer" }
+  do k = 1, 2
+    do j = 1, 6
+    enddo
+  enddo
+!$omp end parallel do
+end
+subroutine test6
+  integer :: j, k
+!$omp parallel do collapse(-1) schedule (static,1) ! { dg-error "not constant positive integer" }
+  do k = 1, 2
+    do j = 1, 6
+    enddo
+  enddo
+!$omp end parallel do
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr40878-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pr40878-2.f90
new file mode 100644
index 000000000..a118aa860
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr40878-2.f90
@@ -0,0 +1,23 @@
+! PR fortran/40878
+! { dg-do compile }
+! { dg-options "-fopenmp" } 
+
+subroutine test1
+  integer :: j, k
+  integer, parameter :: m = 2
+!$omp parallel do collapse(m) schedule (static,1)
+  do k = 1, 2
+    do j = 1, 6
+    enddo
+  enddo
+!$omp end parallel do
+end
+subroutine test2
+  integer :: j, k
+!$omp parallel do collapse(2) schedule (static,1)
+  do k = 1, 2
+    do j = 1, 6
+    enddo
+  enddo
+!$omp end parallel do
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr41344.f b/gcc/testsuite/gfortran.dg/gomp/pr41344.f
new file mode 100644
index 000000000..66ae8b35d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr41344.f
@@ -0,0 +1,16 @@
+      subroutine xrotate(nerr)
+
+      common /dfm/ndfl
+
+*$omp parallel private(ix)
+      ix = 0
+*$omp do
+      do i=1,ndfl
+         ix = ix + 1
+	 if (ix.gt.5) go to 9000 ! { dg-error "invalid (exit|branch)" }
+      enddo
+*$omp end do
+*$omp end parallel
+
+9000  continue
+      end
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr43337.f90 b/gcc/testsuite/gfortran.dg/gomp/pr43337.f90
new file mode 100644
index 000000000..f07ccb441
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr43337.f90
@@ -0,0 +1,30 @@
+! PR middle-end/43337
+! { dg-do compile }
+! { dg-options "-fopenmp -O2 -g" }
+
+subroutine pr43337
+  integer :: a, b(10)
+  call foo (b)
+  call bar (b)
+contains
+  subroutine foo (b)
+    integer :: b(10)
+!$omp parallel if (.false.)
+!$omp task if (.false.) shared(b)
+    do a = 1, 10
+      b(a) = 1
+    end do
+!$omp end task
+!$omp end parallel
+  end subroutine foo
+  subroutine bar (b)
+    integer :: b(10)
+!$omp parallel if (.false.)
+!$omp parallel if (.false.)
+    do a = 1, 10
+      b(a) = 1
+    end do
+!$omp end parallel
+!$omp end parallel
+  end subroutine bar
+end subroutine pr43337
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr43711.f90 b/gcc/testsuite/gfortran.dg/gomp/pr43711.f90
new file mode 100644
index 000000000..e47e586ea
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr43711.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+!
+! PR fortran/43711 uninformative error message for two 'nowait' in omp statement
+! Contributed by Bill Long <longb AT cray DOT com>
+
+program NF03_2_5_2_1a
+   !$omp parallel
+      !$omp sections
+      !$omp section
+         print *, 'FAIL'
+      !$omp section
+         print *, 'FAIL'
+      !$omp end sections nowait nowait     ! { dg-error "Unexpected junk" }
+   !$omp end parallel
+end program NF03_2_5_2_1a
+
+! { dg-excess-errors "Unexpected" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr43836.f90 b/gcc/testsuite/gfortran.dg/gomp/pr43836.f90
new file mode 100644
index 000000000..cf86523f5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr43836.f90
@@ -0,0 +1,10 @@
+! PR fortran/43836
+! { dg-do compile }
+! { dg-options "-fopenmp -fexceptions -O2" }
+subroutine foo
+!$omp single
+!$omp parallel
+  call bar
+!$omp end parallel
+!$omp end single
+end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr44036-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pr44036-1.f90
new file mode 100644
index 000000000..a4633a3e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr44036-1.f90
@@ -0,0 +1,24 @@
+! PR fortran/44036
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+subroutine foo(a, b)
+  integer, external :: a
+  integer, external, pointer :: b
+  integer, external :: c
+  integer, external, pointer :: d
+  integer :: x
+  x = 6
+!$omp parallel default(none) private (x)
+  x = a(4)
+!$omp end parallel
+!$omp parallel default(none) private (x)	! { dg-error "enclosing parallel" }
+  x = b(5)					! { dg-error "not specified in" }
+!$omp end parallel
+!$omp parallel default(none) private (x)
+  x = c(6)
+!$omp end parallel
+  d => a
+!$omp parallel default(none) private (x)	! { dg-error "enclosing parallel" }
+  x = d(7)					! { dg-error "not specified in" }
+!$omp end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr44036-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pr44036-2.f90
new file mode 100644
index 000000000..c9320f139
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr44036-2.f90
@@ -0,0 +1,17 @@
+! PR fortran/44036
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+subroutine foo(a, b)
+  integer, external :: a
+  integer, external, pointer :: b
+  integer, external :: c
+  integer, external, pointer :: d
+  integer :: x
+  d => a
+!$omp parallel default(none) private (x) firstprivate (b, d)
+  x = a(4)
+  x = b(5)
+  x = c(6)
+  x = d(7)
+!$omp end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr44036-3.f90 b/gcc/testsuite/gfortran.dg/gomp/pr44036-3.f90
new file mode 100644
index 000000000..449cb9572
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr44036-3.f90
@@ -0,0 +1,13 @@
+! PR fortran/44036
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+subroutine foo(a)
+  integer, external :: a, c
+  integer :: x
+!$omp parallel default(none) private (x) shared (a)	! { dg-error "is not a variable" }
+  x = a(6)
+!$omp end parallel
+!$omp parallel default(none) private (x) shared (c)	! { dg-error "is not a variable" }
+  x = c(6)
+!$omp end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr44085.f90 b/gcc/testsuite/gfortran.dg/gomp/pr44085.f90
new file mode 100644
index 000000000..db8fbbc95
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr44085.f90
@@ -0,0 +1,25 @@
+! PR middle-end/44085
+! { dg-do compile }
+! { dg-require-effective-target tls_native }
+! { dg-options "-fopenmp" }
+
+  integer, save :: thr1, thr2
+  integer :: thr3, thr4
+  common /thrs/ thr3, thr4
+!$omp threadprivate (thr1, thr2, /thrs/)
+
+!$omp task untied		! { dg-error "enclosing task" }
+  thr1 = thr1 + 1		! { dg-error "used in untied task" }
+  thr2 = thr2 + 2		! { dg-error "used in untied task" }
+  thr3 = thr3 + 3		! { dg-error "used in untied task" }
+  thr4 = thr4 + 4		! { dg-error "used in untied task" }
+!$omp end task
+
+!$omp task
+  thr1 = thr1 + 1
+  thr2 = thr2 + 2
+  thr3 = thr3 + 3
+  thr4 = thr4 + 4
+!$omp end task
+
+  end
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr44536.f90 b/gcc/testsuite/gfortran.dg/gomp/pr44536.f90
new file mode 100644
index 000000000..0dc896dcc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr44536.f90
@@ -0,0 +1,10 @@
+! PR fortran/44536
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+      subroutine foo (a, i, j)
+        integer, dimension(:) :: a
+        integer :: i, j
+!$omp parallel default(none) shared(i, j)	! { dg-error "enclosing parallel" }
+        j=a(i)					! { dg-error "not specified in" }
+!$omp end parallel
+      end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr44847.f90 b/gcc/testsuite/gfortran.dg/gomp/pr44847.f90
new file mode 100644
index 000000000..3da431149
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr44847.f90
@@ -0,0 +1,86 @@
+! PR fortran/44847
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+subroutine pr44847_1
+  integer :: i, j
+!$omp parallel do collapse(2)
+l:do i = 1, 2
+    do j = 1, 2
+      cycle l		! { dg-error "CYCLE statement" }
+    end do
+  end do l
+end subroutine
+subroutine pr44847_2
+  integer :: i, j, k
+!$omp parallel do collapse(3)
+  do i = 1, 2
+  l:do j = 1, 2
+      do k = 1, 2
+        cycle l		! { dg-error "CYCLE statement" }
+      end do
+    end do l
+  end do
+end subroutine
+subroutine pr44847_3
+  integer :: i, j
+!$omp parallel do
+l:do i = 1, 2
+    do j = 1, 2
+      cycle l
+    end do
+  end do l
+end subroutine
+subroutine pr44847_4
+  integer :: i, j, k
+!$omp parallel do collapse(2)
+  do i = 1, 2
+  l:do j = 1, 2
+      do k = 1, 2
+        cycle l
+      end do
+    end do l
+  end do
+end subroutine
+subroutine pr44847_5
+  integer :: i, j
+!$omp parallel do collapse(2)
+l:do i = 1, 2
+    do j = 1, 2
+      exit l		! { dg-error "EXIT statement" }
+    end do
+  end do l
+end subroutine
+subroutine pr44847_6
+  integer :: i, j, k
+!$omp parallel do collapse(3)
+  do i = 1, 2
+  l:do j = 1, 2
+      do k = 1, 2
+        exit l		! { dg-error "EXIT statement" }
+      end do
+    end do l
+  end do
+end subroutine
+subroutine pr44847_7
+  integer :: i, j, k
+!$omp parallel do collapse(2)
+  do i = 1, 2
+  l:do j = 1, 2
+      do k = 1, 2
+        exit l		! { dg-error "EXIT statement" }
+      end do
+    end do l
+  end do
+end subroutine
+subroutine pr44847_8
+  integer :: i, j, k
+!$omp parallel do
+  do i = 1, 2
+  l:do j = 1, 2
+      do k = 1, 2
+        exit l
+      end do
+    end do l
+  end do
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr45172.f90 b/gcc/testsuite/gfortran.dg/gomp/pr45172.f90
new file mode 100644
index 000000000..dbb242bb1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr45172.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-O -fopenmp -fexceptions" }
+
+  SUBROUTINE dbcsr_mult_m_e_e ( )
+    LOGICAL, PARAMETER   :: use_combined_types = .FALSE.
+    INTEGER, ALLOCATABLE, DIMENSION(:, :) ::  right_index_sr
+    INTEGER, ALLOCATABLE, DIMENSION(:, :, :) ::  my_sizes
+    INTEGER, ALLOCATABLE,  DIMENSION(:, :, :, :) :: all_sizes
+    ALLOCATE (all_sizes(4, LBOUND(my_sizes,2):UBOUND(my_sizes,2), &
+              LBOUND(my_sizes,3):UBOUND(my_sizes,3), 0:numnodes-1))
+          IF (use_combined_types) THEN
+             CALL mp_waitall (right_index_sr)
+          ENDIF
+          DO ki = 0, min_nimages-1
+!$omp parallel default (none) &
+!$omp reduction (+: flop_single, t_all, t_dgemm)
+!$omp end parallel
+          ENDDO
+       checksum = dbcsr_checksum (product_matrix, error)
+  END SUBROUTINE dbcsr_mult_m_e_e
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr45595.f90 b/gcc/testsuite/gfortran.dg/gomp/pr45595.f90
new file mode 100644
index 000000000..ab10c3f95
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr45595.f90
@@ -0,0 +1,10 @@
+! PR fortran/45595
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+subroutine foo(l,u)
+  integer :: k,l,u
+  !$omp parallel do shared(l,u) collapse(3)	! { dg-error "not enough DO loops" }
+    do k = l,u
+    end do
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr45597.f90 b/gcc/testsuite/gfortran.dg/gomp/pr45597.f90
new file mode 100644
index 000000000..6d6a65d44
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr45597.f90
@@ -0,0 +1,22 @@
+! PR fortran/45597
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+subroutine foo(n)
+  integer :: i, n(6)
+  !$omp parallel do default(none) shared(n)
+    do i = 1, 6
+      if (n(i).gt.0) cycle
+    end do
+end subroutine
+subroutine bar(n)
+  integer :: i, j, k, n(6, 6, 6)
+  !$omp parallel do default(none) shared(n) collapse(3)
+    do i = 1, 6
+      do j = 1, 6
+        do k = 1, 6
+          if (n(i, j, k).gt.0) cycle
+        end do
+      end do
+    end do
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr47331.f90 b/gcc/testsuite/gfortran.dg/gomp/pr47331.f90
new file mode 100644
index 000000000..71713e022
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr47331.f90
@@ -0,0 +1,24 @@
+! PR fortran/47331
+! { dg-do compile }
+! { dg-options "-fopenmp -fwhole-file" }
+
+subroutine foo
+  !$omp parallel
+    call bar ()
+  !$omp end parallel
+end subroutine foo
+
+subroutine bar
+  integer :: k
+  do k=1,5
+    call baz (k)
+  end do
+end subroutine bar
+
+subroutine baz (k)
+  integer :: k
+end subroutine
+
+program pr47331
+  call foo
+end program pr47331
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr48117.f90 b/gcc/testsuite/gfortran.dg/gomp/pr48117.f90
new file mode 100644
index 000000000..bc8ad9bc3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr48117.f90
@@ -0,0 +1,11 @@
+! PR fortran/48117
+! { dg-do compile }
+! { dg-options "-O2 -fopenmp" }
+
+subroutine foo(x)
+  character(len=*), optional :: x
+  character(len=80) :: v
+  !$omp master
+    if (present(x)) v = adjustl(x)
+  !$omp end master
+end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr48611.f90 b/gcc/testsuite/gfortran.dg/gomp/pr48611.f90
new file mode 100644
index 000000000..643cc5c3e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr48611.f90
@@ -0,0 +1,12 @@
+! PR tree-optimization/48611
+! { dg-do compile }
+! { dg-options "-Os -fopenmp -fexceptions -fno-tree-ccp -fno-tree-copy-prop" }
+
+  integer, allocatable :: a(:)
+  logical :: l
+!$omp parallel private (a) reduction (.or.:l)
+  do i = 1, 7
+    a(:) = i
+  end do
+!$omp end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr48794.f90 b/gcc/testsuite/gfortran.dg/gomp/pr48794.f90
new file mode 100644
index 000000000..11edb0bb4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr48794.f90
@@ -0,0 +1,12 @@
+! PR tree-optimization/48794
+! { dg-do compile }
+! { dg-options "-Os -fopenmp -fexceptions -fno-tree-ccp -fno-tree-copy-prop" }
+
+  integer, allocatable :: a(:)
+  logical :: l
+  if (allocated (a)) call abort
+!$omp parallel private (a) reduction (.or.:l)
+  do i = 1, 7
+  end do
+!$omp end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction1.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction1.f90
new file mode 100644
index 000000000..4912f7178
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction1.f90
@@ -0,0 +1,132 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fmax-errors=100" }
+! { dg-require-effective-target tls }
+
+subroutine foo (ia1)
+integer :: i1, i2, i3
+integer, dimension (*) :: ia1
+integer, dimension (10) :: ia2
+real :: r1
+real, dimension (5) :: ra1
+double precision :: d1
+double precision, dimension (4) :: da1
+complex :: c1
+complex, dimension (7) :: ca1
+logical :: l1
+logical, dimension (3) :: la1
+character (5) :: a1
+type t
+  integer :: i
+end type
+type(t) :: t1
+type(t), dimension (2) :: ta1
+real, pointer :: p1 => NULL()
+integer, allocatable :: aa1 (:,:)
+save i2
+!$omp threadprivate (i2)
+common /blk/ i1
+
+!$omp parallel reduction (+:i3, ia2, r1, ra1, d1, da1, c1, ca1)
+!$omp end parallel
+!$omp parallel reduction (*:i3, ia2, r1, ra1, d1, da1, c1, ca1)
+!$omp end parallel
+!$omp parallel reduction (-:i3, ia2, r1, ra1, d1, da1, c1, ca1)
+!$omp end parallel
+!$omp parallel reduction (.and.:l1, la1)
+!$omp end parallel
+!$omp parallel reduction (.or.:l1, la1)
+!$omp end parallel
+!$omp parallel reduction (.eqv.:l1, la1)
+!$omp end parallel
+!$omp parallel reduction (.neqv.:l1, la1)
+!$omp end parallel
+!$omp parallel reduction (min:i3, ia2, r1, ra1, d1, da1)
+!$omp end parallel
+!$omp parallel reduction (max:i3, ia2, r1, ra1, d1, da1)
+!$omp end parallel
+!$omp parallel reduction (iand:i3, ia2)
+!$omp end parallel
+!$omp parallel reduction (ior:i3, ia2)
+!$omp end parallel
+!$omp parallel reduction (ieor:i3, ia2)
+!$omp end parallel
+!$omp parallel reduction (+:/blk/)	! { dg-error "Syntax error" }
+!$omp end parallel			! { dg-error "Unexpected" }
+!$omp parallel reduction (+:i2)		! { dg-error "THREADPRIVATE object" }
+!$omp end parallel
+!$omp parallel reduction (*:p1)		! { dg-error "POINTER object" }
+!$omp end parallel
+!$omp parallel reduction (-:aa1)
+!$omp end parallel
+!$omp parallel reduction (*:ia1)	! { dg-error "Assumed size" }
+!$omp end parallel
+!$omp parallel reduction (+:l1)		! { dg-error "must be of numeric type, got LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (*:la1)	! { dg-error "must be of numeric type, got LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (-:a1)		! { dg-error "must be of numeric type, got CHARACTER" }
+!$omp end parallel
+!$omp parallel reduction (+:t1)		! { dg-error "must be of numeric type, got TYPE" }
+!$omp end parallel
+!$omp parallel reduction (*:ta1)	! { dg-error "must be of numeric type, got TYPE" }
+!$omp end parallel
+!$omp parallel reduction (.and.:i3)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.or.:ia2)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.eqv.:r1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.neqv.:ra1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.and.:d1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.or.:da1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.eqv.:c1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.neqv.:ca1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.and.:a1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.or.:t1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.eqv.:ta1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (min:c1)	! { dg-error "must be INTEGER or REAL" }
+!$omp end parallel
+!$omp parallel reduction (max:ca1)	! { dg-error "must be INTEGER or REAL" }
+!$omp end parallel
+!$omp parallel reduction (max:l1)	! { dg-error "must be INTEGER or REAL" }
+!$omp end parallel
+!$omp parallel reduction (min:la1)	! { dg-error "must be INTEGER or REAL" }
+!$omp end parallel
+!$omp parallel reduction (max:a1)	! { dg-error "must be INTEGER or REAL" }
+!$omp end parallel
+!$omp parallel reduction (min:t1)	! { dg-error "must be INTEGER or REAL" }
+!$omp end parallel
+!$omp parallel reduction (max:ta1)	! { dg-error "must be INTEGER or REAL" }
+!$omp end parallel
+!$omp parallel reduction (iand:r1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (ior:ra1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (ieor:d1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (ior:da1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (iand:c1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (ior:ca1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (ieor:l1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (iand:la1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (ior:a1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (ieor:t1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (iand:ta1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction2.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction2.f90
new file mode 100644
index 000000000..f855d0e7f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction2.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+
+subroutine f1
+  integer :: i
+  i = 0
+!$omp parallel reduction (ior:i)
+  i = ior (i, 3)
+!$omp end parallel
+!$omp parallel reduction (ior:i)
+  i = ior (i, 16)
+!$omp end parallel
+end subroutine f1
+subroutine f2
+  integer :: i
+  i = ior (2, 4)
+!$omp parallel reduction (ior:i)
+  i = ior (i, 3)
+!$omp end parallel
+end subroutine f2
+subroutine f3
+  integer :: i
+  i = 6
+!$omp parallel reduction (ior:i)
+  i = ior (i, 3)
+!$omp end parallel
+end subroutine f3
+subroutine f4
+  integer :: i, ior
+  i = 6
+!$omp parallel reduction (ior:i)
+  i = ior (i, 3)
+!$omp end parallel
+end subroutine f4
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction3.f90
new file mode 100644
index 000000000..0272a7415
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction3.f90
@@ -0,0 +1,65 @@
+! { dg-do compile }
+
+module mreduction3
+  interface
+    function ior (a, b)
+      integer :: ior, a, b
+    end function
+  end interface
+contains
+  function iand (a, b)
+    integer :: iand, a, b
+    iand = a + b
+  end function
+end module mreduction3
+subroutine f1
+  integer :: i, ior
+  ior = 6
+  i = 6
+!$omp parallel reduction (ior:i) ! { dg-error "is not INTRINSIC procedure name" }
+!$omp end parallel
+end subroutine f1
+subroutine f2
+  integer :: i
+  interface
+    function ior (a, b)
+      integer :: ior, a, b
+    end function
+  end interface
+  i = 6
+!$omp parallel reduction (ior:i) ! { dg-error "is not INTRINSIC procedure name" }
+  i = ior (i, 3)
+!$omp end parallel
+end subroutine f2
+subroutine f3
+  integer :: i
+  intrinsic ior
+  i = 6
+!$omp parallel reduction (ior:i)
+  i = ior (i, 3)
+!$omp end parallel
+end subroutine f3
+subroutine f4
+  integer :: i, ior
+  i = 6
+!$omp parallel reduction (ior:i)
+  ior = 4			 ! { dg-error "is not a variable" }
+!$omp end parallel
+end subroutine f4
+subroutine f5
+  use mreduction3
+  integer :: i
+  i = 6
+!$omp parallel reduction (ior:i) ! { dg-error "is not INTRINSIC procedure name" }
+  i = ior (i, 7)
+!$omp end parallel
+end subroutine f5
+subroutine f6
+  use mreduction3
+  integer :: i
+  i = 6
+!$omp parallel reduction (iand:i) ! { dg-error "is not INTRINSIC procedure name" }
+  i = iand (i, 18)
+!$omp end parallel
+end subroutine f6
+! { dg-final { cleanup-modules "mreduction3" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/sharing-1.f90 b/gcc/testsuite/gfortran.dg/gomp/sharing-1.f90
new file mode 100644
index 000000000..7a107ffe7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/sharing-1.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+
+  integer :: thrpriv, thr, i, j, s, g1, g2, m
+  integer, dimension (6) :: p
+  common /thrblk/ thr
+  common /gblk/ g1
+  save thrpriv, g2
+!$omp threadprivate (/thrblk/, thrpriv)
+  s = 1
+!$omp parallel do default (none) &
+!$omp & private (p) shared (s) ! { dg-error "enclosing parallel" }
+  do i = 1, 64
+    call foo (thrpriv)	! Predetermined - threadprivate
+    call foo (thr)	! Predetermined - threadprivate
+    call foo (i)	! Predetermined - omp do iteration var
+    do j = 1, 64	! Predetermined - sequential loop
+      call foo (j)	! iteration variable
+    end do
+    call bar ((/ (k * 4, k = 1, 8) /)) ! Predetermined - implied do
+    forall (l = 1 : i) &! Predetermined - forall indice
+      p(l) = 6		! Explicitly determined - private
+    call foo (s)	! Explicitly determined - shared
+    call foo (g1)	! { dg-error "not specified in" }
+    call foo (g2)	! { dg-error "not specified in" }
+    call foo (m)	! { dg-error "not specified in" }
+  end do
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/sharing-2.f90 b/gcc/testsuite/gfortran.dg/gomp/sharing-2.f90
new file mode 100644
index 000000000..b7d7e0729
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/sharing-2.f90
@@ -0,0 +1,84 @@
+  integer :: i, j, k, l
+  integer, dimension (10, 10) :: a
+!$omp parallel do default (none) shared (a)
+  do i = 1, 10
+    j = 4
+    do j = 1, 10
+      a(i, j) = i + j
+    end do
+    j = 8
+  end do
+!$omp end parallel do
+!$omp parallel default (none) shared (a) ! { dg-error "enclosing parallel" }
+  i = 1
+  j = 1
+  k = 1
+  l = 1		! { dg-error "not specified in" }
+  do i = 1, 10
+    a(i, 1) = 1
+  end do
+!$omp critical
+  do j = 1, 10
+    a(1, j) = j
+  end do
+!$omp end critical
+!$omp single
+  do k = 1, 10
+    a(k, k) = k
+  end do
+!$omp end single
+!$omp end parallel
+!$omp parallel default (none) shared (a) ! { dg-error "enclosing parallel" }
+  i = 1		! { dg-error "not specified in" }
+  j = 1		! { dg-error "not specified in" }
+  k = 1		! { dg-error "not specified in" }
+!$omp parallel default (none) shared (a)
+  i = 1
+  j = 1
+  k = 1
+  do i = 1, 10
+    a(i, 1) = 1
+  end do
+!$omp critical
+  do j = 1, 10
+    a(1, j) = j
+  end do
+!$omp end critical
+!$omp single
+  do k = 1, 10
+    a(k, k) = k
+  end do
+!$omp end single
+!$omp end parallel
+  i = 1
+  j = 1
+  k = 1
+!$omp end parallel
+!$omp parallel default (none) shared (a) ! { dg-error "enclosing parallel" }
+  i = 1		! { dg-error "not specified in" }
+!$omp do
+  do i = 1, 10
+    a(i, 1) = i + 1
+  end do
+!$omp end parallel
+!$omp parallel default (none) shared (a) ! { dg-error "enclosing parallel" }
+  i = 1		! { dg-error "not specified in" }
+!$omp parallel do default (none) shared (a)
+  do i = 1, 10
+    a(i, 1) = i + 1
+  end do
+!$omp end parallel
+!$omp parallel default (none) shared (a) ! { dg-error "enclosing parallel" }
+  i = 1		! { dg-error "not specified in" }
+!$omp parallel default (none) shared (a, i)
+  i = 2
+!$omp parallel default (none) shared (a)
+  do i = 1, 10
+    a(i, 1) = i
+  end do
+!$omp end parallel
+  i = 3
+!$omp end parallel
+  i = 4
+!$omp end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/sharing-3.f90 b/gcc/testsuite/gfortran.dg/gomp/sharing-3.f90
new file mode 100644
index 000000000..05be38283
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/sharing-3.f90
@@ -0,0 +1,37 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+subroutine foo (vara, varb, varc, vard, n)
+  integer :: n, vara(n), varb(*), varc(:), vard(6), vare(6)
+  vare(:) = 0
+  !$omp parallel default(none) shared(vara, varb, varc, vard, vare)
+    !$omp master
+      vara(1) = 1
+      varb(1) = 1
+      varc(1) = 1
+      vard(1) = 1
+      vare(1) = 1
+    !$omp end master
+  !$omp end parallel
+  !$omp parallel default(none) private(vara, varc, vard, vare)
+    vara(1) = 1
+    varc(1) = 1
+    vard(1) = 1
+    vare(1) = 1
+  !$omp end parallel
+  !$omp parallel default(none) firstprivate(vara, varc, vard, vare)
+    vara(1) = 1
+    varc(1) = 1
+    vard(1) = 1
+    vare(1) = 1
+  !$omp end parallel
+  !$omp parallel default(none)	! { dg-error "enclosing parallel" }
+    !$omp master
+      vara(1) = 1		! { dg-error "not specified" }
+      varb(1) = 1		! Assumed-size is predetermined
+      varc(1) = 1		! { dg-error "not specified" }
+      vard(1) = 1		! { dg-error "not specified" }
+      vare(1) = 1		! { dg-error "not specified" }
+    !$omp end master
+  !$omp end parallel
+end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/gomp/workshare1.f90 b/gcc/testsuite/gfortran.dg/gomp/workshare1.f90
new file mode 100644
index 000000000..ffbb1db82
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/workshare1.f90
@@ -0,0 +1,42 @@
+! { dg-do compile }
+
+interface
+  subroutine foo
+  end subroutine
+  function bar ()
+  integer :: bar
+  end function bar
+  elemental function baz ()
+  integer :: baz
+  end function baz
+end interface
+
+  integer :: i, j
+  real :: a, b (10), c
+  a = 0.5
+  b = 0.25
+!$omp parallel workshare
+  a = sin (a)
+  b = sin (b)
+  forall (i = 1:10) b(i) = cos (b(i)) - 0.5
+  j = baz ()
+!$omp parallel if (bar () .gt. 2) &
+!$omp & num_threads (bar () + 1)
+  i = bar ()
+!$omp end parallel
+!$omp parallel do schedule (static, bar () + 4)
+  do j = 1, 10
+    i = bar ()
+  end do
+!$omp end parallel do
+!$omp end parallel workshare
+!$omp parallel workshare
+  call foo			! { dg-error "CALL statement" }
+  i = bar ()			! { dg-error "non-ELEMENTAL" }
+!$omp critical
+  i = bar ()			! { dg-error "non-ELEMENTAL" }
+!$omp end critical
+!$omp atomic
+  j = j + bar ()		! { dg-error "non-ELEMENTAL" }
+!$omp end parallel workshare
+end
diff --git a/gcc/testsuite/gfortran.dg/goto_1.f b/gcc/testsuite/gfortran.dg/goto_1.f
new file mode 100644
index 000000000..11b7c535f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goto_1.f
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+! PR 18540
+! Verify that old-style cross-block GOTOs work
+      I = 1
+      GO TO 2
+      IF (I .EQ. 0) THEN
+ 2       IF (I .NE. 1) CALL ABORT
+         I = 0
+         GOTO 3
+      ELSE
+ 3       I = 2
+      END IF
+      IF (I .NE. 2) CALL ABORT
+      END
diff --git a/gcc/testsuite/gfortran.dg/goto_2.f90 b/gcc/testsuite/gfortran.dg/goto_2.f90
new file mode 100644
index 000000000..fc5e8d830
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goto_2.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+! Checks for corrects warnings if branching to then end of a
+! construct at various nesting levels
+  subroutine check_if(i)
+    goto 10  ! { dg-warning "Label at ... is not in the same block" }
+    if (i > 0) goto 40
+    if (i < 0) then
+       goto 40
+10  end if    ! { dg-warning "Label at ... is not in the same block" }
+    if (i == 0) then
+       i = i+1
+       goto 20
+       goto 40
+20  end if
+    if (i == 1) then
+       i = i+1
+       if (i == 2) then
+          goto 30
+       end if
+       goto 40
+30  end if
+    return
+40  i = -1
+  end subroutine check_if
+  
+  subroutine check_select(i)
+    goto 10  ! { dg-warning "Label at ... is not in the same block" }
+    select case (i)
+    case default
+       goto 999
+10  end select  ! { dg-warning "Label at ... is not in the same block" }
+    select case (i)
+    case (2)
+       i = 1
+       goto 20
+       goto 999
+    case default
+       goto 999
+20  end select
+    j = i
+    select case (j)
+    case default
+       select case (i)
+       case (1)
+          i = 2
+          goto 30
+       end select
+       goto 999
+30  end select
+    return    
+999 i = -1
+  end subroutine check_select
+
+  i = 0
+  call check_if (i)
+  if (i /= 2) call abort ()
+  call check_select (i)
+  if (i /= 2) call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/goto_3.f90 b/gcc/testsuite/gfortran.dg/goto_3.f90
new file mode 100644
index 000000000..918443abb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goto_3.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! Verify that various cases of invalid branches are rejected
+   dimension a(10)
+   if (i>0) then
+      goto 10  ! { dg-error "not a valid branch target statement" }
+10 else        ! { dg-error "not a valid branch target statement" }
+      i = -i
+   end if
+
+   goto 20     ! { dg-error "not a valid branch target statement" }
+   forall (i=1:10)
+      a(i) = 2*i
+20 end forall  ! { dg-error "not a valid branch target statement" }
+
+   goto 30     ! { dg-error "not a valid branch target statement" }
+   goto 40     ! { dg-error "not a valid branch target statement" }
+   where (a>0)
+      a = 2*a
+30 elsewhere   ! { dg-error "not a valid branch target statement" }
+      a = a/2
+40 end where   ! { dg-error "not a valid branch target statement" }
+ end
+ 
diff --git a/gcc/testsuite/gfortran.dg/goto_4.f90 b/gcc/testsuite/gfortran.dg/goto_4.f90
new file mode 100644
index 000000000..7340814cc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goto_4.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! PR 17708: Jumping to END DO statements didn't do the right thing
+! PR 38507: The warning we used to give was wrong
+      program test
+        j = 0
+        do 10 i=1,3
+           if(i == 2) goto 10
+           j = j+1
+10      enddo
+        if (j/=2) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/goto_5.f90 b/gcc/testsuite/gfortran.dg/goto_5.f90
new file mode 100644
index 000000000..44ba69724
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goto_5.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! PR 38507
+! Verify that we correctly flag invalid gotos, while not flagging valid gotos.
+integer i,j
+
+do i=1,10
+   goto 20
+20 end do   ! { dg-warning "is not in the same block" }
+
+goto 20   ! { dg-warning "is not in the same block" }
+goto 25   ! { dg-warning "is not in the same block" }
+goto 40   ! { dg-warning "is not in the same block" }
+goto 50   ! { dg-warning "is not in the same block" }
+
+goto 222
+goto 333
+goto 444
+
+222 if (i < 0) then
+25 end if      ! { dg-warning "is not in the same block" }
+
+333 if (i > 0) then
+   do j = 1,20
+      goto 30
+   end do
+else if (i == 0) then
+   goto 30
+else
+   goto 30
+30 end if
+
+444 select case(i)
+case(0)
+   goto 50
+   goto 60  ! { dg-warning "is not in the same block" }
+case(1)
+   goto 40
+   goto 50
+   40 continue  ! { dg-warning "is not in the same block" }
+   60 continue    ! { dg-warning "is not in the same block" }
+50 end select   ! { dg-warning "is not in the same block" }
+continue 
+
+end
diff --git a/gcc/testsuite/gfortran.dg/goto_6.f b/gcc/testsuite/gfortran.dg/goto_6.f
new file mode 100644
index 000000000..5b054b636
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goto_6.f
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-options "-w" }
+
+! PR fortran/41403
+! Assigned-goto with label list used to compare label addresses which
+! failed with optimization.  Check this works correctly now.
+! This is the most reduced Fortran code from the PR.
+
+      IVFAIL=0
+      ASSIGN 1263 TO I
+      GO TO I, (1262,1263,1264)
+ 1262 ICON01 = 1262
+      GO TO 1265
+ 1263 ICON01 = 1263
+      GO TO 1265
+ 1264 ICON01 = 1264
+ 1265 CONTINUE
+41260 IF ( ICON01 - 1263 )  21260, 11260, 21260
+11260 IVPASS = IVPASS + 1
+      GO TO 1271
+21260 IVFAIL = IVFAIL + 1
+ 1271 CONTINUE
+      IF (IVFAIL /= 0) CALL abort ()
+      END
diff --git a/gcc/testsuite/gfortran.dg/goto_7.f b/gcc/testsuite/gfortran.dg/goto_7.f
new file mode 100644
index 000000000..e230b7b6f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goto_7.f
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+
+! Check for error message when computed and assigned gotos reference
+! illegal label numbers.
+
+      ASSIGN 1 TO I
+      GOTO (1, 2, 3, 42), 2 ! { dg-error "is never defined" }
+      GOTO I, (1, 2, 3, 43) ! { dg-error "is never defined" }
+ 1    CONTINUE
+ 2    CONTINUE
+ 3    CONTINUE
+c     No label 42 or 43.
+      END
diff --git a/gcc/testsuite/gfortran.dg/goto_8.f90 b/gcc/testsuite/gfortran.dg/goto_8.f90
new file mode 100644
index 000000000..744b5f3c8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goto_8.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+!
+! PR 41781: [OOP] bogus undefined label error with SELECT TYPE.
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+! and Tobias Burnus >burnus@gcc.gnu.org>
+
+! 1st example: jumping out of SELECT TYPE (valid)
+type bar
+  integer :: i
+end type bar
+class(bar), pointer :: var
+select type(var)
+class default
+  goto 9999
+end select
+9999 continue
+
+! 2nd example: jumping out of BLOCK (valid) 
+block
+  goto 88
+end block
+88 continue
+
+! 3rd example: jumping into BLOCK (invalid)
+goto 99        ! { dg-warning "is not in the same block" }
+block
+  99 continue  ! { dg-warning "is not in the same block" }
+end block
+
+end
diff --git a/gcc/testsuite/gfortran.dg/graphite/block-1.f90 b/gcc/testsuite/gfortran.dg/graphite/block-1.f90
new file mode 100644
index 000000000..cea307e5a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/block-1.f90
@@ -0,0 +1,13 @@
+subroutine matrix_multiply(a,b,c,n)
+
+real(8), dimension(n,n) :: a,b,c
+
+! The following code is disabled for the moment.
+c=0.d0
+
+end subroutine matrix_multiply
+
+! { dg-final { scan-tree-dump-times "number of SCoPs: 1" 1 "graphite" } }
+! { dg-final { scan-tree-dump-times "will be loop blocked" 1 "graphite" { xfail *-*-* } } }
+! { dg-final { cleanup-tree-dump "graphite" } }
+
diff --git a/gcc/testsuite/gfortran.dg/graphite/block-2.f b/gcc/testsuite/gfortran.dg/graphite/block-2.f
new file mode 100644
index 000000000..75fccca14
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/block-2.f
@@ -0,0 +1,21 @@
+      SUBROUTINE MATRIX_MUL_UNROLLED (A, B, C, L, M, N)
+      DIMENSION A(L,M), B(M,N), C(L,N)
+
+      DO 100 K = 1, N
+        DO 100 I = 1, L
+          C(I,K) = 0.
+100     CONTINUE
+      DO 110 J = 1, M, 4
+        DO 110 K = 1, N
+          DO 110 I = 1, L
+            C(I,K) = C(I,K) + A(I,J) * B(J,K)
+     $             + A(I,J+1) * B(J+1,K) + A(I,J+2) * B(J+2,K)
+     $             + A(I,J+3) * B(J+3,K)
+110   CONTINUE
+
+      RETURN
+      END
+
+! { dg-final { scan-tree-dump-times "number of SCoPs: 2" 1 "graphite" } }
+! { dg-final { scan-tree-dump-times "will be loop blocked" 2 "graphite" { xfail *-*-* } } }
+! { dg-final { cleanup-tree-dump "graphite" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/block-3.f90 b/gcc/testsuite/gfortran.dg/graphite/block-3.f90
new file mode 100644
index 000000000..9a66adffd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/block-3.f90
@@ -0,0 +1,18 @@
+subroutine matrix_multiply(a,b,c,n)
+
+real(8), dimension(n,n) :: a,b,c
+
+do i = 1,n
+  do j = 1,n
+    do k = 1,n
+      c(j,i) = c(j,i) + a(k,i) * b(j,k)
+    enddo
+ enddo
+enddo
+
+end subroutine matrix_multiply
+
+! { dg-final { scan-tree-dump-times "number of SCoPs: 1" 1 "graphite" { xfail *-*-* } } }
+! { dg-final { scan-tree-dump-times "will be loop blocked" 1 "graphite" { xfail *-*-* } } }
+! { dg-final { cleanup-tree-dump "graphite" } }
+
diff --git a/gcc/testsuite/gfortran.dg/graphite/block-4.f90 b/gcc/testsuite/gfortran.dg/graphite/block-4.f90
new file mode 100644
index 000000000..061830fb9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/block-4.f90
@@ -0,0 +1,21 @@
+subroutine matrix_multiply(a,b,c,n)
+
+real(8), dimension(n,n) :: a,b,c
+
+! The following code is disabled for the moment.
+! c=0.d0
+
+do i = 1,n
+  do j = 1,n
+    do k = 1,n
+      c(j,i) = c(j,i) + a(k,i) * b(j,k)
+    enddo
+ enddo
+enddo
+
+end subroutine matrix_multiply
+
+! { dg-final { scan-tree-dump-times "number of SCoPs: 1" 1 "graphite" { xfail *-*-* } } }
+! { dg-final { scan-tree-dump-times "will be loop blocked" 1 "graphite" { xfail *-*-* } } }
+! { dg-final { cleanup-tree-dump "graphite" } }
+
diff --git a/gcc/testsuite/gfortran.dg/graphite/graphite.exp b/gcc/testsuite/gfortran.dg/graphite/graphite.exp
new file mode 100644
index 000000000..73c2aeed4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/graphite.exp
@@ -0,0 +1,78 @@
+#   Copyright (C) 2008, 2010 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# GCC testsuite that uses the `dg.exp' driver.
+
+# Load support procs.
+load_lib gfortran-dg.exp
+
+if ![check_effective_target_fgraphite] {
+  return
+}
+
+# Remove VALUE from LIST_VARIABLE.
+proc lremove {list_variable value} {
+    upvar 1 $list_variable var
+    set idx [lsearch -exact $var $value]
+    set var [lreplace $var $idx $idx]
+}
+
+# The default action for a test is 'compile'.  Save current default.
+global dg-do-what-default
+set save-dg-do-what-default ${dg-do-what-default}
+
+# Initialize `dg'.
+dg-init
+
+set wait_to_run_files [lsort [glob -nocomplain $srcdir/$subdir/*.\[fF\]{,90,95,03,08} ] ]
+set block_files       [lsort [glob -nocomplain $srcdir/$subdir/block-*.\[fF\]{,90,95,03,08} ] ]
+set id_files          [lsort [glob -nocomplain $srcdir/$subdir/id-*.\[fF\]{,90,95,03,08} ] ]
+set interchange_files [lsort [glob -nocomplain $srcdir/$subdir/interchange-*.\[fF\]{,90,95,03,08} ] ]
+set scop_files        [lsort [glob -nocomplain $srcdir/$subdir/scop-*.\[fF\]{,90,95,03,08} ] ]
+set run_id_files      [lsort [glob -nocomplain $srcdir/$subdir/run-id-*.\[fF\]{,90,95,03,08} ] ]
+set vect_files        [lsort [glob -nocomplain $srcdir/$subdir/vect-*.\[fF\]{,90,95,03,08} ] ]
+
+# Tests to be compiled.
+set dg-do-what-default compile
+gfortran-dg-runtest $scop_files        "-O2 -fgraphite -fdump-tree-graphite-all"
+gfortran-dg-runtest $id_files          "-O2 -fgraphite-identity -ffast-math"
+gfortran-dg-runtest $interchange_files "-O2 -floop-interchange -fno-loop-block -fno-loop-strip-mine -ffast-math -fdump-tree-graphite-all"
+gfortran-dg-runtest $block_files       "-O2 -floop-block -fno-loop-strip-mine -fno-loop-interchange -ffast-math -fdump-tree-graphite-all"
+
+# Vectorizer tests, to be run or compiled, depending on target capabilities.
+if [check_vect_support_and_set_flags] {
+    gfortran-dg-runtest $vect_files "-O2 -fgraphite-identity -ftree-vectorize -fno-vect-cost-model -fdump-tree-vect-details -ffast-math"
+}
+
+# Tests to be run.
+set dg-do-what-default run
+gfortran-dg-runtest $run_id_files      "-O2 -fgraphite-identity"
+
+# The default action for the rest of the files is 'compile'.
+set dg-do-what-default compile
+foreach f $block_files       {lremove wait_to_run_files $f}
+foreach f $id_files          {lremove wait_to_run_files $f}
+foreach f $interchange_files {lremove wait_to_run_files $f}
+foreach f $scop_files        {lremove wait_to_run_files $f}
+foreach f $run_id_files      {lremove wait_to_run_files $f}
+foreach f $vect_files        {lremove wait_to_run_files $f}
+gfortran-dg-runtest $wait_to_run_files ""
+
+# Clean up.
+set dg-do-what-default ${save-dg-do-what-default}
+
+# All done.
+dg-finish
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-1.f90 b/gcc/testsuite/gfortran.dg/graphite/id-1.f90
new file mode 100644
index 000000000..5fe709bfb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-1.f90
@@ -0,0 +1,11 @@
+program NF
+end program NF
+subroutine mattest(nx,ny,nz,band1,band2,band3,stiffness,maxiter,targrms,method)
+  integer,parameter :: dpkind=kind(1.0D0)
+  character(*) :: method
+  real(dpkind),allocatable,dimension(:) :: ad,au1,au2,au3,x,b
+  allocate(ad(nxyz),au1(nxyz),au2(nxyz),au3(nxyz),x(nxyz),b(nxyz))
+  au1(nx:nxyz:nx) = 0.0
+  if ( method=='NFCG' ) then                                    
+  endif
+end subroutine mattest
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-10.f90 b/gcc/testsuite/gfortran.dg/graphite/id-10.f90
new file mode 100644
index 000000000..0e016f253
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-10.f90
@@ -0,0 +1,11 @@
+subroutine foo ( uplo, ap, y )
+      character*1        uplo
+      complex(kind((1.0d0,1.0d0)))         ap( * ), y( * )
+      if     ( .not. scan( uplo, 'uu' )>0.and. &
+         .not. scan( uplo, 'll' )>0      )then
+            do 60, j = 1, n
+               y( j ) = y( j ) + dble( ap( kk ) )
+               kk     = kk     + j
+   60       continue
+      end if
+      end
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-11.f b/gcc/testsuite/gfortran.dg/graphite/id-11.f
new file mode 100644
index 000000000..872e12f35
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-11.f
@@ -0,0 +1,14 @@
+      subroutine foo(bar)
+      dimension bar(100)
+      common l_
+  50  continue
+      do i=1,20
+        bar(i)=0
+      enddo
+      do 100 j=1,l_
+        if(sum.gt.r) then
+          bar(n2)=j
+        end if
+ 100  continue
+      if(bar(4).ne.0) go to 50
+      end
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-12.f b/gcc/testsuite/gfortran.dg/graphite/id-12.f
new file mode 100644
index 000000000..5b7415ca0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-12.f
@@ -0,0 +1,19 @@
+      subroutine foo(a)
+      logical bar
+      dimension a(12,2)
+      dimension b(12,8)
+      if(cd .eq. 1) then
+         if (bar) write(iw,*) norb
+         if(ef.ne.1) then
+            do i=1,norb
+            end do
+         end if
+      end if
+         do 400 j = 1,8
+            b(i,j) = 0
+  400    continue
+         do 410 j=1,norb
+            a(i,j) = 0
+  410    continue
+      call rdrsym(b)
+      end
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-13.f b/gcc/testsuite/gfortran.dg/graphite/id-13.f
new file mode 100644
index 000000000..9aec1fa6b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-13.f
@@ -0,0 +1,12 @@
+      DIMENSION FF(19)
+      COMMON UF(9)
+         CALL RYSNOD(K)
+      DO 150 K=2,N
+         JMAX=K-1
+            DUM = ONE/FF(1)
+            DO 110 J=1,JMAX
+               DUM=DUM+POLY*POLY
+  110       CONTINUE
+  150 CONTINUE
+         UF(K)=DUM/(ONE-DUM)
+      END
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-14.f b/gcc/testsuite/gfortran.dg/graphite/id-14.f
new file mode 100644
index 000000000..cdc3d101c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-14.f
@@ -0,0 +1,20 @@
+      SUBROUTINE ORDORB(IORBTP,IORBCD)
+      LOGICAL MASWRK
+      DIMENSION IORBTP(12,12)
+      DIMENSION IORBCD(12)
+      DIMENSION NSYMTP(12,8)
+      IF (MASWRK) WRITE(IW) K,NORB
+      DO 280 I=1,NFZV
+         IORBCD(K+I) = 3
+  280 CONTINUE
+      DO 420 I = 1,NTPS
+         DO 400 J = 1,8
+            NSYMTP(I,J) = 0
+  400    CONTINUE
+         DO 410 J=1,NORB
+            IORBTP(I,J) = 0
+  410    CONTINUE
+  420 CONTINUE
+      CALL RDRSYM(ICODE,NSYMTP,NSYM)
+ 9055 FORMAT(I5)
+      END
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-15.f b/gcc/testsuite/gfortran.dg/graphite/id-15.f
new file mode 100644
index 000000000..bf60d8569
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-15.f
@@ -0,0 +1,16 @@
+      SUBROUTINE ORDORB(IORBTP)
+      LOGICAL MASWRK
+      DIMENSION IORBTP(12,12)
+      DIMENSION NSYMTP(12,8)
+      IF (MASWRK) WRITE(IW) K,NORB
+      DO 420 I = 1,NTPS
+         DO 400 J = 1,8
+            NSYMTP(I,J) = 0
+  400    CONTINUE
+         DO 410 J=1,NORB
+            IORBTP(I,J) = 0
+  410    CONTINUE
+  420 CONTINUE
+      CALL RDRSYM(ICODE,NSYMTP,NSYM)
+ 9055 FORMAT(I5)
+      END
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-16.f b/gcc/testsuite/gfortran.dg/graphite/id-16.f
new file mode 100644
index 000000000..323d6c958
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-16.f
@@ -0,0 +1,10 @@
+      SUBROUTINE BFN(X,BF)
+      DIMENSION BF(13)
+      DIMENSION FACT(17)
+      DO 70 M=0,LAST
+         XF = 1
+         IF(M.NE.0) XF = FACT(M)
+         Y = Y + XF
+ 70   CONTINUE
+      BF(1)=Y
+      END
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-17.f b/gcc/testsuite/gfortran.dg/graphite/id-17.f
new file mode 100644
index 000000000..4bebed016
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-17.f
@@ -0,0 +1,16 @@
+      SUBROUTINE SPECTOP(Dr,N)
+      DIMENSION d1(0:32,0:32) , Dr(0:32,0:32) , x(0:32)
+      DO k = 0 , N
+         fctr2 = o
+         DO j = 0 , N
+            fctr = fctr1*fctr2
+            IF ( j.NE.k ) THEN
+               d1(k,j) = ck*fctr/(cj*(x(k)-x(j)))
+            ENDIF
+            fctr2 = -o*fctr2
+         ENDDO
+         DO j = 0 , N
+            Dr(k,j) = d1(N-k,N-j)
+         ENDDO
+      ENDDO
+      END
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-18.f90 b/gcc/testsuite/gfortran.dg/graphite/id-18.f90
new file mode 100644
index 000000000..ed7806736
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-18.f90
@@ -0,0 +1,26 @@
+MODULE spherical_harmonics
+  INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND ( 14, 200 )
+CONTAINS
+  FUNCTION dlegendre (x, l, m) RESULT (dplm)
+  SELECT CASE ( l )
+  CASE ( 0 )
+    dplm = 0.0_dp
+  CASE ( 1 )
+    dplm = 1.0_dp
+  CASE DEFAULT
+    IF ( mm > 0 ) THEN
+      dpmm = -m
+      DO im = 1, mm
+        dpmm = -dpmm
+      END DO
+      IF ( l == mm + 1 ) THEN
+        DO il = mm + 2, l
+          dpll = dpmm
+        END DO
+        dplm = dpll
+      END IF
+    END IF
+  END SELECT
+  END FUNCTION dlegendre
+END MODULE spherical_harmonics
+! { dg-final { cleanup-modules "spherical_harmonics" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-19.f b/gcc/testsuite/gfortran.dg/graphite/id-19.f
new file mode 100644
index 000000000..e05f764b2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-19.f
@@ -0,0 +1,15 @@
+      SUBROUTINE ECCODR(FPQR)
+      DIMENSION FPQR(25,25,25)
+      INTEGER P,Q,R
+      DIMENSION REC(73)
+      DO 150 P=1,N4MAX,2
+         QM2=-ONE
+         DO 140 Q=1,N4MAX,2
+            DO 130 R=1,N4MAX,2
+               IF(P.GT.1) THEN
+                  FPQR(P,Q,R)= QM2*FPQR(P,Q-2,R)*REC(P+Q-2+R)
+               END IF
+  130       RM2= RM2+TWO
+  140    QM2= QM2+TWO
+  150 PM2= PM2+TWO
+      END
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-2.f90 b/gcc/testsuite/gfortran.dg/graphite/id-2.f90
new file mode 100644
index 000000000..2f9f9dbec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-2.f90
@@ -0,0 +1,14 @@
+module solv_cap
+  integer, parameter, public :: dp = selected_real_kind(5)
+contains
+  subroutine prod0( G, X )
+    real(kind=dp), intent(in out), dimension(:,:)    :: X
+    real(kind=dp), dimension(size(X,1),size(X,2)) :: Y
+    X = Y
+  end subroutine prod0
+  function Ginteg(xq1,yq1, xq2,yq2, xp,yp)  result(G)
+  end function Ginteg
+  subroutine fourir(A,ntot,kconjg, E,useold)
+  end subroutine fourir
+end module solv_cap
+! { dg-final { cleanup-modules "solv_cap" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-20.f b/gcc/testsuite/gfortran.dg/graphite/id-20.f
new file mode 100644
index 000000000..795cb1b92
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-20.f
@@ -0,0 +1,10 @@
+! { dg-options "-O3 -ffast-math" }
+
+      DIMENSION FPQR(25,25,25)
+      INTEGER P,Q,R
+            DO 130 R=1,N4MAX,2
+               IF(P.GT.1) THEN
+                  FPQR(P,Q,R)= RM2*FPQR(P,Q,R-2)*REC(P+Q+R-2)
+               END IF
+  130       RM2= RM2+TWO
+      END
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-21.f b/gcc/testsuite/gfortran.dg/graphite/id-21.f
new file mode 100644
index 000000000..4fa047ed6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-21.f
@@ -0,0 +1,20 @@
+      MODULE LES3D_DATA
+      DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:,:,:) ::
+     >             P, T, H
+      DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:,:,:,:) ::
+     >             HF
+      DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:,:,:,:,:) ::
+     >             Q
+      END MODULE LES3D_DATA
+      USE LES3D_DATA
+      DO K = 1, KMAX - 1
+         DO J = 1, JMAX - 1
+            DO I = 1, I2
+               T(I,J,K) = (EI - HF(I,J,K,1)) / HF(I,J,K,3)
+            ENDDO
+            P(1:I2,J,K) = Q(1:I2,J,K,1,M) * HF(1:I2,J,K,4) * T(1:I2,J,K)
+            IF(ISGSK .EQ. 1) H(1:I2,J,K) =
+     >                   (Q(1:I2,J,K,5,M) + P(1:I2,J,K))
+         END DO
+      ENDDO
+      END
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-22.f b/gcc/testsuite/gfortran.dg/graphite/id-22.f
new file mode 100644
index 000000000..4b943f1b5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-22.f
@@ -0,0 +1,10 @@
+! { dg-options "-O3 -ffast-math" }
+
+      COMMON /NONEQ / UNZOR
+      DO ITS = 1, NTS
+        DO JATOM = 1, NAT
+          IF(IEF.EQ.5.OR.IEF.EQ.8)
+     *       UNZOR = UNZOR + 8
+        ENDDO
+      ENDDO
+      END
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-23.f b/gcc/testsuite/gfortran.dg/graphite/id-23.f
new file mode 100644
index 000000000..74c29283d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-23.f
@@ -0,0 +1,13 @@
+      SUBROUTINE CAMB(RX2,RTX,NUM)
+      DIMENSION RX2(NUM,NUM),RTX(NUM,NUM)
+      DO I=1,NUM
+        DO J=1,I
+          DO M=1,NUM
+            RX2(I,J)=RX2(I,J)+RTX(M,I)
+          END DO
+        END DO
+      END DO
+      IF (RX2(I,1).LE.EIGCT2) THEN
+      RTX(I,1)=4.0D+00
+      END IF
+      END
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-24.f b/gcc/testsuite/gfortran.dg/graphite/id-24.f
new file mode 100644
index 000000000..20c40ee06
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-24.f
@@ -0,0 +1,9 @@
+      SUBROUTINE TFTRAB(A,NA)
+      DIMENSION A(NA,NA)
+      DO 160 K=1,NA
+         DUM = DUM + A(K,I)
+ 160  CONTINUE
+      DO 180 I=1,NA
+         A(I,J) = DUM
+ 180  CONTINUE
+      END
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-25.f b/gcc/testsuite/gfortran.dg/graphite/id-25.f
new file mode 100644
index 000000000..642ed6de7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-25.f
@@ -0,0 +1,10 @@
+      SUBROUTINE TFTRAB(NA,NC,D,WRK)
+      DIMENSION D(NA,NC), WRK(NA)
+      DO 160 K=1,NA
+         DUM = DUM + D(K,J)
+ 160  CONTINUE
+      WRK(I) = DUM
+      DO 180 I=1,NA
+         D(I,J) = WRK(I)
+ 180  CONTINUE
+      END
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-3.f90 b/gcc/testsuite/gfortran.dg/graphite/id-3.f90
new file mode 100644
index 000000000..7f0efc7bc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-3.f90
@@ -0,0 +1,19 @@
+subroutine gentrs (ptrst, ncls, xmin, dcls, xdont, ndon) 
+do icls1 = 1, ncls
+   prec:    do
+      select case (isns)
+      case (-1)
+         do icls = icls1, 1, -1
+         enddo
+      case (+1)
+         do icls = icls1, ncls
+            if (xale > rtrst (icls1, icls)) then
+            endif
+         enddo
+      end select
+   enddo prec
+enddo
+contains
+real function genuni (jsee)
+end function genuni
+end subroutine gentrs
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-4.f90 b/gcc/testsuite/gfortran.dg/graphite/id-4.f90
new file mode 100644
index 000000000..83899445d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-4.f90
@@ -0,0 +1,33 @@
+MODULE Vcimage
+  CHARACTER (LEN=80), SAVE :: CARD, FIELD
+END MODULE Vcimage
+MODULE Vimage
+  LOGICAL, SAVE ::  EOFF
+END MODULE Vimage
+SUBROUTINE READIN(PROB, TITLE, CSTOP, FCYCLE, DCYCLE, DHIST, VHIST&
+     &    , IMAX, PHIST, DEBUG, NSTAT, STATS, MAXSTA, NCORE, PPLOT,     &
+     &    DPLOT, VPLOT, TPLOT, SLIST, D0, E0, NODES, SHEAT, GAMMA, COLD &
+     &    , THIST, NVISC, SCREEN, WEIGHT, TSTOP, STABF)
+  USE Vcimage
+  USE Vimage
+  INTEGER, DIMENSION(MAXSTA) :: STATS
+  IF (.NOT.EOFF) THEN
+     IF (FIELD=='PROB' .OR. FIELD=='PROBLEM_NUMBER') THEN
+        CALL QSORT (STATS(1:NSTAT))
+        WRITE (16,                                                 &
+             &'(//'' YOU HAVE REQUESTED A PRINTOUT OF THE STATION'',            &
+             &    '' ABORT''//)')
+     ENDIF
+  ENDIF
+CONTAINS
+  RECURSIVE SUBROUTINE QSORT (LIST)
+    INTEGER, DIMENSION(:), INTENT(INOUT) :: LIST
+    INTEGER, DIMENSION(SIZE(LIST)) :: SMALLER,LARGER
+    IF (SIZE(LIST) > 1) THEN
+       LIST(NUMBER_SMALLER+1:NUMBER_SMALLER+NUMBER_EQUAL) = CHOSEN
+       CALL QSORT (LARGER(1:NUMBER_LARGER))
+       LIST(NUMBER_SMALLER+NUMBER_EQUAL+1:) = LARGER(1:NUMBER_LARGER)
+    END IF
+  END SUBROUTINE QSORT
+END SUBROUTINE READIN
+! { dg-final { cleanup-modules "vimage vcimage" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-5.f b/gcc/testsuite/gfortran.dg/graphite/id-5.f
new file mode 100644
index 000000000..b9e93e39c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-5.f
@@ -0,0 +1,19 @@
+      subroutine shell(Re,Pr,nx,ny,nz,
+     $nuim,nuex2,nuex4,cfl,scheme,conf,ni,maxit) 
+      real*8 q(5,nx,ny,nz),dq(5,nx,ny,nz),rhs(5,nx,ny,nz),e(5,nx,ny,nz),
+     1     f(5,nx,ny,nz),g(5,nx,ny,nz),ev(5,nx,ny,nz),fv(5,nx,ny,nz),
+     2     gv(5,nx,ny,nz),diss(5,nx,ny,nz)
+      do k=1,nz
+         do j=1,ny
+            do i=1,nx
+               do l=1,5
+                  t1= -0.5d0*dt*(
+     3            (g(l,i,j,kp1)-g(l,i,j,km1))/dz) +
+     4            dt/Re*((ev(l,i,j,k)-ev(l,im1,j,k))/dx +
+     6                  (gv(l,i,j,k)-gv(l,i,j,km1))/dz)
+                  rhs(l,i,j,k)=t1+t2
+               enddo
+            enddo
+         enddo
+      enddo
+      end
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-6.f b/gcc/testsuite/gfortran.dg/graphite/id-6.f
new file mode 100644
index 000000000..2ccb4632a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-6.f
@@ -0,0 +1,22 @@
+      SUBROUTINE EIJDEN(EPS,V,E,IA,WRK,L1,L2,L3,L0,ECI)
+      DIMENSION V(L1,L0),EPS(L2),E(*),IA(L1),WRK(L1),ECI(L0,L0)
+      IF(SCFTYP.EQ.RHF .AND. MPLEVL.EQ.0 .AND.
+     *   CITYP.NE.GUGA .AND. CITYP.NE.CIS) THEN
+            CALL DCOPY(NORB,E(IADDE),1,E(IADD),1)
+      END IF
+      IF (CITYP.NE.GUGA) THEN
+      DO 500 I = 1,L1
+         DO 430 L = 1,NORB
+            DO 420 K = 1,NORB
+               IF(K.LE.L) THEN
+                  WRK(L) = WRK(L) - V(I,K)*ECI(K,L)
+               ELSE
+                  WRK(L) = WRK(L) - V(I,K)*ECI(L,K)
+               END IF
+  420       CONTINUE
+  430    CONTINUE
+         DO 440 L = 1,NORB
+  440    CONTINUE
+  500 CONTINUE
+      END IF
+      END
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-7.f b/gcc/testsuite/gfortran.dg/graphite/id-7.f
new file mode 100644
index 000000000..dbbbe37a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-7.f
@@ -0,0 +1,14 @@
+      subroutine dasol(al,au,ad,b,jp,neq,energy)
+      real*8 al(*),au(*),ad(*),b(*),zero,energy,bd,dot
+      do 100 is=1,neq
+         if(b(is).ne.zero) go to 200
+ 100  continue
+      return
+ 200  if(is.lt.neq) then
+      endif
+      do 400 j = is,neq
+         energy=energy+bd*b(j)
+ 400  continue
+      if(neq.gt.1)then
+      endif
+      end
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-8.f b/gcc/testsuite/gfortran.dg/graphite/id-8.f
new file mode 100644
index 000000000..6594dda24
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-8.f
@@ -0,0 +1,17 @@
+      subroutine foo(mxgtot,mxsh)
+      logical b
+      dimension ex(mxgtot),cs(mxgtot)
+         do 500 jg = k1,ig
+            u = ex(ig)+ex(jg)
+            z = u*sqrt(u)
+            x = cs(ig)*cs(jg)/z
+            if (ig .eq. jg) go to 480
+               x = x+x
+  480       continue
+            y = y+x
+  500    continue
+      if(y.gt.t) z=1/sqrt(y)
+      if (b) then
+         write(9) z
+      endif
+      end
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-9.f b/gcc/testsuite/gfortran.dg/graphite/id-9.f
new file mode 100644
index 000000000..c93937088
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-9.f
@@ -0,0 +1,20 @@
+      subroutine foo(bar)
+      real*8 bar(3,3),coefm
+      do ii=istart,iend
+            do i=1,21
+               bar(k,l)=4
+            enddo
+            do m=1,ne
+                  do l=1,3
+                     do k=1,l
+                     enddo
+                     bar(k,l)=bar(k,l)+(v3b-1.d0)
+                  enddo
+            enddo
+            do m=1,ne
+               do k=1,l
+                  l = l*(v3b**(-coefm))
+               enddo
+            enddo
+      enddo
+      end
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-pr43354.f b/gcc/testsuite/gfortran.dg/graphite/id-pr43354.f
new file mode 100644
index 000000000..e614f912b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-pr43354.f
@@ -0,0 +1,18 @@
+      SUBROUTINE POFUN2(DIM,GRDENT,FPART,FPARTL)
+      DOUBLE PRECISION GRDENT(*)
+      DOUBLE COMPLEX FPART(*)
+      DOUBLE COMPLEX FPARTL(*)
+      INTEGER REFLCT,XRIREF
+      IF (DIM.GT.1) THEN
+         ABCS3=XRCELL(1)
+         IF (ABCS2.EQ.ABCS3) THEN
+         END IF
+      ELSE
+         DO REFLCT=1,XRIREF,1
+            FPARTL(REFLCT)=FPART(REFLCT)
+         END DO
+      END IF
+         IF (ABCS2.EQ.ABCS3) THEN
+            GRDENT(1)=GRDENT(3)
+         END IF
+      END
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-pr45370.f90 b/gcc/testsuite/gfortran.dg/graphite/id-pr45370.f90
new file mode 100644
index 000000000..94eebd1f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-pr45370.f90
@@ -0,0 +1,100 @@
+!
+  type :: t
+    real :: r
+    integer :: i
+    character(3) :: chr
+  end type t
+
+  type :: t2
+    real :: r(2, 2)
+    integer :: i
+    character(3) :: chr
+  end type t2
+
+  type :: s
+    type(t), pointer :: t(:)
+  end type s
+
+  integer, parameter :: sh(2) = (/2,2/)
+  real, parameter :: a1(2,2) = reshape ((/1.0,2.0,3.0,4.0/),sh)
+  real, parameter :: a2(2,2) = reshape ((/5.0,6.0,7.0,8.0/),sh)
+
+  type(t), target :: tar1(2) = (/t(1.0, 2, "abc"), t(3.0, 4, "efg")/)
+  character(4), target :: tar2(2) = (/"abcd","efgh"/)
+  type(s), target :: tar3
+  character(2), target :: tar4(2) = (/"ab","cd"/)
+  type(t2), target :: tar5(2) = (/t2(a1, 2, "abc"), t2(a2, 4, "efg")/)
+
+  integer, pointer :: ptr(:)
+  character(2), pointer :: ptr2(:)
+  real, pointer :: ptr3(:)
+
+!_______________component subreference___________
+  ptr => tar1%i
+  ptr = ptr + 1              ! check the scalarizer is OK
+
+  if (any (ptr .ne. (/3, 5/))) call abort ()
+  if (any ((/ptr(1), ptr(2)/) .ne. (/3, 5/))) call abort ()
+  if (any (tar1%i .ne. (/3, 5/))) call abort ()
+
+! Make sure that the other components are not touched.
+  if (any (tar1%r .ne. (/1.0, 3.0/))) call abort ()
+  if (any (tar1%chr .ne. (/"abc", "efg"/))) call abort ()
+
+! Check that the pointer is passed correctly as an actual argument.
+  call foo (ptr)
+  if (any (tar1%i .ne. (/2, 4/))) call abort ()
+
+! And that dummy pointers are OK too.
+  call bar (ptr)
+  if (any (tar1%i .ne. (/101, 103/))) call abort ()
+
+!_______________substring subreference___________
+  ptr2 => tar2(:)(2:3)
+  ptr2 = ptr2(:)(2:2)//"z"   ! again, check the scalarizer
+
+  if (any (ptr2 .ne. (/"cz", "gz"/))) call abort ()
+  if (any ((/ptr2(1), ptr2(2)/) .ne. (/"cz", "gz"/))) call abort ()
+  if (any (tar2 .ne. (/"aczd", "egzh"/))) call abort ()
+
+!_______________substring component subreference___________
+  ptr2 => tar1(:)%chr(1:2)
+  ptr2 = ptr2(:)(2:2)//"q"   ! yet again, check the scalarizer
+  if (any (ptr2 .ne. (/"bq","fq"/))) call abort ()
+  if (any (tar1%chr .ne. (/"bqc","fqg"/))) call abort ()
+
+!_______________trailing array element subreference___________
+  ptr3 => tar5%r(1,2)
+  ptr3 = (/99.0, 999.0/)
+  if (any (tar5(1)%r .ne. reshape ((/1.0,2.0,99.0,4.0/), sh))) call abort ()
+  if (any (tar5(2)%r .ne. reshape ((/5.0,6.0,999.0,8.0/), sh))) call abort ()
+
+!_______________forall assignment___________
+  ptr2 => tar2(:)(1:2)
+  forall (i = 1:2) ptr2(i)(1:1) = "z"
+  if (any (tar2 .ne. (/"zczd", "zgzh"/))) call abort ()
+
+!_______________something more complicated___________
+  tar3%t => tar1
+  ptr3 => tar3%t%r
+  ptr3 = cos (ptr3)
+  if (any (abs(ptr3 - (/cos(1.0_4), cos(3.0_4)/)) >= epsilon(1.0_4))) call abort ()
+
+  ptr2 => tar3%t(:)%chr(2:3)
+  ptr2 = " x"
+  if (any (tar1%chr .ne. (/"b x", "f x"/))) call abort ()
+
+!_______________check non-subref works still___________
+  ptr2 => tar4
+  if (any (ptr2 .ne. (/"ab","cd"/))) call abort ()
+
+contains
+  subroutine foo (arg)
+    integer :: arg(:)
+    arg = arg - 1
+  end subroutine
+  subroutine bar (arg)
+    integer, pointer :: arg(:)
+    arg = arg + 99
+  end subroutine
+end
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-pr46994.f90 b/gcc/testsuite/gfortran.dg/graphite/id-pr46994.f90
new file mode 100644
index 000000000..93eff45fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-pr46994.f90
@@ -0,0 +1,14 @@
+! { dg-options "-O -ffast-math -fgraphite-identity -fno-tree-dce" }
+
+subroutine foo (m)
+  integer :: m, i, j, k
+  real :: s
+  s = 0
+  do i = 1, 9
+    do j = 1, 2*m
+      do k = 1, 2*m
+        s = s + 1
+      end do
+    end do
+  end do
+end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/graphite/id-pr46995.f90 b/gcc/testsuite/gfortran.dg/graphite/id-pr46995.f90
new file mode 100644
index 000000000..06cbfd364
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/id-pr46995.f90
@@ -0,0 +1,16 @@
+! { dg-options "-O -ffast-math -fgraphite-identity -fno-tree-dce" }
+
+subroutine foo (m, l, zw)
+  integer :: m, i, j, k
+  real, dimension(1:9) :: zw
+  real :: l, s
+  s = 0
+  do i = 1, 9
+    do j = 1, 2*m
+      do k = 1, 2*m
+        s = s + 1
+      end do
+    end do
+    l = l + zw(i)*s
+  end do
+end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/graphite/interchange-1.f b/gcc/testsuite/gfortran.dg/graphite/interchange-1.f
new file mode 100644
index 000000000..334fbd824
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/interchange-1.f
@@ -0,0 +1,45 @@
+      subroutine foo(f1,f2,f3,f4,f5,f6,f7,f8,f9,f0,g1,g2,g3)
+      implicit none
+      integer f4,f3,f2,f1
+      integer g4,g5,g6,g7,g8,g9
+      integer i1,i2,i3,i4,i5
+
+      real*8 g1(5,f3,f2,f1),g2(5,5,f3,f2,f1),g3(5,f3,f2,f1)
+      real*8 f0(5,5,f3,f2,f1),f9(5,5,f3,f2,f1),f8(5,5,f3,f2,f1)
+      real*8 f7(5,5,f3,f2,f1),f6(5,5,f3,f2,f1),f5(5,5,f3,f2,f1)
+
+      do i3=1,f1
+         g8=mod(i3+f1-2,f1)+1
+         g9=mod(i3,f1)+1
+         do i4=1,f2
+            g6=mod(i4+f2-2,f2)+1
+            g7=mod(i4,f2)+1
+            do i5=1,f3
+               g4=mod(i5+f3-2,f3)+1
+               g5=mod(i5,f3)+1
+               do i1=1,5
+                  g3(i1,i5,i4,i3)=0.0d0
+                  do i2=1,5
+                     g3(i1,i5,i4,i3)=g3(i1,i5,i4,i3)+
+     1                    g2(i1,i2,i5,i4,i3)*g1(i2,i5,i4,i3)+
+     2                    f0(i1,i2,i5,i4,i3)*g1(i2,g5,i4,i3)+
+     3                    f9(i1,i2,i5,i4,i3)*g1(i2,i5,g7,i3)+
+     4                    f8(i1,i2,i5,i4,i3)*g1(i2,i5,i4,g9)+
+     5                    f7(i1,i2,i5,i4,i3)*g1(i2,g4,i4,i3)+
+     6                    f6(i1,i2,i5,i4,i3)*g1(i2,i5,g6,i3)+
+     7                    f5(i1,i2,i5,i4,i3)*g1(i2,i5,i4,g8)
+                  enddo
+               enddo
+            enddo
+         enddo
+      enddo
+      return
+      end
+
+
+! We should be able to interchange this as the number of iterations is
+! known to be 4 in the inner two loops.  See interchange-2.f for the
+! kernel from bwaves.
+
+! { dg-final { scan-tree-dump-times "will be interchanged" 1 "graphite" { xfail *-*-* } } }
+! { dg-final { cleanup-tree-dump "graphite" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/interchange-2.f b/gcc/testsuite/gfortran.dg/graphite/interchange-2.f
new file mode 100644
index 000000000..8e2e87f12
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/interchange-2.f
@@ -0,0 +1,43 @@
+      subroutine foo(f1,f2,f3,f4,f5,f6,f7,f8,f9,f0,g1,g2,g3)
+      implicit none
+      integer f4,f3,f2,f1
+      integer g4,g5,g6,g7,g8,g9
+      integer i1,i2,i3,i4,i5
+
+      real*8 g1(f4,f3,f2,f1),g2(f4,f4,f3,f2,f1),g3(f4,f3,f2,f1)
+      real*8 f0(f4,f4,f3,f2,f1),f9(f4,f4,f3,f2,f1),f8(f4,f4,f3,f2,f1)
+      real*8 f7(f4,f4,f3,f2,f1),f6(f4,f4,f3,f2,f1),f5(f4,f4,f3,f2,f1)
+
+      do i3=1,f1
+         g8=mod(i3+f1-2,f1)+1
+         g9=mod(i3,f1)+1
+         do i4=1,f2
+            g6=mod(i4+f2-2,f2)+1
+            g7=mod(i4,f2)+1
+            do i5=1,f3
+               g4=mod(i5+f3-2,f3)+1
+               g5=mod(i5,f3)+1
+               do i1=1,f4
+                  g3(i1,i5,i4,i3)=0.0d0
+                  do i2=1,f4
+                     g3(i1,i5,i4,i3)=g3(i1,i5,i4,i3)+
+     1                    g2(i1,i2,i5,i4,i3)*g1(i2,i5,i4,i3)+
+     2                    f0(i1,i2,i5,i4,i3)*g1(i2,g5,i4,i3)+
+     3                    f9(i1,i2,i5,i4,i3)*g1(i2,i5,g7,i3)+
+     4                    f8(i1,i2,i5,i4,i3)*g1(i2,i5,i4,g9)+
+     5                    f7(i1,i2,i5,i4,i3)*g1(i2,g4,i4,i3)+
+     6                    f6(i1,i2,i5,i4,i3)*g1(i2,i5,g6,i3)+
+     7                    f5(i1,i2,i5,i4,i3)*g1(i2,i5,i4,g8)
+                  enddo
+               enddo
+            enddo
+         enddo
+      enddo
+      return
+      end
+
+! This is the kernel extracted from bwaves: this cannot be interchanged
+! as the number of iterations for f4 is not known.
+
+! { dg-final { scan-tree-dump-times "will be interchanged" 0 "graphite" } }
+! { dg-final { cleanup-tree-dump "graphite" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/interchange-3.f90 b/gcc/testsuite/gfortran.dg/graphite/interchange-3.f90
new file mode 100644
index 000000000..06da2b3aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/interchange-3.f90
@@ -0,0 +1,28 @@
+! Formerly known as ltrans-7.f90
+
+Program FOO
+  IMPLICIT INTEGER	(I-N)
+  IMPLICIT REAL*8	(A-H, O-Z)
+  PARAMETER (N1=1335, N2=1335)
+  COMMON U(N1,N2), V(N1,N2), P(N1,N2)
+
+  PC = 0.0D0
+  UC = 0.0D0
+  VC = 0.0D0
+
+  do I = 1, M
+     do J = 1, M
+        PC = PC + abs(P(I,J))
+        UC = UC + abs(U(I,J))
+        VC = VC + abs(V(I,J))
+     end do
+     U(I,I) = U(I,I) * ( mod (I, 100) /100.)
+  end do
+
+  write(6,366) PC, UC, VC
+366  format(/, ' PC = ',E12.4,/,' UC = ',E12.4,/,' VC = ',E12.4,/)
+
+end Program FOO
+
+! { dg-final { scan-tree-dump-times "will be interchanged" 1 "graphite" } }
+! { dg-final { cleanup-tree-dump "graphite" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/interchange-4.f b/gcc/testsuite/gfortran.dg/graphite/interchange-4.f
new file mode 100644
index 000000000..3d42811bc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/interchange-4.f
@@ -0,0 +1,29 @@
+      subroutine s231 (ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc)
+c
+c     loop interchange
+c     loop with multiple dimension recursion
+c
+      integer ntimes, ld, n, i, nl, j
+      double precision a(n), b(n), c(n), d(n), e(n), aa(ld,n),
+     +                 bb(ld,n), cc(ld,n)
+      double precision chksum, cs2d
+      real t1, t2, second, ctime, dtime
+
+      call init(ld,n,a,b,c,d,e,aa,bb,cc,'s231 ')
+      t1 = second()
+      do 1 nl = 1,ntimes/n
+      do 10 i=1,n
+         do 20 j=2,n
+            aa(i,j) = aa(i,j-1) + bb(i,j)
+   20    continue
+   10 continue
+      call dummy(ld,n,a,b,c,d,e,aa,bb,cc,1.d0)
+   1  continue
+      t2 = second() - t1 - ctime - ( dtime * float(ntimes/n) )
+      chksum = cs2d(n,aa)
+      call check (chksum,(ntimes/n)*n*(n-1),n,t2,'s231 ')
+      return
+      end
+
+! { dg-final { scan-tree-dump-times "will be interchanged" 1 "graphite" { xfail *-*-* } } }
+! { dg-final { cleanup-tree-dump "graphite" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/interchange-5.f b/gcc/testsuite/gfortran.dg/graphite/interchange-5.f
new file mode 100644
index 000000000..658f10a74
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/interchange-5.f
@@ -0,0 +1,30 @@
+      subroutine s235 (ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc)
+c
+c     loop interchanging
+c     imperfectly nested loops
+c
+      integer ntimes, ld, n, i, nl, j
+      double precision a(n), b(n), c(n), d(n), e(n), aa(ld,n),
+     +                 bb(ld,n), cc(ld,n)
+      double precision chksum, cs1d, cs2d
+      real t1, t2, second, ctime, dtime
+
+      call init(ld,n,a,b,c,d,e,aa,bb,cc,'s235 ')
+      t1 = second()
+      do 1 nl = 1,ntimes/n
+      do 10 i = 1,n
+         a(i) =  a(i) + b(i) * c(i)
+         do 20 j = 2,n
+            aa(i,j) = aa(i,j-1) +  bb(i,j) * a(i)
+  20     continue
+  10  continue
+      call dummy(ld,n,a,b,c,d,e,aa,bb,cc,1.d0)
+  1   continue
+      t2 = second() - t1 - ctime - ( dtime * float(ntimes/n) )
+      chksum = cs2d(n,aa) + cs1d(n,a)
+      call check (chksum,(ntimes/n)*n*(n-1),n,t2,'s235 ')
+      return
+      end
+
+! { dg-final { scan-tree-dump-times "will be interchanged" 1 "graphite" { xfail *-*-* } } }
+! { dg-final { cleanup-tree-dump "graphite" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr14741.f90 b/gcc/testsuite/gfortran.dg/graphite/pr14741.f90
new file mode 100644
index 000000000..3fe1d690c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr14741.f90
@@ -0,0 +1,29 @@
+! { dg-options "-O3 -ffast-math -floop-interchange -floop-block -fdump-tree-graphite-all" }
+
+  INTEGER, PARAMETER :: N=1024
+  REAL*8 :: A(N,N), B(N,N), C(N,N)
+  REAL*8 :: t1,t2
+  A=0.1D0
+  B=0.1D0
+  C=0.0D0
+  CALL cpu_time(t1)
+  CALL mult(A,B,C,N)
+  CALL cpu_time(t2)
+  write(6,*) t2-t1,C(1,1)
+END program
+
+SUBROUTINE mult(A,B,C,N)
+  REAL*8 :: A(N,N), B(N,N), C(N,N)
+  INTEGER :: I,J,K,N
+  DO J=1,N
+     DO I=1,N
+        DO K=1,N
+           C(I,J)=C(I,J)+A(I,K)*B(K,J)
+        ENDDO
+     ENDDO
+  ENDDO
+END SUBROUTINE mult
+
+! { dg-final { scan-tree-dump-times "number of SCoPs: 1" 1 "graphite" { xfail *-*-* } } }
+! { dg-final { scan-tree-dump-times "will be loop blocked" 1 "graphite" { xfail *-*-* } } }
+! { dg-final { cleanup-tree-dump "graphite" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr29290.f90 b/gcc/testsuite/gfortran.dg/graphite/pr29290.f90
new file mode 100644
index 000000000..8968d88c4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr29290.f90
@@ -0,0 +1,9 @@
+! PR tree-optimization/29290
+! { dg-do compile }
+! { dg-options "-O3 -ftree-loop-linear" }
+
+subroutine pr29290 (a, b, c, d)
+  integer c, d
+  real*8 a(c,c), b(c,c)
+  a(1:d,1:d) = b(1:d,1:d)
+end
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr29581.f90 b/gcc/testsuite/gfortran.dg/graphite/pr29581.f90
new file mode 100644
index 000000000..3e4a39efb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr29581.f90
@@ -0,0 +1,27 @@
+! PR tree-optimization/29581
+! { dg-do run }
+! { dg-options "-O2 -ftree-loop-linear" }
+
+      SUBROUTINE FOO (K)
+      INTEGER I, J, K, A(5,5), B
+      COMMON A
+      A(1,1) = 1
+ 10   B = 0
+      DO 30 I = 1, K
+        DO 20 J = 1, K
+          B = B + A(I,J)
+ 20     CONTINUE
+        A(I,I) = A(I,I) * 2
+ 30   CONTINUE
+      IF (B.GE.3) RETURN
+      GO TO 10
+      END SUBROUTINE
+
+      PROGRAM BAR
+        INTEGER A(5,5)
+        COMMON A
+        CALL FOO (2)
+        IF (A(1,1).NE.8) CALL ABORT
+        A(1,1) = 0
+        IF (ANY(A.NE.0)) CALL ABORT
+      END
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr29832.f90 b/gcc/testsuite/gfortran.dg/graphite/pr29832.f90
new file mode 100644
index 000000000..ab222ab03
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr29832.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! { dg-options "-O2 -ftree-loop-linear" }
+
+! Program to test the scalarizer
+program testarray
+   implicit none
+   integer, dimension (6, 5) :: a, b
+   integer n
+
+   a = 0
+   do n = 1, 5
+      a(4, n) = n
+   end do
+
+   b(:, 5:1:-1) = a
+   a(1:5, 2) = a(4, :) + 1
+
+   ! The following expression should cause loop reordering
+   a(:, 2:4) = a(:, 1:3)
+
+   do n = 1, 5
+      if (a(n, 3) .ne. (n + 1)) call abort
+      if (b(4, n) .ne. (6 - n)) call abort
+   end do
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr36286.f90 b/gcc/testsuite/gfortran.dg/graphite/pr36286.f90
new file mode 100644
index 000000000..bcdef0850
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr36286.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-O1 -ftree-loop-linear" }
+! PR tree-optimization/36286
+
+program test_count
+    integer, dimension(2,3) :: a, b
+    a = reshape( (/ 1, 3, 5, 2, 4, 6 /), (/ 2, 3 /))
+    b = reshape( (/ 0, 3, 5, 7, 4, 8 /), (/ 2, 3 /))
+    print '(3l6)', a.ne.b
+    print *, a(1,:).ne.b(1,:)
+    print *, a(2,:).ne.b(2,:)
+    print *, count(a.ne.b)
+end program test_count
+
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr36922.f b/gcc/testsuite/gfortran.dg/graphite/pr36922.f
new file mode 100644
index 000000000..6aa95beb6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr36922.f
@@ -0,0 +1,16 @@
+C PR tree-optimization/36922
+C { dg-do compile }
+C { dg-options "-O2 -ftree-loop-linear" }
+      SUBROUTINE PR36922(N,F,Z,C)
+      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
+      DIMENSION C(23821),Z(0:2*N+1),F(0:2*N)
+      I=0
+      DO L=0,N
+        DO M=0,L
+          DO M2=M,L
+            I=I+1
+            C(I)=F(L+M)*F(L-M)*Z(L-M2)/(F(M2+M)*F(M2-M)*F(L-M2)*F(L-M2))
+          ENDDO
+        ENDDO
+      ENDDO
+      END
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr37852.f90 b/gcc/testsuite/gfortran.dg/graphite/pr37852.f90
new file mode 100644
index 000000000..a5d48b712
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr37852.f90
@@ -0,0 +1,13 @@
+! { dg-options "-O2 " }
+
+PROGRAM TEST_FPU
+CHARACTER (LEN=36) :: invert_id(1) = &
+                      (/ 'Test1 - Gauss 2000 (101x101) inverts'/)
+END PROGRAM TEST_FPU
+
+SUBROUTINE Gauss (a,n)
+INTEGER, PARAMETER :: RK8 = SELECTED_REAL_KIND(15, 300)
+REAL(RK8) :: a(n,n)
+INTEGER ::  ipvt(n)
+a(:,ipvt) = b
+END SUBROUTINE Gauss
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr37857.f90 b/gcc/testsuite/gfortran.dg/graphite/pr37857.f90
new file mode 100644
index 000000000..c2cccb775
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr37857.f90
@@ -0,0 +1,9 @@
+! { dg-options "-O2 " }
+
+program superficie_proteina
+  integer, parameter :: LONGreal = selected_real_kind(12,90)
+  integer :: number_of_polypeptides, maximum_polypeptide_length
+  real (kind = LONGreal), dimension (:,:), allocatable :: individual_conformations
+  allocate (individual_conformations(-number_of_bins:0,number_of_polypeptides))
+  individual_conformations = 0.0_LONGreal
+end program superficie_proteina
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr37980.f90 b/gcc/testsuite/gfortran.dg/graphite/pr37980.f90
new file mode 100644
index 000000000..e964adec1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr37980.f90
@@ -0,0 +1,12 @@
+! { dg-options "-O2 " }
+
+module INT_MODULE
+contains
+  pure function spher_cartesians(in1) result(out1)
+    integer(kind=kind(1)) :: in1 
+    intent(in) :: in1 
+    real(kind=kind(1.0d0)), dimension(0:in1,0:in1,0:in1) :: mat0
+    mat0 = 0.0d0
+  end function spher_cartesians
+end module INT_MODULE
+! { dg-final { cleanup-modules "int_module" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr38083.f90 b/gcc/testsuite/gfortran.dg/graphite/pr38083.f90
new file mode 100644
index 000000000..da8c3cc79
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr38083.f90
@@ -0,0 +1,16 @@
+! { dg-options "-O3 " }
+
+SUBROUTINE IVSORT (IL,IH,NSEGS,IOUNIT)
+  INTEGER IOUNIT  
+
+  INTEGER, PARAMETER :: MAXGS = 32
+
+10 IF (IL .GE. IH) GO TO 80
+20 NSEGS = (IH + IL) / 2
+  IF (NSEGS .GT. MAXSGS) THEN
+     WRITE (IOUNIT),MAXSGS
+  ENDIF
+80 NSEGS = NSEGS - 1
+90 IF (IH - IL .GE. 11) GO TO 20
+110 IF (IL .EQ. IH) GO TO 80
+END SUBROUTINE IVSORT
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr38459.f90 b/gcc/testsuite/gfortran.dg/graphite/pr38459.f90
new file mode 100644
index 000000000..1feb6e503
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr38459.f90
@@ -0,0 +1,14 @@
+! { dg-options "-O2 -fgraphite-identity" }
+# 1 "mltfftsg.F"
+# 1 "<built-in>"
+SUBROUTINE mltfftsg ( a, ldax, lday, b, ldbx, ldby, &
+                      n, m)
+  INTEGER, PARAMETER :: dbl = SELECTED_REAL_KIND ( 14, 200 )
+
+! Arguments
+  INTEGER, INTENT ( IN ) :: ldbx, ldby, n, m
+  COMPLEX ( dbl ), INTENT ( INOUT ) :: b ( ldbx, ldby )
+
+   B(N+1:LDBX,1:M) = CMPLX(0._dbl,0._dbl,dbl)
+    
+END SUBROUTINE mltfftsg
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr38953.f90 b/gcc/testsuite/gfortran.dg/graphite/pr38953.f90
new file mode 100644
index 000000000..391549e3c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr38953.f90
@@ -0,0 +1,116 @@
+! { dg-options "-O3  -fgraphite-identity" }
+
+      MODULE MAIN1
+      INTEGER , PARAMETER :: IFMAX = 40 , IKN = 85 , ISTRG = 132 ,      &
+     &                       IERRN = 170 , ILEN_FLD = 80
+      CHARACTER PATH*2 , PPATH*2 , KEYWRD*8 , PKEYWD*8 , KEYWD*8 ,      &
+     &          KTYPE*5 , RUNST*1
+      DIMENSION FIELD(IFMAX) , KEYWD(IKN) , RUNST(ISTRG)
+      LOGICAL :: DFAULT , CONC , DEPOS , DDEP , WDEP , RURAL , URBAN ,  &
+     &        GRDRIS , NOSTD , NOBID , CLMPRO , MSGPRO , PERIOD ,       &
+     &            OLM=.FALSE.    
+      INTEGER :: NSRC , NREC , NGRP , NQF,                              &
+     &           NARC , NOLM
+      CHARACTER NETID*8 , NETIDT*8 , PNETID*8 , NTID*8 , NTTYP*8 ,      &
+     &          RECTYP*2 , PXSOID*8 , PESOID*8 , ARCID*8
+      ALLOCATABLE ::NETID(:) , RECTYP(:) , NTID(:) , NTTYP(:) , ARCID(:)
+      DATA (KEYWD(I),I=1,IKN)/'STARTING' , 'FINISHED' , 'TITLEONE' ,    &
+     &      'TITLETWO' , 'MODELOPT' , 'AVERTIME' , 'POLLUTID' ,         &
+     &      'HALFLIFE' , 'DCAYCOEF' , 'DEBUGOPT' , 'ELEVUNIT' ,         &
+     &      'FLAGPOLE' , 'RUNORNOT' , 'EVENTFIL' , 'SAVEFILE' ,         &
+     &      'INITFILE' , 'MULTYEAR' , 'ERRORFIL' , 'GASDEPDF' ,         &
+     &      'GDSEASON' , 'GASDEPVD' , 'GDLANUSE' , 'EVENTFIL' ,         &
+     &      'URBANOPT' , 'METHOD_2' , 'LOCATION' , 'SRCPARAM' ,         &
+     &      'BUILDHGT' , 'BUILDWID' , 'BUILDLEN' , 'XBADJ   ' ,         &
+     &      'YBADJ   ' , 'EMISFACT' , 'EMISUNIT' , 'PARTDIAM' ,         &
+     &      'MASSFRAX' , 'PARTDENS' , '        ' , '        ' ,         &
+     &      '        ' , 'CONCUNIT' , 'DEPOUNIT' , 'HOUREMIS' ,         &
+     &      'GASDEPOS' , 'URBANSRC' , 'EVENTPER' , 'EVENTLOC' ,         &
+     &      'SRCGROUP' , 'GRIDCART' , 'GRIDPOLR' , 'DISCCART' ,         &
+     &      'DISCPOLR' , 'SURFFILE' , 'PROFFILE' , 'PROFBASE' ,         &
+     &      '        ' , 'SURFDATA' , 'UAIRDATA' , 'SITEDATA' ,         &
+     &      'STARTEND' , 'DAYRANGE' , 'WDROTATE' , 'DTHETADZ' ,         &
+     &      'WINDCATS' , 'RECTABLE' , 'MAXTABLE' , 'DAYTABLE' ,         &
+     &      'MAXIFILE' , 'POSTFILE' , 'PLOTFILE' , 'TOXXFILE' ,         &
+     &      'EVENTOUT' , 'INCLUDED' , 'SCIMBYHR' , 'SEASONHR' ,         &
+     &      'AREAVERT' , 'PARTSIZE' , 'RANKFILE' , 'EVALCART' ,         &
+     &      'EVALFILE' , 'NO2EQUIL' , 'OZONEVAL' , 'OZONEFIL' ,         &
+     &      'NO2RATIO' , 'OLMGROUP'/
+      DIMENSION RESTAB(9,6,5) , STAB(9)
+      DATA (((RESTAB(I,J,K),I=1,9),J=1,6),K=1,5)/1.E07 , 60. , 120. ,   &
+     &      100. , 200. , 150. , 1.E07 , 1.E07 , 80. , 1.E07 , 2000. ,  &
+     &      2000. , 2000. , 2000. , 2000. , 1.E07 , 1.E07 , 2500. ,     &
+     &      1.E07 , 1000. , 1000. , 1000. , 2000. , 2000. , 1.E07 ,     &
+     &      1.E07 , 1000. , 100. , 200. , 100. , 2000. , 100. , 1500. , &
+     &      0. , 0. , 300. , 400. , 150. , 350. , 300. , 500. , 450. ,  &
+     &      0. , 1000. , 0. , 300. , 150. , 200. , 200. , 300. , 300. , &
+     &      2000. , 400. , 1000. , 1.E07 , 1.E07 , 1.E07 , 350. ,       &
+     &      1.E07 , 700. , 1.E07 , 1.E07 , 1.E07 , 1.E07 , 6500. ,      &
+     &      6500. , 3000. , 2000. , 2000. , 1.E07 , 1.E07 , 6500. ,     &
+     &      1.E07 , 400. , 300. , 500. , 600. , 1000. , 1.E07 , 1.E07 , &
+     &      300. , 100. , 150. , 100. , 1700. , 100. , 1200. , 0. , 0. ,&
+     &      200. , 400. , 200. , 350. , 300. , 500. , 450. , 0. ,       &
+     &      1000. , 0. , 300. , 150. , 200. , 200. , 300. , 300. ,      &
+     &      2000. , 400. , 800. , 1.E07 , 1.E07 , 1.E07 , 500. , 1.E07 ,&
+     &      1000. , 1.E07 , 1.E07 , 1.E07 , 1.E07 , 1.E07 , 9000. ,     &
+     &      6000. , 2000. , 2000. , 1.E07 , 1.E07 , 9000. , 1.E07 ,     &
+     &      1.E07 , 400. , 600. , 800. , 1600. , 1.E07 , 1.E07 , 800. , &
+     &      100. , 0. , 100. , 1500. , 100. , 1000. , 0. , 0. , 100. ,  &
+     &      400. , 150. , 350. , 300. , 500. , 450. , 0. , 0. , 1000. , &
+     &      300. , 150. , 200. , 200. , 300. , 300. , 2000. , 400. ,    &
+     &      1000. , 1.E07 , 1.E07 , 1.E07 , 800. , 1.E07 , 1600. ,      &
+     &      1.E07 , 1.E07 , 1.E07 , 1.E07 , 1.E07 , 1.E07 , 400. ,      &
+     &      1.E07 , 800. , 1.E07 , 1.E07 , 9000. , 1.E07 , 2000. ,      &
+     &      1000. , 600. , 2000. , 1200. , 1.E07 , 1.E07 , 800. , 100. ,&
+     &      0. , 10. , 1500. , 100. , 1000. , 0. , 0. , 50. , 100. ,    &
+     &      100. , 100. , 100. , 200. , 200. , 0. , 1000. , 100. ,      &
+     &      600. , 3500. , 3500. , 3500. , 500. , 500. , 2000. , 400. , &
+     &      3500. , 1.E07 , 100. , 120. , 100. , 200. , 150. , 1.E07 ,  &
+     &      1.E07 , 80. , 1.E07 , 2000. , 2000. , 1500. , 2000. ,       &
+     &      2000. , 1.E07 , 1.E07 , 2000. , 1.E07 , 1000. , 250. ,      &
+     &      350. , 500. , 700. , 1.E07 , 1.E07 , 300. , 100. , 50. ,    &
+     &      80. , 1500. , 100. , 1000. , 0. , 0. , 200. , 500. , 150. , &
+     &      350. , 300. , 500. , 450. , 0. , 1000. , 0. , 300. , 150. , &
+     &      200. , 200. , 300. , 300. , 2000. , 400. , 1000./
+      END
+      SUBROUTINE SHAVE
+      USE MAIN1
+      IF ( PERIOD ) THEN
+ 9020    FORMAT ('(''*'',8X,''X'',13X,''Y'',4X,',I1,                    &
+     &'(2X,3A4),4X,''ZELEV'',   4X,''ZHILL'',4X,''ZFLAG'',4X,''AVE'',5X,&
+     &_______  ________  ________'')')
+      ENDIF
+      DO IGRP = 1 , NUMGRP
+         IF ( IANPST(IGRP).EQ.1 ) THEN
+            IF ( IANFRM(IGRP).EQ.0 ) THEN
+               DO IREC = 1 , NUMREC
+               ENDDO
+            ENDIF
+            DO IREC = 1 , NUMREC
+               IF ( RECTYP(IREC).EQ.'DC' ) THEN
+                  WRITE (IOUNIT,9082) SRCID(ISRF) , SRCTYP(ISRF) ,      &
+     &                                AXS(ISRF) , AYS(ISRF) , AZS(ISRF) &
+     &                                , (J,AXR(IREC+J-1),AYR(IREC+J-1), &
+     &                                HCLMSG(IREC+J-1,IHNUM,IGRP,IAVE,  &
+     &                                ITYP),J=1,36)
+ 9082             FORMAT (' BOUNDARY RECEPTOR NETWORK OF SOURCE ID: ',  &
+     &                    18(2(1X,I4,3X,F10.2,', ',F10.2,',',F13.5,A1,  &
+     &                    '(',I8.8,')',7X),/),/)
+               ENDIF
+            ENDDO
+         ENDIF
+      ENDDO
+      END
+      USE MAIN1
+      IF ( ICOUNT.NE.0 .AND. JCOUNT.NE.0 ) THEN
+         DO J = 1 , JCOUNT
+            DO I = 1 , ICOUNT
+               IF ( ISET.GT.NREC ) THEN
+                  GOTO 999
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDIF
+ 999  CONTINUE
+      END
+! { dg-final { cleanup-modules "main1" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr39516.f b/gcc/testsuite/gfortran.dg/graphite/pr39516.f
new file mode 100644
index 000000000..3d6104a8e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr39516.f
@@ -0,0 +1,20 @@
+C PR tree-optimization/39516
+C { dg-do compile }
+C { dg-options "-O2 -ftree-loop-linear" }
+      SUBROUTINE SUB(A, B, M)
+      IMPLICIT NONE
+      DOUBLE PRECISION A(20,20), B(20)
+      INTEGER*8 I, J, K, M
+      DO I=1,M
+        DO J=1,M
+          A(I,J)=A(I,J)+1
+        END DO
+      END DO
+      DO K=1,20
+        DO I=1,M
+          DO J=1,M
+            B(I)=B(I)+A(I,J)
+          END DO
+        END DO
+      END DO
+      END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr40982.f90 b/gcc/testsuite/gfortran.dg/graphite/pr40982.f90
new file mode 100644
index 000000000..c49def850
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr40982.f90
@@ -0,0 +1,71 @@
+! { dg-options "-O3 -fgraphite-identity -floop-interchange " }
+
+module mqc_m
+
+
+implicit none
+
+private
+public :: mutual_ind_quad_cir_coil
+
+integer, parameter, private :: longreal = selected_real_kind(15,90)
+real (kind = longreal), parameter, private :: pi = 3.141592653589793_longreal
+real (kind = longreal), parameter, private :: small = 1.0e-10_longreal
+
+contains
+
+      subroutine mutual_ind_quad_cir_coil (r_coil, x_coil, y_coil, z_coil, h_coil, n_coil,  &
+                                                      rotate_coil, m, mu, l12)
+      real (kind = longreal), intent(in) :: r_coil, x_coil, y_coil, z_coil, h_coil, n_coil, &
+                                            mu
+      real (kind = longreal), dimension(:,:), intent(in) :: rotate_coil
+      integer, intent(in) :: m
+      real (kind = longreal), intent(out) :: l12
+      real (kind = longreal), dimension(3,3) :: rotate_quad
+      real (kind = longreal), dimension(9), save :: x2gauss, y2gauss, w2gauss, z1gauss,     &
+                                                    w1gauss
+      real (kind = longreal) :: xxvec, xyvec, xzvec, yxvec, yyvec, yzvec, zxvec, zyvec,     &
+                                zzvec, magnitude, l12_lower, l12_upper, dx, dy, dz, theta,  &
+                                a, b1, b2, numerator, denominator, coefficient, angle
+      real (kind = longreal), dimension(3) :: c_vector, q_vector, rot_c_vector,             &
+                                              rot_q_vector, current_vector,                 &
+                                              coil_current_vec, coil_tmp_vector
+      integer :: i, j, k
+      logical, save :: first = .true.
+
+      do i = 1, 2*m
+          theta = pi*real(i,longreal)/real(m,longreal)
+          c_vector(1) = r_coil * cos(theta)
+          c_vector(2) = r_coil * sin(theta)
+          coil_tmp_vector(1) = -sin(theta)
+          coil_tmp_vector(2) = cos(theta)
+          coil_tmp_vector(3) = 0.0_longreal
+          coil_current_vec(1) = dot_product(rotate_coil(1,:),coil_tmp_vector(:))
+          coil_current_vec(2) = dot_product(rotate_coil(2,:),coil_tmp_vector(:))
+          coil_current_vec(3) = dot_product(rotate_coil(3,:),coil_tmp_vector(:))
+          do j = 1, 9
+              c_vector(3) = 0.5 * h_coil * z1gauss(j)
+              rot_c_vector(1) = dot_product(rotate_coil(1,:),c_vector(:)) + dx
+              rot_c_vector(2) = dot_product(rotate_coil(2,:),c_vector(:)) + dy
+              rot_c_vector(3) = dot_product(rotate_coil(3,:),c_vector(:)) + dz
+              do k = 1, 9
+                  q_vector(1) = 0.5_longreal * a * (x2gauss(k) + 1.0_longreal)
+                  q_vector(2) = 0.5_longreal * b1 * (y2gauss(k) - 1.0_longreal)
+                  q_vector(3) = 0.0_longreal
+                  rot_q_vector(1) = dot_product(rotate_quad(1,:),q_vector(:))
+                  rot_q_vector(2) = dot_product(rotate_quad(2,:),q_vector(:))
+                  rot_q_vector(3) = dot_product(rotate_quad(3,:),q_vector(:))
+                  numerator = w1gauss(j) * w2gauss(k) *                                     &
+                                                 dot_product(coil_current_vec,current_vector)
+                  denominator = sqrt(dot_product(rot_c_vector-rot_q_vector,                 &
+                                                                  rot_c_vector-rot_q_vector))
+                  l12_lower = l12_lower + numerator/denominator
+              end do
+          end do
+      end do
+      l12 = coefficient * (b1 * l12_lower + b2 * l12_upper)
+      end subroutine mutual_ind_quad_cir_coil
+
+end module mqc_m
+! { dg-final { cleanup-modules "mqc_m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr41924.f90 b/gcc/testsuite/gfortran.dg/graphite/pr41924.f90
new file mode 100644
index 000000000..2f248d0b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr41924.f90
@@ -0,0 +1,16 @@
+! { dg-options "-O2 -fgraphite-identity " }
+
+MODULE MAIN1
+ REAL , ALLOCATABLE :: HRVALD(:)
+END MODULE MAIN1
+
+SUBROUTINE VOLCALC()
+ USE MAIN1
+ INTEGER :: ITYP
+ LOGICAL :: WETSCIM
+
+ DO ITYP = 1 , 100
+    IF ( WETSCIM ) HRVALD(ITYP) = 0.0
+ ENDDO
+END SUBROUTINE VOLCALC
+! { dg-final { cleanup-modules "main1" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42050.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42050.f90
new file mode 100644
index 000000000..e01991741
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr42050.f90
@@ -0,0 +1,26 @@
+! { dg-options "-O2 -fgraphite-identity " }
+
+MODULE qs_ks_methods
+  INTEGER, PARAMETER :: sic_list_all=1
+  TYPE dft_control_type
+     INTEGER :: sic_list_id
+  END TYPE
+CONTAINS
+  SUBROUTINE sic_explicit_orbitals( )
+    TYPE(dft_control_type), POINTER          :: dft_control
+    INTEGER, ALLOCATABLE, DIMENSION(:, :)    :: sic_orbital_list
+    INTEGER, DIMENSION(:), &
+      POINTER                                :: mo_derivs
+    SELECT CASE(dft_control%sic_list_id)
+    CASE(sic_list_all)
+      DO i=1,k_alpha
+         IF (SIZE(mo_derivs,1)==1) THEN
+         ELSE
+             sic_orbital_list(3,iorb)=2
+         ENDIF
+      ENDDO
+    END SELECT
+    CALL test()
+  END SUBROUTINE sic_explicit_orbitals
+END MODULE qs_ks_methods
+! { dg-final { cleanup-modules "qs_ks_methods" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42180.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42180.f90
new file mode 100644
index 000000000..bb5bc0c58
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr42180.f90
@@ -0,0 +1,23 @@
+! { dg-options "-ffast-math -O2 -fgraphite-identity" }
+
+module mcc_m
+  integer, parameter, private :: longreal = selected_real_kind(15,90)
+contains
+  subroutine mutual_ind_cir_cir_coils (m, l12)
+    real (kind = longreal), intent(out) :: l12
+    real (kind = longreal), dimension(1:9), save :: zw
+    gauss:do i = 1, 9
+       theta_l12 = 0.0_longreal
+       theta1:   do n1 = 1, 2*m
+          theta_1 = pi*real(n1,longreal)/real(m,longreal)
+          theta2:       do n2 = 1, 2*m
+             numerator = -sin(theta_1)*tvx + cos(theta_1)*tvy
+             theta_l12 = theta_l12 + numerator/denominator
+          end do theta2
+       end do theta1
+       l12 = l12 + zw(i)*theta_l12
+    end do gauss
+    l12 = coefficient * l12
+  end subroutine mutual_ind_cir_cir_coils
+end module mcc_m
+! { dg-final { cleanup-modules "mcc_m" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42181.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42181.f90
new file mode 100644
index 000000000..06ce47d9e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr42181.f90
@@ -0,0 +1,20 @@
+! { dg-options "-O1 -fgraphite" }
+
+MODULE powell
+  INTEGER, PARAMETER :: dp=8
+CONTAINS
+  SUBROUTINE newuob (n,npt,x,rhobeg,rhoend,maxfun,xbase,&
+       xopt,xnew,xpt,fval,gq,hq,pq,bmat,zmat,ndim,d,vlag,w,opt)
+    REAL(dp), DIMENSION(npt, *), &
+      INTENT(inout)                          :: xpt
+    REAL(dp), DIMENSION(*), INTENT(inout)    :: fval, gq, hq, pq
+120 IF (dsq <= 1.0e-3_dp*xoptsq) THEN
+       DO k=1,npt
+          DO i=1,n
+             gq(i)=gq(i)+temp*xpt(k,i)
+          END DO
+       END DO
+    END IF
+  END SUBROUTINE newuob
+END MODULE powell
+! { dg-final { cleanup-modules "powell" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42185.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42185.f90
new file mode 100644
index 000000000..6fa6e3036
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr42185.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-options "-fgraphite -O -ffast-math" }
+
+MODULE powell
+  INTEGER, PARAMETER :: dp=8
+CONTAINS
+  SUBROUTINE trsapp (n,npt,xopt,xpt,gq,hq,pq,delta,step,d,g,hd,hs,crvmin)
+    REAL(dp), DIMENSION(*), INTENT(INOUT)    :: step, d, g, hd, hs
+    LOGICAL                                  :: jump1, jump2
+    REAL(dp) :: alpha, angle, angtest, bstep, cf, cth, dd, delsq, dg, dhd, &
+      reduc, sg, sgk, shs, ss, sth, temp, tempa, tempb
+    DO i=1,n
+       dd=dd+d(i)**2
+    END DO
+    mainloop : DO
+       IF ( .NOT. jump2 ) THEN
+          IF ( .NOT. jump1 ) THEN
+             bstep=temp/(ds+SQRT(ds*ds+dd*temp))
+             IF (alpha < bstep) THEN
+                IF (ss < delsq) CYCLE mainloop
+             END IF
+             IF (gg <= 1.0e-4_dp*ggbeg) EXIT mainloop
+          END IF
+       END IF
+    END DO mainloop
+  END SUBROUTINE trsapp
+END MODULE powell
+! { dg-final { cleanup-modules "powell" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42186.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42186.f90
new file mode 100644
index 000000000..0e3669bf5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr42186.f90
@@ -0,0 +1,15 @@
+! { dg-options "-fgraphite-identity -g -O3 -ffast-math" }
+MODULE erf_fn
+CONTAINS
+  SUBROUTINE CALERF(ARG,RESULT,JINT)
+    DIMENSION A(5),B(4),C(9),D(8),P(6),Q(5)
+    IF (Y <= THRESH) THEN
+       DO I = 1, 3
+          XNUM = (XNUM + A(I)) * YSQ
+          XDEN = (XDEN + B(I)) * YSQ
+       END DO
+       RESULT = X * (XNUM + A(4)) / (XDEN + B(4))
+    END IF
+  END SUBROUTINE CALERF
+END MODULE erf_fn
+! { dg-final { cleanup-modules "erf_fn" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42285.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42285.f90
new file mode 100644
index 000000000..d496d3724
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr42285.f90
@@ -0,0 +1,24 @@
+! { dg-options "-O2 -floop-interchange" }
+
+SUBROUTINE EFGRDM(NCF,NFRG,G,RTRMS,GM,IOPT,K1)
+  IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+  DIMENSION G(*),RTRMS(*),GM(*)
+
+  DUM = 0
+  DO I=1,NFRG
+     DO J=1,3
+        IF (IOPT.EQ.0) THEN
+           GM(K1)=G(K1)
+        END IF
+     END DO
+     DO J=1,3
+        JDX=NCF*9+IOPT*9*NFRG
+        DO M=1,3
+           DUM=DUM+RTRMS(JDX+M)
+        END DO
+        GM(K1)=DUM
+     END DO
+  END DO
+  RETURN
+END SUBROUTINE EFGRDM
+
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42326-1.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42326-1.f90
new file mode 100644
index 000000000..8c9d110b2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr42326-1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile { target i?86-*-* x86_64-*-* } }
+! { dg-require-effective-target ilp32 }
+! { dg-require-effective-target sse2 }
+! { dg-options "-O2 -floop-parallelize-all -fprefetch-loop-arrays -msse2" }
+
+subroutine phasad(t,i,ium)
+  implicit none
+  real t(5,4)
+  integer i,l,ll,ium
+
+  do l=1,2
+     ll=2*l
+     do i=1,ium
+        t(i,ll-1)=t(i,ll-1)+t(i,ll)
+     enddo
+  enddo
+  return
+end subroutine phasad
+
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42326.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42326.f90
new file mode 100644
index 000000000..06ef2b706
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr42326.f90
@@ -0,0 +1,36 @@
+! { dg-do compile { target i?86-*-* x86_64-*-* } }
+! { dg-require-effective-target ilp32 }
+! { dg-require-effective-target sse2 }
+! { dg-options "-O2 -floop-strip-mine -fprefetch-loop-arrays -msse2" }
+
+subroutine blts ( ldmx, ldmy, v, tmp1, i, j, k)
+  implicit none
+  integer ldmx, ldmy, i, j, k, ip, m, l
+  real*8 tmp, tmp1, v( 5, ldmx, ldmy, *), tmat(5,5)
+
+  do ip = 1, 4
+     do m = ip+1, 5
+        tmp = tmp1 * tmat( m, ip )
+        do l = ip+1, 5
+           tmat( m, l ) =  tmat( m, l ) - tmat( ip, l )
+        end do
+        v( m, i, j, k ) = tmp
+     end do
+  end do
+  return
+end subroutine blts
+
+subroutine phasad(t,i,ium)
+  implicit none
+  real t(5,4)
+  integer i,l,ll,ium
+
+  do l=1,2
+     ll=2*l
+     do i=1,ium
+        t(i,ll-1)=t(i,ll-1)+t(i,ll)
+     enddo
+  enddo
+  return
+end subroutine phasad
+
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42334-1.f b/gcc/testsuite/gfortran.dg/graphite/pr42334-1.f
new file mode 100644
index 000000000..2503dc3e8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr42334-1.f
@@ -0,0 +1,16 @@
+! { dg-options "-O2 -floop-interchange" }
+
+      subroutine linel(icmdl,stre,anisox)
+      real*8 stre(6),tkl(3,3),ekl(3,3),anisox(3,3,3,3)
+            do m1=1,3
+               do m2=1,m1
+                  do m3=1,3
+                     do m4=1,3
+                        tkl(m1,m2)=tkl(m1,m2)+
+     &                       anisox(m1,m2,m3,m4)*ekl(m3,m4)
+                     enddo
+                  enddo
+               enddo
+            enddo
+            stre(1)=tkl(1,1)
+      end
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42334.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42334.f90
new file mode 100644
index 000000000..4080c9f2a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr42334.f90
@@ -0,0 +1,20 @@
+! { dg-options "-O2 -floop-interchange -ftree-loop-distribution" }
+
+subroutine blockdis(bl1eg,bl2eg)
+  implicit real*8 (a-h,o-z)
+  parameter(nblo=300)
+  common/str /mblo
+  common/str2 /mel(nblo)
+  dimension h(nblo,2,6),g(nblo,2,6)
+  dimension bl1eg(nblo,2,6),bl2eg(nblo,2,6)
+  do k=1,mblo
+     jm=mel(k)
+     do l=1,2
+        do m=1,6
+           bl1eg(k,l,m)=h(jm,l,m)
+           bl2eg(k,l,m)=g(jm,l,m)
+        enddo
+     enddo
+  enddo
+  return
+end subroutine blockdis
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42393-1.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42393-1.f90
new file mode 100644
index 000000000..45c635b76
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr42393-1.f90
@@ -0,0 +1,25 @@
+! { dg-options "-O2 -fgraphite-identity -fno-loop-block -fno-loop-interchange -fno-loop-strip-mine" }
+
+MODULE beta_gamma_psi
+  INTEGER, PARAMETER :: dp=KIND(0.0D0)
+CONTAINS
+  FUNCTION basym () RESULT(fn_val)
+    REAL(dp) :: b0(21), bsum, d(21)
+    DO n = 2, num, 2
+       DO i = n, np1
+          b0(1) = 1
+          DO m = 2, i
+             mm1 = m - 1
+             DO j = 1, mm1
+                bsum = bsum + b0(j)
+             END DO
+             b0(m) = bsum
+          END DO
+          d(i) = -b0(i)
+       END DO
+       sum = sum + d(n)
+    END DO
+    fn_val = sum
+  END FUNCTION basym
+END MODULE beta_gamma_psi
+! { dg-final { cleanup-modules "beta_gamma_psi" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42393.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42393.f90
new file mode 100644
index 000000000..da9a348dd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr42393.f90
@@ -0,0 +1,31 @@
+! { dg-options "-O2 -fgraphite-identity -fno-loop-block -fno-loop-interchange -fno-loop-strip-mine" }
+
+MODULE beta_gamma_psi
+  INTEGER, PARAMETER :: dp=KIND(0.0D0)
+CONTAINS
+  FUNCTION basym (a, b, lambda, eps) RESULT(fn_val)
+    REAL(dp) :: a0(21), b0(21), bsum, c(21), d(21), dsum, &
+         j0, j1, r, r0, r1, s, sum, t, t0, t1, &
+         u, w, w0, z, z0, z2, zn, znm1
+    DO n = 2, num, 2
+       DO i = n, np1
+          b0(1) = r*a0(1)
+          DO m = 2, i
+             bsum = 0.0e0_dp
+             mm1 = m - 1
+             DO j = 1, mm1
+                mmj = m - j
+                bsum = bsum + (j*r - mmj)*a0(j)*b0(mmj)
+             END DO
+             b0(m) = r*a0(m) + bsum/m
+          END DO
+          c(i) = b0(i)/(i + 1.0e0_dp)
+          d(i) = -(dsum + c(i))
+       END DO
+       t0 = d(n)*w*j0
+       sum = sum + (t0 + t1)
+    END DO
+    fn_val = e0*t*u*sum
+  END FUNCTION basym
+END MODULE beta_gamma_psi
+! { dg-final { cleanup-modules "beta_gamma_psi" } }
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42732.f b/gcc/testsuite/gfortran.dg/graphite/pr42732.f
new file mode 100644
index 000000000..95c115076
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr42732.f
@@ -0,0 +1,23 @@
+! { dg-options "-O2 -fgraphite-identity" }
+
+      parameter(in =           128+5
+     &        , jn =           128+5
+     &        , kn =           128+5)
+      real*8   d (in,jn,kn)
+       real*8 dcopy(in,jn,kn)
+       call pdv (is, dcopy)
+       do k=ks,ke
+         do j=je+1,je+2
+           do i=is-2,ie+2
+             dcopy(i,j,k) = d(i,j,k)
+           enddo
+         enddo
+       enddo
+       do k=ks,ke
+         do j=js,je
+           do i=is-2,is-1
+             dcopy(i,j,k) = d(i,j,k)
+           enddo
+         enddo
+       enddo
+       end
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr43097.f b/gcc/testsuite/gfortran.dg/graphite/pr43097.f
new file mode 100644
index 000000000..4ddeed8ae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr43097.f
@@ -0,0 +1,25 @@
+! { dg-options "-O2 -fgraphite-identity" }
+
+      subroutine foo (ldmx,ldmy,nx,ny,v)
+      implicit real*8 (a-h, o-z)
+      dimension v(5,ldmx,ldmy,*)
+      dimension tmat(5,5)
+
+      k = 2
+      do j = 2, ny-1
+         do i = 2, nx-1
+            do ip = 1, 4
+               do m = ip+1, 5
+                  v(m,i,j,k) = v(m,i,j,k) * m
+               end do
+            end do
+            do m = 5, 1, -1
+               do l = m+1, 5
+                  v(m,i,j,k) = v(l,i,j,k)
+               end do
+               v(m,i,j,k) = m
+           end do
+         end do
+      end do
+      return
+      end
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr43349.f b/gcc/testsuite/gfortran.dg/graphite/pr43349.f
new file mode 100644
index 000000000..86e408f9b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr43349.f
@@ -0,0 +1,35 @@
+! { dg-options "-O2 -floop-interchange" }
+
+      SUBROUTINE BUG(A,B,X,Y,Z,N)
+      IMPLICIT NONE
+      DOUBLE PRECISION A(*),B(*),X(*),Y(*),Z(*)
+      INTEGER N,J,K
+      K = 0
+      DO J = 1,N
+         K = K+1
+         X(K) = B(J+N*7)
+         Y(K) = B(J+N*8)
+         Z(K) = B(J+N*2)  + A(J+N*2)
+         K = K+1
+         X(K) = B(J+N*3)  + A(J+N*3)
+         Y(K) = B(J+N*9)  + A(J)
+         Z(K) = B(J+N*15)
+         K = K+1
+         X(K) = B(J+N*4)  + A(J+N*4)
+         Y(K) = B(J+N*15)
+         Z(K) = B(J+N*10) + A(J)
+         K = K+1
+         X(K) = B(J+N*11) + A(J+N)
+         Y(K) = B(J+N*5)  + A(J+N*5)
+         Z(K) = B(J+N*16)
+         K = K+1
+         X(K) = B(J+N*16)
+         Y(K) = B(J+N*6)  + A(J+N*6)
+         Z(K) = B(J+N*12) + A(J+N)
+         K = K+1
+         X(K) = B(J+N*13) + A(J+N*2)
+         Y(K) = B(J+N*17)
+         Z(K) = B(J+N*7)  + A(J+N*7)
+      ENDDO
+      RETURN
+      END
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr45758.f90 b/gcc/testsuite/gfortran.dg/graphite/pr45758.f90
new file mode 100644
index 000000000..b0e0a3d2c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr45758.f90
@@ -0,0 +1,41 @@
+! { dg-options "-O3 -floop-block" }
+
+MODULE util
+  INTEGER, PARAMETER :: int_4=4
+  INTERFACE sort
+     MODULE PROCEDURE sort_int_4v
+  END INTERFACE
+CONTAINS
+  SUBROUTINE sort_int_4v ( arr, n, index )
+    INTEGER(KIND=int_4), INTENT(INOUT)       :: arr(1:n)
+    INTEGER, INTENT(OUT)                     :: INDEX(1:n)
+    DO i = 1, n
+       INDEX(i) = i
+    END DO
+1   IF (ir-l<m) THEN
+       DO j = l + 1, ir
+          DO i = j - 1, 1, -1
+             IF (arr(i)<=a) GO TO 2
+             arr(i+1) = arr(i)
+             INDEX(i+1) = INDEX(i)
+          END DO
+2         arr(i+1) = a
+       END DO
+    END IF
+  END SUBROUTINE sort_int_4v
+  SUBROUTINE create_destination_list(list)
+    INTEGER, DIMENSION(:, :, :), POINTER     :: list
+    INTEGER                                  ::  icpu, ncpu, stat, ultimate_max
+    INTEGER, ALLOCATABLE, DIMENSION(:)       :: index, sublist
+    ultimate_max=7
+    ALLOCATE(INDEX(ultimate_max),STAT=stat)
+    CALL t(stat==0)
+    ALLOCATE(sublist(ultimate_max),STAT=stat)
+    DO icpu=0,ncpu-1
+       CALL sort(sublist,ultimate_max,index)
+       list(1,:,icpu)=sublist
+       list(2,:,icpu)=0
+    ENDDO
+  END SUBROUTINE create_destination_list
+END MODULE
+
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr47019.f b/gcc/testsuite/gfortran.dg/graphite/pr47019.f
new file mode 100644
index 000000000..69067e9c5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/pr47019.f
@@ -0,0 +1,12 @@
+! { dg-options "-O -ftree-pre -fgraphite-identity -fno-tree-copy-prop" }
+
+      subroutine foo (ldmx,ldmy,v)
+      integer :: ldmx, ldmy, v, l, m
+      dimension v(5,ldmx,ldmy)
+      do m = 5, 1, -1
+        do l = m+1, 5
+          v(m,3,2) = v(1,3,2)
+        end do
+        v(m,3,2) = m
+      end do
+      end
diff --git a/gcc/testsuite/gfortran.dg/graphite/run-id-1.f b/gcc/testsuite/gfortran.dg/graphite/run-id-1.f
new file mode 100644
index 000000000..521d268f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/run-id-1.f
@@ -0,0 +1,47 @@
+      subroutine mul66(rt,rtt,r)
+      real*8 rt(6,6),r(6,6),rtt(6,6)
+      do i=1,6
+        do j=1,6
+          do ia=1,6
+            rtt(i,ia)=rt(i,j)*r(j,ia)+rtt(i,ia)
+          end do
+        end do
+      end do
+      end
+
+      program test
+      real*8 xj(6,6),w(6,6),w1(6,6)
+      parameter(idump=0)
+      integer i,j
+
+      do i=1,6
+        do j=1,6
+          xj(i,j) = 0.0d0
+          w1(i,j) = 0.0d0
+          w(i,j) = i * 10.0d0 + j;
+        end do
+      end do
+
+      xj(1,2) =  1.0d0
+      xj(2,1) = -1.0d0
+      xj(3,4) =  1.0d0
+      xj(4,3) = -1.0d0
+      xj(5,6) =  1.0d0
+      xj(6,5) = -1.0d0
+
+      call mul66(xj,w1,w)
+
+      if (idump.ne.0) then
+        write(6,*) 'w1 after call to mul66'
+        do i = 1,6
+          do j = 1,6
+            write(6,'(D15.7)') w1(i,j)
+          end do
+        end do
+      end if
+
+      if (w1(1,1).ne.21.0d0) then
+        call abort()
+      end if
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/graphite/run-id-2.f90 b/gcc/testsuite/gfortran.dg/graphite/run-id-2.f90
new file mode 100644
index 000000000..c4fa1d061
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/run-id-2.f90
@@ -0,0 +1,66 @@
+  IMPLICIT NONE
+  INTEGER, PARAMETER :: dp=KIND(0.0D0)
+  REAL(KIND=dp)      :: res
+
+  res=exp_radius_very_extended(  0    ,      1   ,       0      ,    1, &
+                               (/0.0D0,0.0D0,0.0D0/),&
+                               (/1.0D0,0.0D0,0.0D0/),&
+                               (/1.0D0,0.0D0,0.0D0/),&
+                                 1.0D0,1.0D0,1.0D0,1.0D0)
+  if (res.ne.1.0d0) call abort()
+
+CONTAINS
+
+ FUNCTION exp_radius_very_extended(la_min,la_max,lb_min,lb_max,ra,rb,rp,&
+                          zetp,eps,prefactor,cutoff) RESULT(radius)
+
+    INTEGER, INTENT(IN)                      :: la_min, la_max, lb_min, lb_max
+    REAL(KIND=dp), INTENT(IN)                :: ra(3), rb(3), rp(3), zetp, &
+                                                eps, prefactor, cutoff
+    REAL(KIND=dp)                            :: radius
+
+    INTEGER                                  :: i, ico, j, jco, la(3), lb(3), &
+                                                lxa, lxb, lya, lyb, lza, lzb
+    REAL(KIND=dp)                            :: bini, binj, coef(0:20), &
+                                                epsin_local, polycoef(0:60), &
+                                                prefactor_local, rad_a, &
+                                                rad_b, s1, s2
+
+    epsin_local=1.0E-2_dp
+
+    prefactor_local=prefactor*MAX(1.0_dp,cutoff)
+    rad_a=SQRT(SUM((ra-rp)**2))
+    rad_b=SQRT(SUM((rb-rp)**2))
+
+    polycoef(0:la_max+lb_max)=0.0_dp
+    DO lxa=0,la_max
+    DO lxb=0,lb_max
+       coef(0:la_max+lb_max)=0.0_dp
+       bini=1.0_dp
+       s1=1.0_dp
+       DO i=0,lxa
+          binj=1.0_dp
+          s2=1.0_dp
+          DO j=0,lxb
+             coef(lxa+lxb-i-j)=coef(lxa+lxb-i-j) + bini*binj*s1*s2
+             binj=(binj*(lxb-j))/(j+1)
+             s2=s2*(rad_b)
+          ENDDO
+          bini=(bini*(lxa-i))/(i+1)
+          s1=s1*(rad_a)
+       ENDDO
+       DO i=0,lxa+lxb
+          polycoef(i)=MAX(polycoef(i),coef(i))
+       ENDDO
+    ENDDO
+    ENDDO
+
+    polycoef(0:la_max+lb_max)=polycoef(0:la_max+lb_max)*prefactor_local
+    radius=0.0_dp
+    DO i=0,la_max+lb_max
+          radius=MAX(radius,polycoef(i)**(i+1))
+    ENDDO
+
+  END FUNCTION exp_radius_very_extended
+
+END
diff --git a/gcc/testsuite/gfortran.dg/graphite/scop-1.f b/gcc/testsuite/gfortran.dg/graphite/scop-1.f
new file mode 100644
index 000000000..5bd463c4e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/scop-1.f
@@ -0,0 +1,13 @@
+      dimension p1(2),t(6,4),b1(2),b2(2),al1(2),al2(2),g1(2),g2(2)
+      save
+      if(nlin.eq.0) then
+        do 20 l=1,2
+          ll=2*l
+          b2(l)=t(6-ll,ll-1)*t(6-ll,ll-1)+t(7-ll,ll-1)*t(7-ll,ll-1)
+          write(*,*) b2(l)
+   20   continue
+      endif
+      end
+
+! { dg-final { scan-tree-dump-times "number of SCoPs: 1" 1 "graphite" { xfail *-*-* } } } 
+! { dg-final { cleanup-tree-dump "graphite" } } 
diff --git a/gcc/testsuite/gfortran.dg/graphite/vect-pr40979.f90 b/gcc/testsuite/gfortran.dg/graphite/vect-pr40979.f90
new file mode 100644
index 000000000..662b82a12
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/graphite/vect-pr40979.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-require-effective-target vect_double }
+
+module mqc_m
+integer, parameter, private :: longreal = selected_real_kind(15,90)
+contains
+      subroutine mutual_ind_quad_cir_coil (m, l12)
+      real (kind = longreal), dimension(9), save :: w2gauss, w1gauss
+      real (kind = longreal) :: l12_lower, num, l12
+      real (kind = longreal), dimension(3) :: current, coil
+      w2gauss(1) = 16.0_longreal/81.0_longreal
+      w1gauss(5) = 0.3302393550_longreal
+      do i = 1, 2*m
+          do j = 1, 9
+              do k = 1, 9
+                  num = w1gauss(j) * w2gauss(k) * dot_product(coil,current)
+                  l12_lower = l12_lower + num
+              end do
+          end do
+      end do
+      l12 = l12_lower
+      end subroutine mutual_ind_quad_cir_coil
+end module mqc_m
+
+! { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" } }
+! { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/guality/arg1.f90 b/gcc/testsuite/gfortran.dg/guality/arg1.f90
new file mode 100644
index 000000000..332a4ed1d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/guality/arg1.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-g" }
+  integer :: a(10), b(12)
+  call sub (a, 10)
+  call sub (b, 12)
+  write (*,*) a, b
+end
+
+subroutine sub (a, n)
+  integer :: a(n), n
+  do i = 1, n
+    a(i) = i
+  end do
+  write (*,*) a	! { dg-final { gdb-test 14 "a(10)" "10" } }
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/guality/guality.exp b/gcc/testsuite/gfortran.dg/guality/guality.exp
new file mode 100644
index 000000000..2444d8de7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/guality/guality.exp
@@ -0,0 +1,29 @@
+# This harness is for tests that should be run at all optimisation levels.
+
+load_lib gfortran-dg.exp
+load_lib gcc-gdb-test.exp
+
+# Disable on darwin until radr://7264615 is resolved.
+if { [istarget *-*-darwin*] } {
+  return
+}
+
+dg-init
+
+global GDB
+if ![info exists ::env(GUALITY_GDB_NAME)] {
+    if [info exists GDB] {
+	set guality_gdb_name "$GDB"
+    } else {
+	set guality_gdb_name "[transform gdb]"
+    }
+    setenv GUALITY_GDB_NAME "$guality_gdb_name"
+}
+
+gfortran-dg-runtest [lsort [glob $srcdir/$subdir/*.\[fF\]{,90,95,03,08} ]] ""
+
+if [info exists guality_gdb_name] {
+    unsetenv GUALITY_GDB_NAME
+}
+
+dg-finish
diff --git a/gcc/testsuite/gfortran.dg/guality/pr41558.f90 b/gcc/testsuite/gfortran.dg/guality/pr41558.f90
new file mode 100644
index 000000000..9d1e83399
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/guality/pr41558.f90
@@ -0,0 +1,10 @@
+! PR debug/41558
+! { dg-do run }
+! { dg-options "-g" }
+
+subroutine f (s)
+  character(len=3) :: s
+  write (*,*), s ! { dg-final { gdb-test 7 "s" "'foo'" } }
+end
+  call f ('foo')
+end
diff --git a/gcc/testsuite/gfortran.dg/hollerith.f90 b/gcc/testsuite/gfortran.dg/hollerith.f90
new file mode 100644
index 000000000..697ed22d8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/hollerith.f90
@@ -0,0 +1,102 @@
+! { dg-do run }
+! PR15966, PR18781 & PR16531
+implicit none
+complex(kind=8) x(2) 
+complex a(2,2)
+character(4) z
+character z1(4)
+character(4) z2(2,2)
+character(80) line
+integer i
+integer j
+real r
+character(8) c
+
+data x /16Habcdefghijklmnop, 16Hqrstuvwxyz012345/
+data a /8H(i3),abc, 0, 4H(i4), 8H    (i9)/
+data z/4h(i5)/
+data z1/1h(,1hi,1h6,1h)/
+data z2/4h(i7),'xxxx','xxxx','xxxx'/
+
+z2 (1,2) = 4h(i8)
+i = 4hHell
+j = 4Ho wo
+r = 4Hrld! 
+write (line, '(3A4)') i, j, r
+if (line .ne. 'Hello world!') call abort
+i = 2Hab
+j = 2Hab
+r = 2Hab
+c = 2Hab
+write (line, '(3A4, 8A)') i, j, r, c
+if (line .ne. 'ab  ab  ab  ab      ') call abort
+
+write(line, '(4A8, "!")' ) x
+if (line .ne. 'abcdefghijklmnopqrstuvwxyz012345!') call abort
+
+write (line, a) 3
+if (line .ne. '  3') call abort
+write (line, a (1,2)) 4
+if (line .ne. '   4') call abort
+write (line, z) 5
+if (line .ne. '    5') call abort
+write (line, z1) 6
+if (line .ne. '     6') call abort
+write (line, z2) 7
+if (line .ne. '      7') call abort
+write (line, z2 (1,2)) 8
+if (line .ne. '       8') call abort
+write (line, '(16A)') z2
+if (line .ne. '(i7)xxxx(i8)xxxx') call abort
+call test (8h   hello)
+end
+
+subroutine test (h)
+integer(kind=8) h
+character(80) line
+
+write (line, '(8a)') h
+if (line .ne. '   hello') call abort
+end subroutine
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 15 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 15 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 16 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 16 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 17 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 18 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 19 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 21 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 21 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 22 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 22 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 23 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 23 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 24 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 24 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 27 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 27 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 28 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 28 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 29 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 29 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 30 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 30 }
+
+! { dg-warning "Non-character in FORMAT tag" "" { target *-*-* } 37 }
+
+! { dg-warning "Non-character in FORMAT tag" "" { target *-*-* } 39 }
+
+! { dg-warning "Hollerith constant" "" { target *-*-* } 51 }
diff --git a/gcc/testsuite/gfortran.dg/hollerith2.f90 b/gcc/testsuite/gfortran.dg/hollerith2.f90
new file mode 100644
index 000000000..e3b2f49aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/hollerith2.f90
@@ -0,0 +1,26 @@
+       ! { dg-do run }
+       ! Program to test Hollerith constant.
+       Program test
+       implicit none
+       integer i,j
+       real r, x, y
+       parameter (i = 4h1234)
+       parameter (r = 4hdead)
+       parameter (y = 4*r)
+       parameter (j = selected_real_kind (i))
+       x = 4H1234 
+       x = sin(r)
+       x = x * r
+       x = x / r
+       x = x + r
+       x = x - r
+       end
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 7 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 7 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 8 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 8 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 11 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 11 }
+
diff --git a/gcc/testsuite/gfortran.dg/hollerith3.f90 b/gcc/testsuite/gfortran.dg/hollerith3.f90
new file mode 100644
index 000000000..b283f5f7c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/hollerith3.f90
@@ -0,0 +1,9 @@
+       ! { dg-do compile }
+       ! { dg-options "-w" }
+       ! Program to test invalid Hollerith constant.
+       Program test
+       implicit none
+       integer i
+       i = 0H ! { dg-error "at least one character" }
+       i = 4_8H1234 ! { dg-error "should be default" }
+       end
diff --git a/gcc/testsuite/gfortran.dg/hollerith4.f90 b/gcc/testsuite/gfortran.dg/hollerith4.f90
new file mode 100644
index 000000000..bd2b411f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/hollerith4.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! Test Hollerith constants assigned to allocatable array
+! and used in I/O list.
+
+integer, allocatable :: c (:,:)
+character (len = 20) ch
+allocate (c(1,2))
+
+c(1,1) = 4H(A4)
+c(1,2) = 4H(A5)
+
+write (ch, "(2A4)") c
+if (ch .ne. "(A4)(A5)") call abort()
+write (ch, c) 'Hello'
+if (ch .ne. "Hell") call abort()
+write (ch, c (1,2)) 'Hello'
+if (ch .ne. "Hello") call abort()
+
+write (ch, *) 5Hhello
+if (ch .ne. " hello") call abort()
+write (ch, "(A5)") 5Hhello
+if (ch .ne. "hello") call abort()
+
+end
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 9 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 9 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 10 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 10 }
+
+! { dg-warning "Non-character in FORMAT tag" "" { target *-*-* } 14 }
+
+! { dg-warning "Non-character in FORMAT tag" "" { target *-*-* } 16 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 19 }
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 21 }
+
diff --git a/gcc/testsuite/gfortran.dg/hollerith5.f90 b/gcc/testsuite/gfortran.dg/hollerith5.f90
new file mode 100644
index 000000000..ebd0a117c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/hollerith5.f90
@@ -0,0 +1,8 @@
+       ! { dg-do compile }
+       implicit none
+       logical b
+       b = 4Habcd ! { dg-warning "has undefined result" }
+       end
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 4 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 4 }
diff --git a/gcc/testsuite/gfortran.dg/hollerith6.f90 b/gcc/testsuite/gfortran.dg/hollerith6.f90
new file mode 100644
index 000000000..93e857dd5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/hollerith6.f90
@@ -0,0 +1,35 @@
+! PR fortran/39865
+! { dg-do run }
+
+subroutine foo (a)
+  integer(kind=4) :: a(1, 3)
+  character(len=40) :: t
+  write (t, fmt=a(1,2)) 1, 2, 3, 4, 5, 6, 7, 8
+  if (t .ne. '   1   2   3   4   5   6   7   8') call abort
+end subroutine foo
+  interface
+    subroutine foo (a)
+      integer(kind=4) :: a(1, 3)
+    end subroutine foo
+  end interface
+  integer(kind=4) :: b(1,3)
+  character(len=40) :: t
+  b(1,1) = 4HXXXX
+  b(1,2) = 4H (8I
+  b(1,3) = 2H4)
+  write (t, fmt=b(1,2)) 1, 2, 3, 4, 5, 6, 7, 8
+  if (t .ne. '   1   2   3   4   5   6   7   8') call abort
+  call foo (b)
+end
+
+! { dg-warning "Non-character in FORMAT tag" "FMT" { target *-*-* } 7 }
+! { dg-warning "Non-character in FORMAT tag" "FMT" { target *-*-* } 20 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 17 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 17 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 18 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 18 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 19 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 19 }
diff --git a/gcc/testsuite/gfortran.dg/hollerith7.f90 b/gcc/testsuite/gfortran.dg/hollerith7.f90
new file mode 100644
index 000000000..8e2fb4fec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/hollerith7.f90
@@ -0,0 +1,52 @@
+! PR fortran/39865
+! { dg-do compile }
+
+subroutine foo (a)
+  integer(kind=4), target :: a(1:, 1:)
+  integer(kind=4), pointer :: b(:, :)
+  b => a
+  write (*, fmt=a(1,2)) 1, 2, 3, 4, 5, 6, 7, 8
+  write (*, fmt=b(1,2)) 1, 2, 3, 4, 5, 6, 7, 8
+end subroutine foo
+subroutine bar (a, b)
+  character :: b(2,*)
+  integer :: a(*)
+  write (*, fmt=b) 1, 2, 3
+  write (*, fmt=a) 1, 2, 3
+  write (*, fmt=a(2)) 1, 2, 3
+end subroutine
+  interface
+    subroutine foo (a)
+      integer(kind=4), target :: a(:, :)
+    end subroutine foo
+  end interface
+  integer(kind=4) :: a(2, 3)
+  a = 4HXXXX
+  a(2,2) = 4H (8I
+  a(1,3) = 2H4)
+  a(2,3) = 1H 
+  call foo (a(2:2,:))
+end
+
+! { dg-warning "Non-character in FORMAT tag" "FMT" { target *-*-* } 8 }
+! { dg-error "Non-character assumed shape array element in FORMAT tag" "element" { target *-*-* } 8 }
+
+! { dg-warning "Non-character in FORMAT tag" "FMT" { target *-*-* } 9 }
+! { dg-error "Non-character pointer array element in FORMAT tag" "element" { target *-*-* } 9 }
+
+! { dg-error "reference to the assumed size array" "assumed-size" { target *-*-* } 14 }
+! { dg-error "reference to the assumed size array" "assumed-size" { target *-*-* } 15 }
+! { dg-warning "Non-character in FORMAT tag" "FMT" { target *-*-* } 16 }
+! { dg-error "Non-character assumed size array element in FORMAT tag" "element" { target *-*-* } 16 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 24 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 24 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 25 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 25 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 26 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 26 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 27 }
+! { dg-warning "Conversion" "conversion" { target *-*-* } 27 }
diff --git a/gcc/testsuite/gfortran.dg/hollerith8.f90 b/gcc/testsuite/gfortran.dg/hollerith8.f90
new file mode 100644
index 000000000..65cb681cb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/hollerith8.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+! PR43217 Output of Hollerith constants which are not a multiple of 4 bytes
+! Test case prepared from OP by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program hello2
+  call wrtout (9hHELLO YOU, 9)
+  stop
+end
+
+subroutine wrtout (iarray, nchrs)
+  integer iarray(1)
+  integer nchrs
+
+  integer icpw
+  data icpw/4/
+  integer i, nwrds
+  character(len=33) outstr
+
+  nwrds = (nchrs + icpw - 1) /icpw
+  write(outstr,'(4(z8," "))') (iarray(i), i=1,nwrds)
+  if (outstr.ne."4C4C4548 4F59204F 20202055" .and. &
+ &    outstr.ne."48454C4C 4F20594F 55202020") call abort
+  return
+end
+! { dg-warning "Hollerith constant" "" { target *-*-* } 6 }
+! { dg-warning "Rank mismatch" "" { target *-*-* } 6 }
diff --git a/gcc/testsuite/gfortran.dg/hollerith_1.f90 b/gcc/testsuite/gfortran.dg/hollerith_1.f90
new file mode 100644
index 000000000..829ca7f99
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/hollerith_1.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR 21260
+! We wrongly interpreted the '!' as the beginning of a comment.
+! Also verifies the functioning of hollerith formatting.
+      character*72 c
+      write(c,8000)
+8000  format(36(2H!)))
+      do i = 1,72,2
+         if (c(i:i+1) /= '!)') call abort
+      end do
+      end
diff --git a/gcc/testsuite/gfortran.dg/hollerith_f95.f90 b/gcc/testsuite/gfortran.dg/hollerith_f95.f90
new file mode 100644
index 000000000..dc52187ad
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/hollerith_f95.f90
@@ -0,0 +1,93 @@
+! { dg-do compile }
+! { dg-options "-fall-intrinsics -std=f95" }
+! PR15966, PR18781 & PR16531
+implicit none
+complex(kind=8) x(2) 
+complex a(2,2)
+character(4) z
+character z1(4)
+character(4) z2(2,2)
+character(80) line
+integer i
+logical l
+real r
+character(8) c
+
+data x /16Habcdefghijklmnop, 16Hqrstuvwxyz012345/
+data a /8H(i3),abc, 0, 4H(i4), 8H    (i9)/
+data z/4h(i5)/
+data z1/1h(,1hi,1h6,1h)/
+data z2/4h(i7),'xxxx','xxxx','xxxx'/
+
+z2 (1,2) = 4h(i8)
+i = 4hHell
+l = 4Ho wo
+r = 4Hrld! 
+write (line, '(3A4)') i, l, r
+if (line .ne. 'Hello world!') call abort
+i = 2Hab
+r = 2Hab
+l = 2Hab
+c = 2Hab
+write (line, '(3A4, 8A)') i, l, r, c
+if (line .ne. 'ab  ab  ab  ab      ') call abort
+
+write(line, '(4A8, "!")' ) x
+if (line .ne. 'abcdefghijklmnopqrstuvwxyz012345!') call abort
+
+write (line, a) 3
+if (line .ne. '  3') call abort
+write (line, a (1,2)) 4
+if (line .ne. '   4') call abort
+write (line, z) 5
+if (line .ne. '    5') call abort
+write (line, z1) 6
+if (line .ne. '     6') call abort
+write (line, z2) 7
+if (line .ne. '      7') call abort
+write (line, z2 (1,2)) 8
+if (line .ne. '       8') call abort
+write (line, '(16A)') z2
+if (line .ne. '(i7)xxxx(i8)xxxx') call abort
+call test (8h   hello)
+end
+
+subroutine test (h)
+integer(kind=8) h
+character(80) line
+
+write (line, '(8a)') h
+if (line .ne. '   hello') call abort
+end subroutine
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 16 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 17 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 18 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 19 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 20 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 22 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 23 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 24 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 25 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 28 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 29 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 30 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 31 }
+
+! { dg-error "Hollerith constant" "const" { target *-*-* } 52 }
+
+! { dg-error "Non-character in FORMAT tag" "" { target *-*-* } 38 }
+
+! { dg-error "Non-character in FORMAT tag" "" { target *-*-* } 40 }
diff --git a/gcc/testsuite/gfortran.dg/hollerith_legacy.f90 b/gcc/testsuite/gfortran.dg/hollerith_legacy.f90
new file mode 100644
index 000000000..1bbaf3f68
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/hollerith_legacy.f90
@@ -0,0 +1,61 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+! PR15966, PR18781 & PR16531
+implicit none
+complex(kind=8) x(2) 
+complex a(2,2)
+character*4 z
+character z1(4)
+character*4 z2(2,2)
+character*80 line
+integer i
+logical l
+real r
+character*8 c
+
+data x /16Habcdefghijklmnop, 16Hqrstuvwxyz012345/
+data a /8H(i3),abc, 0, 4H(i4), 8H    (i9)/
+data z/4h(i5)/
+data z1/1h(,1hi,1h6,1h)/
+data z2/4h(i7),'xxxx','xxxx','xxxx'/
+
+z2 (1,2) = 4h(i8)
+i = 4hHell
+l = 4Ho wo	! { dg-warning "has undefined result" }
+r = 4Hrld! 
+write (line, '(3A4)') i, l, r
+if (line .ne. 'Hello world!') call abort
+i = 2Hab
+r = 2Hab
+l = 2Hab	! { dg-warning "has undefined result" }
+c = 2Hab
+write (line, '(3A4, 8A)') i, l, r, c
+if (line .ne. 'ab  ab  ab  ab      ') call abort
+
+write(line, '(4A8, "!")' ) x
+if (line .ne. 'abcdefghijklmnopqrstuvwxyz012345!') call abort
+
+write (line, a) 3
+if (line .ne. '  3') call abort
+write (line, a (1,2)) 4
+if (line .ne. '   4') call abort
+write (line, z) 5
+if (line .ne. '    5') call abort
+write (line, z1) 6
+if (line .ne. '     6') call abort
+write (line, z2) 7
+if (line .ne. '      7') call abort
+write (line, z2 (1,2)) 8
+if (line .ne. '       8') call abort
+write (line, '(16A)') z2
+if (line .ne. '(i7)xxxx(i8)xxxx') call abort
+call test (8h   hello)
+end
+
+subroutine test (h)
+integer(kind=8) h
+character*80 line
+
+write (line, '(8a)') h
+if (line .ne. '   hello') call abort
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_blockdata_1.f90 b/gcc/testsuite/gfortran.dg/host_assoc_blockdata_1.f90
new file mode 100644
index 000000000..07f9ed478
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_blockdata_1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! PR 38672 - this used to ICE.
+MODULE globals
+  TYPE :: type1
+     integer :: x
+  END TYPE type1
+  TYPE (type1) :: pdm_bps
+END module globals
+BLOCK DATA
+   use globals
+END BLOCK DATA
+! { dg-final { cleanup-modules "globals" } }
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_blockdata_2.f90 b/gcc/testsuite/gfortran.dg/host_assoc_blockdata_2.f90
new file mode 100644
index 000000000..40e3ac4d5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_blockdata_2.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+MODULE globals
+  TYPE :: type1
+     sequence
+     integer :: x
+  END TYPE type1
+  TYPE (type1) :: pdm_bps
+  common /co/ pdm_bps
+END module globals
+BLOCK DATA
+   use globals
+END BLOCK DATA
+
+program main
+  use globals
+  common /co/ pdm_bps ! { dg-error "already in a COMMON block" }
+end program main
+! { dg-final { cleanup-modules "globals" } }
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_call_1.f90 b/gcc/testsuite/gfortran.dg/host_assoc_call_1.f90
new file mode 100644
index 000000000..804929080
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_call_1.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! Tests the fix for PR31494, where the call of sub2 would reference
+! the variable, rather than the contained subroutine.
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+!
+MODULE ksbin2_aux_mod
+REAL, DIMENSION(1) :: sub2
+CONTAINS
+  SUBROUTINE sub1
+    CALL sub2
+    CONTAINS 
+      SUBROUTINE sub2
+      END SUBROUTINE sub2
+  END SUBROUTINE sub1
+END MODULE ksbin2_aux_mod
+! { dg-final { cleanup-modules "ksbin2_aux_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_call_2.f90 b/gcc/testsuite/gfortran.dg/host_assoc_call_2.f90
new file mode 100644
index 000000000..a74f37343
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_call_2.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! Tests the fix for PR36700, in which the call to the function would
+! cause an ICE.
+!
+! Contributed by <terry@chem.gu.se>
+!
+module Diatoms
+  implicit none
+contains
+  function InitialDiatomicX () result(v4)    ! { dg-error "has a type" }
+    real(kind = 8), dimension(4) :: v4
+    v4 = 1
+  end function InitialDiatomicX
+  subroutine FindDiatomicPeriod
+    call InitialDiatomicX ()    ! { dg-error "which is not consistent with the CALL" }
+  end subroutine FindDiatomicPeriod
+end module Diatoms
+! { dg-final { cleanup-modules "Diatoms" } }
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_call_3.f90 b/gcc/testsuite/gfortran.dg/host_assoc_call_3.f90
new file mode 100644
index 000000000..379b228e4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_call_3.f90
@@ -0,0 +1,55 @@
+! { dg-do compile }
+!
+! PR fortran/37445, in which the contained 'putaline' would be
+! ignored and no specific interface found in the generic version.
+!
+! Contributed by Norman S Clerman < clerman@fuse.net>
+!
+MODULE M1
+  INTERFACE putaline
+    MODULE PROCEDURE S1,S2
+  END INTERFACE
+CONTAINS
+  SUBROUTINE S1(I)
+      i = 3
+  END SUBROUTINE
+  SUBROUTINE S2(F)
+      f = 4.0
+  END SUBROUTINE
+END MODULE
+
+MODULE M2
+  USE M1
+CONTAINS
+  SUBROUTINE S3
+    integer :: check = 0
+    CALL putaline()
+    if (check .ne. 1) call abort
+    CALL putaline("xx")
+    if (check .ne. 2) call abort
+!  CALL putaline(1.0) ! => this now causes an error, as it should 
+  CONTAINS
+    SUBROUTINE putaline(x)
+      character, optional :: x
+      if (present(x)) then
+        check = 2
+      else
+        check = 1
+      end if
+    END SUBROUTINE
+  END SUBROUTINE
+  subroutine S4
+    integer :: check = 0
+    REAL :: rcheck = 0.0
+    call putaline(check)
+    if (check .ne. 3) call abort
+    call putaline(rcheck)
+    if (rcheck .ne. 4.0) call abort
+  end subroutine s4
+END MODULE
+
+  USE M2
+  CALL S3
+  call S4
+END
+! { dg-final { cleanup-modules "M1 M2" } }
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_call_4.f90 b/gcc/testsuite/gfortran.dg/host_assoc_call_4.f90
new file mode 100644
index 000000000..f97a644e6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_call_4.f90
@@ -0,0 +1,48 @@
+! { dg-do compile }
+!
+! PR fortran/37445, in which the first version of the fix regressed on the 
+! calls to GetBasicElementData; picking up the local GetBasicElementData instead.
+!
+! Contributed by Norman S Clerman < clerman@fuse.net>
+! and reduced by Tobias Burnus <burnus@gcc.gnu.org>
+!
+MODULE ErrElmnt
+  IMPLICIT NONE
+  TYPE :: TErrorElement
+    integer :: i
+  end type TErrorElement
+contains
+  subroutine GetBasicData ( AnElement, ProcedureName, ErrorNumber,    &
+                            Level, Message, ReturnStat)
+    type (TErrorElement) :: AnElement
+    character (*, 1), optional ::       &
+      ProcedureName
+    integer (4), optional :: ErrorNumber
+    character (*, 1), optional :: Level
+    character (*, 1), optional :: Message
+    integer (4), optional :: ReturnStat
+  end subroutine GetBasicData
+end module ErrElmnt
+
+MODULE ErrorMod
+  USE ErrElmnt, only: GetBasicElementData => GetBasicData , TErrorElement
+  IMPLICIT NONE
+contains
+  subroutine GetBasicData ()
+    integer (4) :: CallingStat, LocalErrorNum
+    character (20, 1) :: LocalErrorMessage
+    character (20, 1) :: LocalProcName
+    character (20, 1) :: Locallevel
+    type (TErrorElement) :: AnElement
+    call GetBasicElementData (AnElement, LocalProcName, LocalErrorNum, LocalLevel, LocalErrorMessage, CallingStat)
+  end subroutine GetBasicData
+  SUBROUTINE WH_ERR ()
+    integer (4) :: ErrorNumber, CallingStat
+    character (20, 1) :: ProcedureName
+    character (20, 1) :: ErrorLevel
+    character (20, 1) :: ErrorMessage
+    type (TErrorElement) :: TargetElement
+    call GetBasicElementData (TargetElement, ProcedureName, ErrorNumber, ErrorLevel, ErrorMessage, CallingStat)
+  end subroutine WH_ERR
+end module ErrorMod
+! { dg-final { cleanup-modules "ErrElmnt ErrorMod" } }
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_call_5.f90 b/gcc/testsuite/gfortran.dg/host_assoc_call_5.f90
new file mode 100644
index 000000000..6ce57ce01
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_call_5.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! Tests the fix for PR37597, where the reference to other_sub would generate
+! Error: Symbol 'other_sub' at (1) has no IMPLICIT type.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+! from a report on clf by Rich Townsend <rhdt@barvoidtol.udel.edu>
+!
+module foo
+   implicit none
+contains
+   subroutine main_sub ()
+     call internal_sub()
+   contains
+     subroutine internal_sub()
+       call QAG(other_sub)
+     end subroutine internal_sub
+   end subroutine main_sub
+   subroutine other_sub ()
+   end subroutine other_sub
+end module foo
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_call_6.f90 b/gcc/testsuite/gfortran.dg/host_assoc_call_6.f90
new file mode 100644
index 000000000..60a5edc53
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_call_6.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+! PR fortran/38594, in which the symtree for the first
+! 'g' was being attached to the second. This is necessary
+! for generic interfaces(eg. hosts_call_3.f90) but makes
+! a mess otherwise.
+!
+! Contributed by Daniel Franke <dfranke@gcc.gnu.org>
+!
+MODULE m
+CONTAINS
+  SUBROUTINE g()
+  END SUBROUTINE
+  SUBROUTINE f()
+    CALL g()
+  CONTAINS
+    SUBROUTINE g()
+    END SUBROUTINE
+  END SUBROUTINE
+END MODULE
+
+  USE m
+  CALL g()
+END
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_1.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_1.f90
new file mode 100644
index 000000000..f80f97a27
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_function_1.f90
@@ -0,0 +1,43 @@
+! { dg-do run }
+! Tests the fix for the bug PR30746, in which the reference to 'x'
+! in 'inner' wrongly host-associated with the variable 'x' rather
+! than the function.
+!
+! Testcase is due to Malcolm Cohen, NAG.
+!
+real function z (i)
+  integer :: i
+  z = real (i)**i
+end function
+
+MODULE m
+  REAL :: x(3) = (/ 1.5, 2.5, 3.5 /)
+  interface
+    real function z (i)
+      integer :: i
+    end function
+  end interface
+CONTAINS
+  SUBROUTINE s
+    if (x(2, 3) .ne. real (2)**3) call abort ()
+    if (z(3, 3) .ne. real (3)**3) call abort ()
+    CALL inner
+  CONTAINS
+    SUBROUTINE inner
+      i = 7
+      if (x(i, 7) .ne. real (7)**7) call abort ()
+      if (z(i, 7) .ne. real (7)**7) call abort ()
+    END SUBROUTINE
+    FUNCTION x(n, m)
+      x = REAL(n)**m
+    END FUNCTION
+    FUNCTION z(n, m)
+      z = REAL(n)**m
+    END FUNCTION
+
+  END SUBROUTINE
+END MODULE
+  use m
+  call s()
+end
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_2.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_2.f90
new file mode 100644
index 000000000..5d63d7aa3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_function_2.f90
@@ -0,0 +1,48 @@
+! { dg-do compile }
+! Tests the fix for PR32464, where the use associated procedure would
+! mess up the check for "grandparent" host association.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+!
+
+module gfcbug64_mod1
+  implicit none
+
+  public :: inverse
+
+  interface inverse
+     module procedure copy
+  end interface
+
+contains
+
+  function copy (d) result (y)
+    real, intent(in) :: d(:)
+    real             :: y(size (d))     ! <- this version kills gfortran
+!    real, intent(in) :: d
+!    real             :: y
+    y = d
+  end function copy
+
+end module gfcbug64_mod1
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+module gfcbug64_mod2
+  implicit none
+contains
+
+  subroutine foo (x_o)
+    real, intent(in) :: x_o(:)
+
+    integer          :: s(size (x_o))           ! <- this line kills gfortran
+
+  contains
+
+    subroutine bar ()
+      use gfcbug64_mod1, only: inverse          ! <- this line kills gfortran
+    end subroutine bar
+
+  end subroutine foo
+end module gfcbug64_mod2
+! { dg-final { cleanup-modules "gfcbug64_mod1 gfcbug64_mod2" } }
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_3.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_3.f90
new file mode 100644
index 000000000..a83fa1738
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_function_3.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! Tests the fix for the bug PR33233, in which the reference to 'x'
+! in 'inner' wrongly host-associated with the variable 'x' rather
+! than the function.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+MODULE m
+  REAL :: x(3) = (/ 1.5, 2.5, 3.5 /)
+CONTAINS
+  SUBROUTINE s
+    if (x(2) .eq. 2.5) call abort ()
+  CONTAINS
+    FUNCTION x(n, m)
+      integer, optional :: m
+      if (present(m)) then
+        x = REAL(n)**m
+      else
+        x = 0.0
+      end if
+    END FUNCTION
+  END SUBROUTINE s
+END MODULE m
+  use m
+  call s
+end
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_4.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_4.f90
new file mode 100644
index 000000000..799eb0078
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_function_4.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+!
+! PR fortran/37445, in which the contained 's1' would be
+! ignored and the use+host associated version used.
+!
+! Contributed by Norman S Clerman < clerman@fuse.net>
+!
+MODULE M1
+CONTAINS
+  integer function S1 ()
+    s1 = 0
+  END function
+END MODULE
+
+MODULE M2
+  USE M1
+CONTAINS
+  SUBROUTINE S2
+    if (s1 () .ne. 1) call abort
+  CONTAINS
+    integer function S1 ()
+      s1 = 1
+    END function
+  END SUBROUTINE
+END MODULE
+
+  USE M2
+  CALL S2
+END
+! { dg-final { cleanup-modules "M1 M2" } }
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_5.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_5.f90
new file mode 100644
index 000000000..c75202e44
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_function_5.f90
@@ -0,0 +1,47 @@
+! { dg-do compile }
+!
+! PR fortran/38665, in which checking for host association
+! was wrongly trying to substitute mod_symmon(mult) with
+! mod_sympoly(mult) in the user operator expression on line
+! 43.
+!
+! Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>
+!
+module mod_symmon
+ implicit none
+
+ public :: t_symmon, operator(*)
+ private
+
+ type t_symmon
+   integer :: ierr = 0
+ end type t_symmon
+
+ interface operator(*)
+   module procedure mult
+ end interface
+
+contains
+ elemental function mult(m1,m2) result(m)
+  type(t_symmon), intent(in) :: m1, m2
+  type(t_symmon) :: m
+ end function mult
+end module mod_symmon
+
+module mod_sympoly
+ use mod_symmon
+ implicit none
+
+ type t_sympol
+   type(t_symmon), allocatable :: mons(:)
+ end type t_sympol
+contains
+
+ elemental function mult(p1,p2) result(p)
+  type(t_sympol), intent(in) :: p1,p2
+  type(t_sympol) :: p
+  type(t_symmon), allocatable :: mons(:)
+  mons(1) = p1%mons(1)*p2%mons(2)
+ end function
+end module
+! { dg-final { cleanup-modules "mod_symmon mod_sympoly" } }
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_6.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_6.f90
new file mode 100644
index 000000000..28cd7c836
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_function_6.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! Tests the fix for PR38765 in which the use associated symbol
+! 'fun' was confused with the contained function in 'mod_b'
+! because the real name was being used instead of the 'use'
+! name..
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+! from a report by Marco Restelli.
+!
+module mod_a
+  implicit none
+  public :: fun
+  private
+contains
+  pure function fun(x) result(mu)
+    real, intent(in) :: x(:,:)
+    real :: mu(2,2,size(x,2))
+    mu = 2.0
+  end function fun
+end module mod_a
+
+module mod_b
+  use mod_a, only: &
+  a_fun => fun
+  implicit none
+  private
+contains
+  pure function fun(x) result(mu)
+    real, intent(in) :: x(:,:)
+    real :: mu(2,2,size(x,2))
+    mu = a_fun(x)
+  end function fun
+end module mod_b
+
+! { dg-final { cleanup-modules "mod_a mod_b" } }
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_7.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_7.f90
new file mode 100644
index 000000000..15684438a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_function_7.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+! Tests the fix for PR38907, in which any expressions, including unary plus,
+! in front of the call to S_REAL_SUM_I (marked) would throw the mechanism
+! for correcting invalid host association.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+module sa0054_stuff
+  REAL :: S_REAL_SUM_2(10) = [(REAL (I), I = 1, 10)]
+contains
+  ELEMENTAL FUNCTION S_REAL_SUM_I (A)
+    REAL  ::  S_REAL_SUM_I
+    REAL, INTENT(IN)  ::  A
+    X = 1.0
+    S_REAL_SUM_I = X
+  END FUNCTION S_REAL_SUM_I
+  SUBROUTINE SA0054 (RDA)
+    REAL RDA(:)
+    RDA =  + S_REAL_SUM_I (RDA)          ! Reported problem => ICE
+    RDA = RDA + S_REAL_SUM_2 (INT (RDA)) ! Also failed
+  CONTAINS
+    ELEMENTAL FUNCTION S_REAL_SUM_I (A)
+      REAL  ::  S_REAL_SUM_I
+      REAL, INTENT(IN)  ::  A
+      S_REAL_SUM_I = 2.0 * A
+    END FUNCTION S_REAL_SUM_I
+    ELEMENTAL FUNCTION S_REAL_SUM_2 (A)
+      REAL  ::  S_REAL_SUM_2
+      INTEGER, INTENT(IN)  ::  A
+      S_REAL_SUM_2 = 2.0 * A
+    END FUNCTION S_REAL_SUM_2
+  END SUBROUTINE
+end module sa0054_stuff
+
+  use sa0054_stuff
+  REAL :: RDA(10) = [(REAL(I), I = 1, 10)]
+  call SA0054 (RDA)
+  IF (ANY (INT (RDA) .ne. [(6 * I, I = 1, 10)])) print *, rda
+END
+
+! { dg-final { cleanup-modules "sa0054_stuff" } }
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_9.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_9.f90
new file mode 100644
index 000000000..58cae435f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_function_9.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! Tests the fix for the bug PR40629, in which the reference to 'x'
+! in 'upper' wrongly host-associated with the symbol 'x' at module
+! leve rather than the function.
+!
+! Contributed by Philippe Marguinaud  <philippe.marguinaud@meteo.fr>
+!
+MODULE m
+  REAL :: x = 0
+CONTAINS
+  subroutine s
+    call upper
+    call lower
+  CONTAINS
+    SUBROUTINE upper
+     y = x(3,1)
+     if (int(y) .ne. 3) call abort
+    END SUBROUTINE
+    FUNCTION x(n, m)
+       x = m*n
+    END FUNCTION
+    SUBROUTINE lower
+     y = x(2,1)
+     if (int(y) .ne. 2) call abort
+    END SUBROUTINE
+  END SUBROUTINE
+END MODULE
+
+  use m
+  call s
+end
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_types_1.f90 b/gcc/testsuite/gfortran.dg/host_assoc_types_1.f90
new file mode 100644
index 000000000..53c968410
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_types_1.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! Tests the fix for PR29232, in which the invalid code below was not
+! diagnosed.
+!
+! Contributed by Tobias Burnus  <tobias.burnus@physik.fu-berlin.de>
+!
+MODULE test
+     TYPE vertex
+           INTEGER :: k
+     END TYPE vertex
+CONTAINS
+     SUBROUTINE S1()
+         TYPE(vertex) :: a  ! { dg-error "cannot be host associated" }
+         vertex : DO i=1,2  ! { dg-error "incompatible object of the same name" }
+         ENDDO vertex
+     END SUBROUTINE
+END MODULE test
+! { dg-final { cleanup-modules "test" } }
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_types_2.f90 b/gcc/testsuite/gfortran.dg/host_assoc_types_2.f90
new file mode 100644
index 000000000..824a49592
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_types_2.f90
@@ -0,0 +1,69 @@
+! { dg-do compile }
+! Tests the fix for PR33945, the host association of overloaded_type_s
+! would be incorrectly blocked by the use associated overloaded_type.
+!
+! Contributed by Jonathan Hogg  <J.Hogg@rl.ac.uk>
+!
+module dtype

+   implicit none

+

+   type overloaded_type

+      double precision :: part

+   end type

+

+   interface overloaded_sub

+      module procedure overloaded_sub_d

+   end interface

+

+contains

+   subroutine overloaded_sub_d(otype)

+      type(overloaded_type), intent(in) :: otype

+

+      print *, "d type = ", otype%part

+   end subroutine

+end module

+

+module stype

+   implicit none

+

+   type overloaded_type

+      real :: part

+   end type

+

+   interface overloaded_sub

+      module procedure overloaded_sub_s

+   end interface

+

+contains

+   subroutine overloaded_sub_s(otype)

+      type(overloaded_type), intent(in) :: otype

+

+      print *, "s type = ", otype%part

+   end subroutine

+end module

+

+program test

+   use stype, overloaded_type_s => overloaded_type

+   use dtype, overloaded_type_d => overloaded_type

+   implicit none

+

+   type(overloaded_type_s) :: sval

+   type(overloaded_type_d) :: dval

+

+   sval%part = 1

+   dval%part = 2

+

+   call fred(sval, dval)

+

+contains

+   subroutine fred(sval, dval)

+      use stype

+

+      type(overloaded_type_s), intent(in) :: sval  ! This caused an error

+      type(overloaded_type_d), intent(in) :: dval

+

+      call overloaded_sub(sval)

+      call overloaded_sub(dval)

+   end subroutine

+end program

+! { dg-final { cleanup-modules "stype dtype" } }

diff --git a/gcc/testsuite/gfortran.dg/host_assoc_variable_1.f90 b/gcc/testsuite/gfortran.dg/host_assoc_variable_1.f90
new file mode 100644
index 000000000..1e7adea88
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_variable_1.f90
@@ -0,0 +1,77 @@
+! { dg-do compile }
+! This tests that PR32760, in its various manifestations is fixed.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+!
+! This is the original bug - the frontend tried to fix the flavor of
+! 'PRINT' too early so that the compile failed on the subroutine 
+! declaration.
+!
+module gfcbug68
+  implicit none
+  public :: print
+contains
+  subroutine foo (i)
+    integer, intent(in)  :: i
+    print *, i
+  end subroutine foo
+  subroutine print (m)
+    integer, intent(in) :: m
+  end subroutine print
+end module gfcbug68
+
+! This version of the bug appears in comment # 21.
+!
+module m
+  public :: volatile
+contains
+  subroutine foo
+    volatile :: bar
+  end subroutine foo
+  subroutine volatile
+  end subroutine volatile
+end module
+
+! This was a problem with the resolution of the STAT parameter in 
+! ALLOCATE and DEALLOCATE that was exposed in comment #25.
+!
+module n
+  public :: integer
+  private :: istat
+contains
+  subroutine foo
+    integer, allocatable :: s(:), t(:)
+    allocate(t(5))
+    allocate(s(4), stat=istat)
+  end subroutine foo
+  subroutine integer()
+  end subroutine integer
+end module n
+
+! This is the version of the bug in comment #12 of the PR.
+!
+module gfcbug68a
+  implicit none
+  public :: write
+contains
+  function foo (i)
+    integer, intent(in)  :: i
+    integer foo
+    write (*,*) i
+    foo = i
+  end function foo
+  subroutine write (m)
+    integer, intent(in) :: m
+    print *, m*m*m
+  end subroutine write
+end module gfcbug68a
+
+program testit
+  use gfcbug68a
+  integer :: i = 27
+  integer :: k
+  k = foo(i)
+  print *, "in the main:", k
+  call write(33)
+end program testit
+! { dg-final { cleanup-modules "gfcbug68 gfcbug68a m n" } }
diff --git a/gcc/testsuite/gfortran.dg/host_dummy_index_1.f90 b/gcc/testsuite/gfortran.dg/host_dummy_index_1.f90
new file mode 100644
index 000000000..62080f940
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_dummy_index_1.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! Tests the fix for PR23446. Based on PR example.
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+! Tests furthermore the fix for PR fortran/29916.
+! Test contributed by Marco Restelli <mrestelli@gmail.com>
+!
+PROGRAM TST
+  INTEGER IMAX
+  INTEGER :: A(4) = 1
+  IMAX=2
+
+  CALL S(A)
+  CALL T(A)
+  CALL U(A)
+  if ( ALL(A.ne.(/2,2,3,4/))) CALL ABORT ()
+  if ( ALL(F().ne.(/2.0,2.0/))) CALL ABORT()
+
+CONTAINS
+  SUBROUTINE S(A)
+    INTEGER A(IMAX)
+    a = 2
+  END SUBROUTINE S
+  SUBROUTINE T(A)
+    INTEGER A(3:IMAX+4)
+    A(5:IMAX+4) = 3
+  END SUBROUTINE T
+  SUBROUTINE U(A)
+    INTEGER A(2,IMAX)
+    A(2,2) = 4
+  END SUBROUTINE U
+  FUNCTION F()
+    real :: F(IMAX)
+    F = 2.0
+  END FUNCTION F
+ENDPROGRAM TST
diff --git a/gcc/testsuite/gfortran.dg/host_used_types_1.f90 b/gcc/testsuite/gfortran.dg/host_used_types_1.f90
new file mode 100644
index 000000000..528f6de6d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_used_types_1.f90
@@ -0,0 +1,42 @@
+! { dg-do compile }
+! Tests the fix for PR25532, which was a regression introduced by
+! the fix for PR20244.
+!
+! Contributed by Erik Edelmann  <eedelman@gcc.gnu.org>
+module ModelParams
+        implicit none
+
+        type ReionizationParams
+             real   :: fraction
+        end type ReionizationParams
+
+        type CAMBparams
+             type(ReionizationParams) :: Reion
+         end type CAMBparams
+
+        type(CAMBparams) CP
+end module ModelParams
+
+
+module ThermoData
+    use ModelParams
+    implicit none
+
+contains
+
+    subroutine inithermo()
+        use ModelParams
+        if (0 < CP%Reion%fraction) then
+        end if
+    end subroutine inithermo
+
+! The bug expressed itself in this subroutine because the component type
+! information was not being copied from the parent namespace.
+    subroutine SetTimeSteps
+        if (0 < CP%Reion%fraction) then
+        end if
+    end subroutine SetTimeSteps
+
+end module ThermoData
+
+! { dg-final { cleanup-modules "ModelParams ThermoData" } }
diff --git a/gcc/testsuite/gfortran.dg/hypot_1.f90 b/gcc/testsuite/gfortran.dg/hypot_1.f90
new file mode 100644
index 000000000..0c1c6e2ae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/hypot_1.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+
+program test
+  implicit none
+
+  interface check
+    procedure check_r4
+    procedure check_r8
+  end interface check
+
+  real(kind=4) :: x4, y4
+  real(kind=8) :: x8, y8
+
+  x8 = 1.9_8 ; x4 = 1.9_4
+  y8 = -2.1_8 ; y4 = -2.1_4
+
+  call check(hypot(x8,y8), hypot(1.9_8,-2.1_8))
+  call check(hypot(x4,y4), hypot(1.9_4,-2.1_4))
+
+contains
+  subroutine check_r4 (a, b) ! { dg-warning "Extension: Internal procedure" }
+    real(kind=4), intent(in) :: a, b
+    if (abs(a - b) > 1.e-5 * abs(b)) call abort
+  end subroutine
+  subroutine check_r8 (a, b) ! { dg-warning "Extension: Internal procedure" }
+    real(kind=8), intent(in) :: a, b
+    if (abs(a - b) > 1.e-7 * abs(b)) call abort
+  end subroutine
+end program test
diff --git a/gcc/testsuite/gfortran.dg/iall_iany_iparity_1.f90 b/gcc/testsuite/gfortran.dg/iall_iany_iparity_1.f90
new file mode 100644
index 000000000..35b4e168e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iall_iany_iparity_1.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+!
+! PR fortran/38282
+!
+implicit none
+integer :: a(2,1)
+
+a(1,1) = 35
+a(2,1) = -74
+
+if (iand(a(1,1),a(2,1)) /= iall(a)) call abort ()
+if (iand(a(1,1),a(2,1)) /= iall(array=[35, -74])) call abort ()
+if (any (iand(a(1,1),a(2,1)) /= iall(a,dim=1))) call abort ()
+if (iand(a(1,1),a(2,1)) /= iall(dim=1,mask=[.true.,.true.],array=[35, -74])) call abort ()
+
+if (ior(a(1,1),a(2,1)) /= iany(a)) call abort ()
+if (ior(a(1,1),a(2,1)) /= iany(array=[35, -74])) call abort ()
+if (any (ior(a(1,1),a(2,1)) /= iany(a,dim=1))) call abort ()
+if (ior(a(1,1),a(2,1)) /= iany(dim=1,mask=[.true.,.true.],array=[35, -74])) call abort ()
+
+if (ieor(a(1,1),a(2,1)) /= iparity(a)) call abort ()
+if (ieor(a(1,1),a(2,1)) /= iparity(array=[35, -74])) call abort ()
+if (any (ieor(a(1,1),a(2,1)) /= iparity(a,dim=1))) call abort ()
+if (ieor(a(1,1),a(2,1)) /= iparity(dim=1,mask=[.true.,.true.],array=[35, -74])) call abort ()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/iall_iany_iparity_2.f90 b/gcc/testsuite/gfortran.dg/iall_iany_iparity_2.f90
new file mode 100644
index 000000000..4872ddf7f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iall_iany_iparity_2.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/38282
+!
+implicit none
+integer :: a(2,1)
+
+a(1,1) = 35
+a(2,1) = -74
+
+if (iand(a(1,1),a(2,1)) /= iall(a)) stop 1 ! { dg-error " .iall. at .1. has no IMPLICIT type" }
+
+if (ior(a(1,1),a(2,1)) /= iany(a)) stop 1 ! { dg-error " .iany. at .1. has no IMPLICIT type" }
+
+if (ieor(a(1,1),a(2,1)) /= iparity(a)) stop 1 ! { dg-error " .iparity. at .1. has no IMPLICIT type" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/iargc.f90 b/gcc/testsuite/gfortran.dg/iargc.f90
new file mode 100644
index 000000000..a91e9003a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iargc.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! { dg-options "-fall-intrinsics -std=f95" }
+! PR fortran/20248
+program z
+   if (iargc() /= 0) call abort
+end program z
diff --git a/gcc/testsuite/gfortran.dg/ibclr_1.f90 b/gcc/testsuite/gfortran.dg/ibclr_1.f90
new file mode 100644
index 000000000..3932789ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ibclr_1.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+program a
+   integer :: i = 42
+   integer l
+   l = ibclr(i, -1)  ! { dg-error "must be nonnegative" }
+   l = ibclr(i, 65)  ! { dg-error "must be less than" }
+end program a
diff --git a/gcc/testsuite/gfortran.dg/ibits.f90 b/gcc/testsuite/gfortran.dg/ibits.f90
new file mode 100644
index 000000000..9233b97a3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ibits.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! Test that the mask is properly converted to the kind type of j in ibits.
+program ibits_test
+  implicit none
+  integer(8), parameter :: n = z'00000000FFFFFFFF' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
+  integer(8) i,j,k,m
+  j = 1
+  do i=1,70
+     j = ishft(j,1) + 1
+     k = ibits(j, 0, 32)
+     m = iand(j,n)
+     if (k /= m) call abort
+  end do
+end program ibits_test
+
diff --git a/gcc/testsuite/gfortran.dg/ibits_1.f90 b/gcc/testsuite/gfortran.dg/ibits_1.f90
new file mode 100644
index 000000000..2bcbe829b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ibits_1.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+!
+! PR fortran/44346
+! Original test sumbitted by Vittorio Zecca, zeccav at gmail dot com.
+! Modified by Steven G. Kargl for dejagnu testsuite.
+!
+program a
+   integer :: j, i = 42
+   j = ibits(i, -1, 1)    ! { dg-error "must be nonnegative" }
+   j = ibits(i, 1, -1)    ! { dg-error "must be nonnegative" }
+   j = ibits(i, 100, 100) ! { dg-error "must be less than" }
+end program a
+
diff --git a/gcc/testsuite/gfortran.dg/ibset_1.f90 b/gcc/testsuite/gfortran.dg/ibset_1.f90
new file mode 100644
index 000000000..2ff261dbd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ibset_1.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+program a
+   integer :: i = 42
+   integer l
+   l = ibset(i, -1)  ! { dg-error "must be nonnegative" }
+   l = ibset(i, 65)  ! { dg-error "must be less than" }
+end program a
diff --git a/gcc/testsuite/gfortran.dg/ichar_1.f90 b/gcc/testsuite/gfortran.dg/ichar_1.f90
new file mode 100644
index 000000000..362cd2f45
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ichar_1.f90
@@ -0,0 +1,71 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! PR20879
+! Check that we reject expressions longer than one character for the
+! ICHAR and IACHAR intrinsics.
+
+! Assumed length variables are special because the frontend doesn't have
+! an expression for their length
+subroutine test (c)
+  character(len=*) :: c
+  integer i
+  i = ichar(c)
+  i = ichar(c(2:))
+  i = ichar(c(:1))
+end subroutine
+
+program ichar_1
+   type derivedtype
+      character(len=4) :: addr
+   end type derivedtype
+
+   type derivedtype1
+      character(len=1) :: addr
+   end type derivedtype1
+
+   integer i
+   integer, parameter :: j = 2
+   character(len=8) :: c = 'abcd'
+   character(len=1) :: g1(2)
+   character(len=1) :: g2(2,2)
+   character*1, parameter :: s1 = 'e'
+   character*2, parameter :: s2 = 'ef'
+   type(derivedtype) :: dt
+   type(derivedtype1) :: dt1
+
+   if (ichar(c(3:3)) /= 97) call abort
+   if (ichar(c(:1)) /= 97) call abort
+   if (ichar(c(j:j)) /= 98) call abort
+   if (ichar(s1) /= 101) call abort
+   if (ichar('f') /= 102) call abort
+   g1(1) = 'a'
+   if (ichar(g1(1)) /= 97) call abort
+   if (ichar(g1(1)(:)) /= 97) call abort
+   g2(1,1) = 'a'
+   if (ichar(g2(1,1)) /= 97) call abort
+
+   i = ichar(c)      ! { dg-error "must be of length one" "" }
+   i = ichar(c(:))   ! { dg-error "must be of length one" "" }
+   i = ichar(s2)     ! { dg-error "must be of length one" "" }
+   i = ichar(c(1:2)) ! { dg-error "must be of length one" "" }
+   i = ichar(c(1:))  ! { dg-error "must be of length one" "" }
+   i = ichar('abc')  ! { dg-error "must be of length one" "" }
+
+   ! ichar and iachar use the same checking routines. DO a couple of tests to
+   ! make sure it's not totally broken.
+
+   if (ichar(c(3:3)) /= 97) call abort
+   i = ichar(c)      ! { dg-error "must be of length one" "" }
+   
+   i = ichar(dt%addr(1:1))
+   i = ichar(dt%addr) ! { dg-error "must be of length one" "" }
+   i = ichar(dt%addr(1:2)) ! { dg-error "must be of length one" "" }
+   i = ichar(dt%addr(1:)) ! { dg-error "must be of length one" "" }
+   
+   i = ichar(dt1%addr(1:1))
+   i = ichar(dt1%addr)
+
+
+   call test(g1(1))
+end program ichar_1
diff --git a/gcc/testsuite/gfortran.dg/ichar_2.f90 b/gcc/testsuite/gfortran.dg/ichar_2.f90
new file mode 100644
index 000000000..27b9ffcc4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ichar_2.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! Test char and ichar intrinsic functions
+Program test
+integer i
+
+if (ichar (char (0)) .ne. 0) call abort ()
+if (ichar (char (255)) .ne. 255) call abort ()
+if (ichar (char (127)) .ne. 127) call abort ()
+
+i = 0
+if (ichar (char (i)) .ne. i) call abort ()
+i = 255
+if (ichar (char (i)) .ne. i) call abort ()
+i = 127
+if (ichar (char (i)) .ne. i) call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/imag_1.f b/gcc/testsuite/gfortran.dg/imag_1.f
new file mode 100644
index 000000000..e8af92d22
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/imag_1.f
@@ -0,0 +1,11 @@
+! { dg-do compile }
+      program bug
+      implicit none
+      complex(kind=8) z
+      double precision x,y
+      z = cmplx(1.e0_8,2.e0_8)
+      y = imag(z)
+      y = imagpart(z)
+      x = realpart(z)
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/implicit_1.f90 b/gcc/testsuite/gfortran.dg/implicit_1.f90
new file mode 100644
index 000000000..85398ca20
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! PR 13575 -- we used to not see that c0 has no type, and then ICE later
+module AHFinder_dat 
+implicit none 
+save c0 ! { dg-error "no IMPLICIT type" "no IMPLICIT type" }
+end module AHFinder_dat
+! PR 15978 -- we used to not see that aaa has no type, and then ICE later
+implicit none
+common/rommel/aaa ! { dg-error "no IMPLICIT type" "no IMPLICIT type" }
+end
+
+! { dg-final { cleanup-modules "AHFinder_dat" } }
diff --git a/gcc/testsuite/gfortran.dg/implicit_10.f90 b/gcc/testsuite/gfortran.dg/implicit_10.f90
new file mode 100644
index 000000000..0f5094f42
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_10.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! Check fix for PR24783 where we did try to resolve the implicit type
+! from the wrong namespace thus rejecting valid code.
+      MODULE mod1
+      IMPLICIT NONE
+      CONTAINS
+      SUBROUTINE sub(vec, ny)
+      IMPLICIT REAL (a-h,o-z)
+      IMPLICIT INTEGER (i-n)
+      DIMENSION vec(ny)
+      ny = fun(vec(ny),1,1) 
+      RETURN
+      END SUBROUTINE sub
+      REAL FUNCTION fun(r1, i1, i2)
+      IMPLICIT REAL (r,f)
+      IMPLICIT INTEGER (i)
+      DIMENSION r1(i1:i2)
+      r1(i1) = i1 + 1
+      r1(i2) = i2 + 1
+      fun = r1(i1) + r1(i2)
+      END FUNCTION fun
+      END MODULE mod1
+
+      use mod1
+      IMPLICIT REAL (d)
+      INTEGER i
+      dimension di(5)
+      i = 1
+      if (fun(di(i),1,2).NE.5) call abort()
+      call sub(di(i),i)
+      if (i.NE.4) call abort()
+      end
+! { dg-final { cleanup-modules "mod1" } }
diff --git a/gcc/testsuite/gfortran.dg/implicit_11.f90 b/gcc/testsuite/gfortran.dg/implicit_11.f90
new file mode 100644
index 000000000..d33acd10a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_11.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! 
+! PR fortran/34760
+! The problem with implict typing is that it is unclear
+! whether an existing symbol is a variable or a function.
+! Thus it remains long FL_UNKNOWN, which causes extra 
+! problems; it was failing here since ISTAT was not
+! FL_VARIABLE but still FL_UNKNOWN.
+!
+! Test case contributed by Dick Hendrickson.
+!
+     MODULE TESTS
+       PRIVATE :: ISTAT
+       PUBLIC :: ISTAT2
+     CONTAINS
+     SUBROUTINE AD0001
+     REAL RLA1(:)
+     ALLOCATABLE RLA1
+     ISTAT = -314
+     ALLOCATE (RLA1(NF10), STAT = ISTAT)
+     ALLOCATE (RLA1(NF10), STAT = ISTAT2)
+     END SUBROUTINE
+     END MODULE
+
+     MODULE TESTS2
+       PRIVATE :: ISTAT2
+     CONTAINS
+     function istat2()
+       istat2 = 0
+     end function istat2
+     SUBROUTINE AD0001
+       REAL RLA1(:)
+       ALLOCATABLE RLA1
+       ALLOCATE (RLA1(NF10), STAT = ISTAT2) ! { dg-error "is not a variable" }
+     END SUBROUTINE
+     END MODULE tests2
+
+! { dg-final { cleanup-modules "TESTS" } }
diff --git a/gcc/testsuite/gfortran.dg/implicit_12.f90 b/gcc/testsuite/gfortran.dg/implicit_12.f90
new file mode 100644
index 000000000..3b47352d6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_12.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+!
+! PR fortran/37400
+!
+module mod 
+   implicit character(len=*,kind=kind('A')) (Q) 
+   parameter(Q1 = '12345678')     ! len=8
+   parameter(Q2 = 'abcdefghijkl') ! len=12
+   contains 
+      subroutine sub(Q3) 
+         if(len('#'//Q3//'#') /= 15) call abort()
+         if('#'//Q3//'#' /= '#ABCDEFGHIJKLM#') call abort()
+      end subroutine sub 
+end module mod 
+program startest 
+   use mod 
+   implicit none
+   if(len('#'//Q1//'#') /= 10) call abort()
+   if(len('#'//Q2//'#') /= 14) call abort()
+   if('#'//Q1//'#' /='#12345678#') call abort()
+   if('#'//Q2//'#' /='#abcdefghijkl#') call abort()
+   call sub('ABCDEFGHIJKLM') ! len=13
+end program startest
+
+! { dg-final { cleanup-modules "mod" } }
diff --git a/gcc/testsuite/gfortran.dg/implicit_13.f90 b/gcc/testsuite/gfortran.dg/implicit_13.f90
new file mode 100644
index 000000000..900725977
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_13.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+
+! PR fortran/35770
+! Implicit declaration hides type of internal function.
+
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+
+IMPLICIT CHARACTER (s)
+REAL :: RDA
+
+RDA = S_REAL_SQRT_I(42) ! { dg-bogus "Can't convert" }
+
+CONTAINS
+
+REAL FUNCTION S_REAL_SQRT_I(I) RESULT (R)
+  IMPLICIT NONE
+  INTEGER :: I
+  R = 0.0
+END FUNCTION S_REAL_SQRT_I
+
+END
diff --git a/gcc/testsuite/gfortran.dg/implicit_2.f90 b/gcc/testsuite/gfortran.dg/implicit_2.f90
new file mode 100644
index 000000000..4bff17840
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_2.f90
@@ -0,0 +1,50 @@
+! { dg-do compile }
+
+module implicit_2
+  ! This should cause an error if function types are resolved from the
+  ! module namespace.
+  implicit none
+  type t
+    integer i
+  end type
+contains
+! This caused an ICE because we were trying to apply the implicit type
+! after we had applied the explicit type.
+subroutine test()
+  implicit type (t) (v)
+  type (t) v1, v2
+  v1%i = 1
+  call foo (v2%i)
+end subroutine
+
+! A similar error because we failed to apply the implicit type to a function.
+! This is a contained function to check we lookup the type in the function
+! namespace, not it's parent.
+function f() result (val)
+  implicit type (t) (v)
+
+  val%i = 1
+end function
+
+! And again for a result variable.
+function fun()
+  implicit type (t) (f)
+
+  fun%i = 1
+end function
+
+! intrinsic types are resolved later than derived type, so check those as well.
+function test2()
+  implicit integer (t)
+  test2 = 42
+end function
+subroutine bar()
+  ! Check that implicit types are applied to names already known to be
+  ! variables.
+  implicit type(t) (v)
+  save v
+  v%i = 42
+end subroutine
+end module
+
+! { dg-final { cleanup-modules "implicit_2" } }
diff --git a/gcc/testsuite/gfortran.dg/implicit_3.f90 b/gcc/testsuite/gfortran.dg/implicit_3.f90
new file mode 100644
index 000000000..830b8611a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_3.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! Verify that INTERFACEs don't inherit the implicit types of the
+! surrounding namespace.
+implicit complex (i-k)
+
+interface
+   function f(k,l)
+     ! k should be default INTEGER 
+     dimension l(k)
+   end function f
+end interface
+end
diff --git a/gcc/testsuite/gfortran.dg/implicit_4.f90 b/gcc/testsuite/gfortran.dg/implicit_4.f90
new file mode 100644
index 000000000..2e871b09d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_4.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! Verify error diagnosis for invalid combinations of IMPLICIT statements
+IMPLICIT NONE
+IMPLICIT NONE ! { dg-error "Duplicate" }
+END
+
+SUBROUTINE a
+IMPLICIT REAL(b-j) ! { dg-error "cannot follow" }
+implicit none      ! { dg-error "cannot follow" }
+END SUBROUTINE a
+
+subroutine b
+implicit none
+implicit real(g-k) ! { dg-error "Cannot specify" }
+end subroutine b
+
+subroutine c
+implicit real(a-b)
+implicit integer (b-c) ! { dg-error "already" }
+implicit real(d-f), complex(f-g) ! { dg-error "already" }
+end subroutine c
diff --git a/gcc/testsuite/gfortran.dg/implicit_5.f90 b/gcc/testsuite/gfortran.dg/implicit_5.f90
new file mode 100644
index 000000000..fcfb6944d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_5.f90
@@ -0,0 +1,22 @@
+! PR fortran/21729
+! { dg-do compile }
+function f1 ()   ! { dg-error "has no IMPLICIT type" "f1" }
+   implicit none
+end function f1
+function f2 () result (r2) ! { dg-error "has no IMPLICIT type" "r2" }
+   implicit none
+end function f2
+function f3 ()   ! { dg-error "has no IMPLICIT type" "f3" }
+   implicit none
+entry e3 ()   ! { dg-error "has no IMPLICIT type" "e3" }
+end function f3
+function f4 ()
+   implicit none
+   real f4
+entry e4 ()   ! { dg-error "has no IMPLICIT type" "e4" }
+end function f4
+function f5 ()   ! { dg-error "has no IMPLICIT type" "f5" }
+   implicit none
+entry e5 ()
+   real e5
+end function f5
diff --git a/gcc/testsuite/gfortran.dg/implicit_6.f90 b/gcc/testsuite/gfortran.dg/implicit_6.f90
new file mode 100644
index 000000000..a74ecc29b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_6.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! PR 24643
+! substring references on implicitly typed CHARACTER variables didn't work
+        PROGRAM P
+        IMPLICIT CHARACTER*8 (Y)
+        YLOCAL='A'
+        YBTABLE=YLOCAL(1:2)
+        END
diff --git a/gcc/testsuite/gfortran.dg/implicit_7.f90 b/gcc/testsuite/gfortran.dg/implicit_7.f90
new file mode 100644
index 000000000..750d2454f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_7.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! PR 24643
+! This tests a case where the compiler used to ICE in an early
+! incarnation of the patch
+ylocal=1
+ybtable=ylocal(1:2)  ! { dg-error "Unclassifiable" }
+end
diff --git a/gcc/testsuite/gfortran.dg/implicit_8.f90 b/gcc/testsuite/gfortran.dg/implicit_8.f90
new file mode 100644
index 000000000..bdd11e615
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_8.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! PR 24748
+
+! The compiler used to crash trying to take a substring of an implicit 
+! real scalar.
+subroutine variant1
+ ybtable=ylocal(1:2)  ! { dg-error "Syntax error in argument list" }
+end
+
+! We want the behavior to be the same whether ylocal is implicitly 
+! or explicitly typed.
+subroutine variant2
+ real ylocal
+ ybtable=ylocal(1:2)  ! { dg-error "Syntax error in argument list" }
+end
+
diff --git a/gcc/testsuite/gfortran.dg/implicit_9.f90 b/gcc/testsuite/gfortran.dg/implicit_9.f90
new file mode 100644
index 000000000..04b7afa4e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_9.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! Tests patch for PR29373, in which the implicit character
+! statement messes up the function declaration because the
+! requisite functions in decl.c were told nothing about
+! implicit types.
+!
+! Contributed by Tobias Schlueter  <tobi@gcc.gnu.org>
+!
+  implicit character*32 (a-z)
+  CHARACTER(len=255), DIMENSION(1,2)  :: a
+
+! Reporters original, which triggers another error:
+! gfc_todo: Not Implemented: complex character array
+! constructors.=> PR29431
+!  a = reshape((/ to_string(1.0) /), (/ 1, 2 /))
+
+  a = to_string(1.0)
+  print *, a
+  CONTAINS
+    CHARACTER*(32) FUNCTION to_string(x)
+      REAL, INTENT(in) :: x
+      WRITE(to_string, FMT="(F6.3)") x
+    END FUNCTION
+END PROGRAM
diff --git a/gcc/testsuite/gfortran.dg/implicit_actual.f90 b/gcc/testsuite/gfortran.dg/implicit_actual.f90
new file mode 100644
index 000000000..750d3f385
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_actual.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! Tests patch for problem that was found whilst investigating
+! PR24158. The call to foo would cause an ICE because the
+! actual argument was of a type that was not defined.  The USE
+! GLOBAL was commented out, following the fix for PR29364.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+module global
+  type :: t2
+    type(t3), pointer :: d ! { dg-error "has not been declared" }
+  end type t2
+end module global
+
+program snafu
+!  use global
+  implicit type (t3) (z)
+
+  call foo (zin) ! { dg-error "defined|Type mismatch" }
+
+contains
+
+  subroutine foo (z)
+
+    type :: t3
+      integer :: i
+    end type t3
+
+    type(t3)  :: z
+    z%i = 1
+
+  end subroutine foo
+end program snafu
+
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/implicit_derived_type_1.f90 b/gcc/testsuite/gfortran.dg/implicit_derived_type_1.f90
new file mode 100644
index 000000000..baa36d1ba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_derived_type_1.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+
+! PR fortran/36746
+! Check that parsing of component references for symbols with IMPLICIT
+! derived-type works.
+
+! Reduced test from the PR.
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+module m
+  type t
+    integer :: i
+  end type t
+contains
+  subroutine s(x)
+    implicit type(t)(x)
+    dimension x(:)
+    print *, x(1)%i
+  end subroutine s
+end module m
diff --git a/gcc/testsuite/gfortran.dg/implicit_pure_1.f90 b/gcc/testsuite/gfortran.dg/implicit_pure_1.f90
new file mode 100644
index 000000000..d4a5a364e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_pure_1.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+!
+! PR fortran/51218
+!
+! Contributed by Harald Anlauf
+!
+
+module a
+  implicit none
+  integer :: neval = 0
+contains
+  subroutine inc_eval
+    neval = neval + 1
+  end subroutine inc_eval
+end module a
+
+module b
+  use a
+  implicit none
+contains
+  function f(x) ! Should be implicit pure
+    real :: f
+    real, intent(in) :: x
+    f = x
+  end function f
+
+  function g(x) ! Should NOT be implicit pure
+    real :: g
+    real, intent(in) :: x
+    call inc_eval
+    g = x
+  end function g
+end module b
+
+program gfcbug114a
+  use a
+  use b
+  implicit none
+  real :: x = 1, y = 1, t, u, v, w
+  if (neval /= 0) call abort ()
+  t = f(x)*f(y)
+  if (neval /= 0) call abort ()
+  u = f(x)*f(y) + f(x)*f(y)
+  if (neval /= 0) call abort ()
+  v = g(x)*g(y)
+  if (neval /= 2) call abort ()
+  w = g(x)*g(y) + g(x)*g(y)
+  if (neval /= 6) call abort ()
+  if (t /= 1.0 .or. u /= 2.0 .or. v /= 1.0 .or. w /= 2) call abort ()
+end program gfcbug114a
+
+! { dg-final { scan-module "b" "IMPLICIT_PURE" } }
+! { dg-final { cleanup-modules "b" } }
diff --git a/gcc/testsuite/gfortran.dg/implicit_pure_2.f90 b/gcc/testsuite/gfortran.dg/implicit_pure_2.f90
new file mode 100644
index 000000000..496e856e0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_pure_2.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! PR 51502 - this was wrongly detected to be implicit pure.
+module m
+  integer :: i
+contains
+  subroutine foo(x)
+    integer, intent(inout) :: x
+    outer: block
+      block
+        i = 5
+      end block
+    end block outer
+  end subroutine foo
+end module m
+
+! { dg-final { scan-module-absence "m" "IMPLICIT_PURE" } }
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/implicit_pure_3.f90 b/gcc/testsuite/gfortran.dg/implicit_pure_3.f90
new file mode 100644
index 000000000..d9d7734da
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_pure_3.f90
@@ -0,0 +1,109 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-optimized" }
+!
+! PR fortran/54556
+!
+! Contributed by Joost VandeVondele
+!
+MODULE parallel_rng_types
+
+  IMPLICIT NONE
+
+  ! Global parameters in this module
+  INTEGER, PARAMETER :: dp=8
+
+  TYPE rng_stream_type
+    PRIVATE
+    CHARACTER(LEN=40)             :: name
+    INTEGER                       :: distribution_type
+    REAL(KIND=dp), DIMENSION(3,2) :: bg,cg,ig
+    LOGICAL                       :: antithetic,extended_precision
+    REAL(KIND=dp)                 :: buffer
+    LOGICAL                       :: buffer_filled
+  END TYPE rng_stream_type
+
+  REAL(KIND=dp), DIMENSION(3,3) :: a1p0,a1p76,a1p127,&
+                                   a2p0,a2p76,a2p127,&
+                                   inv_a1,inv_a2
+
+  INTEGER, PARAMETER          :: GAUSSIAN = 1,&
+                                 UNIFORM  = 2
+
+  REAL(KIND=dp), PARAMETER :: norm  = 2.328306549295727688e-10_dp,&
+                              m1    = 4294967087.0_dp,&
+                              m2    = 4294944443.0_dp,&
+                              a12   = 1403580.0_dp,&
+                              a13n  = 810728.0_dp,&
+                              a21   = 527612.0_dp,&
+                              a23n  = 1370589.0_dp,&
+                              two17 = 131072.0_dp,&            ! 2**17
+                              two53 = 9007199254740992.0_dp,&  ! 2**53
+                              fact  = 5.9604644775390625e-8_dp ! 1/2**24
+
+
+CONTAINS
+
+  FUNCTION rn32(rng_stream) RESULT(u)
+
+    TYPE(rng_stream_type), POINTER           :: rng_stream
+    REAL(KIND=dp)                            :: u
+
+    INTEGER                                  :: k
+    REAL(KIND=dp)                            :: p1, p2
+
+! -------------------------------------------------------------------------
+! Component 1
+
+    p1 = a12*rng_stream%cg(2,1) - a13n*rng_stream%cg(1,1)
+    k = INT(p1/m1)
+    p1 = p1 - k*m1
+    IF (p1 < 0.0_dp) p1 = p1 + m1
+    rng_stream%cg(1,1) = rng_stream%cg(2,1)
+    rng_stream%cg(2,1) = rng_stream%cg(3,1)
+    rng_stream%cg(3,1) = p1
+
+    ! Component 2
+
+    p2 = a21*rng_stream%cg(3,2) - a23n*rng_stream%cg(1,2)
+    k = INT(p2/m2)
+    p2 = p2 - k*m2
+    IF (p2 < 0.0_dp) p2 = p2 + m2
+    rng_stream%cg(1,2) = rng_stream%cg(2,2)
+    rng_stream%cg(2,2) = rng_stream%cg(3,2)
+    rng_stream%cg(3,2) = p2
+
+    ! Combination
+
+    IF (p1 > p2) THEN
+      u = (p1 - p2)*norm
+    ELSE
+      u = (p1 - p2 + m1)*norm
+    END IF
+
+    IF (rng_stream%antithetic) u = 1.0_dp - u
+
+  END FUNCTION rn32
+
+! *****************************************************************************
+  FUNCTION rn53(rng_stream) RESULT(u)
+
+    TYPE(rng_stream_type), POINTER           :: rng_stream
+    REAL(KIND=dp)                            :: u
+
+    u = rn32(rng_stream)
+
+    IF (rng_stream%antithetic) THEN
+      u = u + (rn32(rng_stream) - 1.0_dp)*fact
+      IF (u < 0.0_dp) u = u + 1.0_dp
+    ELSE
+      u = u + rn32(rng_stream)*fact
+      IF (u >= 1.0_dp) u = u - 1.0_dp
+    END IF
+
+  END FUNCTION rn53
+
+END MODULE
+
+! { dg-final { scan-module-absence "parallel_rng_types" "IMPLICIT_PURE" } }
+! { dg-final { scan-tree-dump-times "rn32 \\(rng_stream" 3 "optimized" } }
+! { dg-final { cleanup-tree-dump "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/implied_do_1.f90 b/gcc/testsuite/gfortran.dg/implied_do_1.f90
new file mode 100644
index 000000000..d837e8f9f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implied_do_1.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! PR fortran/29458 - spurious warning for implied do-loop counter
+
+  integer :: n, i
+  i = 10
+  n = 5
+  n = SUM((/(i,i=1,n)/))
+
+  ! 'i' must not be changed
+  IF (i /= 10) CALL abort()
+END
diff --git a/gcc/testsuite/gfortran.dg/implied_shape_1.f08 b/gcc/testsuite/gfortran.dg/implied_shape_1.f08
new file mode 100644
index 000000000..07a1ce835
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implied_shape_1.f08
@@ -0,0 +1,37 @@
+! { dg-do run }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+
+! Test for correct semantics of implied-shape arrays.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  INTEGER, PARAMETER :: n = 3
+
+  ! Should be able to reduce complex expressions.
+  REAL, PARAMETER :: arr1(n:*) = SQRT ((/ 1.0, 2.0, 3.0 /)) + 42
+
+  ! With dimension statement.
+  REAL, DIMENSION(*), PARAMETER :: arr2 = arr1
+
+  ! Rank > 1.
+  INTEGER, PARAMETER :: arr3(n:*, *) = RESHAPE ((/ 1, 2, 3, 4 /), (/ 2, 2/))
+
+  ! Character array.
+  CHARACTER(LEN=*), PARAMETER :: arr4(*) = (/ CHARACTER(LEN=3) :: "ab", "cde" /)
+
+  IF (LBOUND (arr1, 1) /= n .OR. UBOUND (arr1, 1) /= n + 2) CALL abort ()
+  IF (SIZE (arr1) /= 3) CALL abort ()
+
+  IF (LBOUND (arr2, 1) /= 1 .OR. UBOUND (arr2, 1) /= 3) CALL abort ()
+  IF (SIZE (arr2) /= 3) CALL abort ()
+
+  IF (ANY (LBOUND (arr3) /= (/ n, 1 /) .OR. UBOUND (arr3) /= (/ n + 1, 2 /))) &
+    CALL abort ()
+  IF (SIZE (arr3) /= 4) CALL abort ()
+
+  IF (LBOUND (arr4, 1) /= 1 .OR. UBOUND (arr4, 1) /= 2) CALL abort ()
+  IF (SIZE (arr4) /= 2) CALL abort ()
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/implied_shape_2.f90 b/gcc/testsuite/gfortran.dg/implied_shape_2.f90
new file mode 100644
index 000000000..a6e11f558
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implied_shape_2.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! Test for rejection of implied-shape prior to Fortran 2008.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER, PARAMETER :: arr(*) = (/ 2, 3, 4 /) ! { dg-error "Fortran 2008" }
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/implied_shape_3.f08 b/gcc/testsuite/gfortran.dg/implied_shape_3.f08
new file mode 100644
index 000000000..6cf13bb40
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implied_shape_3.f08
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+
+! Test for errors with implied-shape declarations.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  INTEGER :: n
+  INTEGER, PARAMETER :: mat(2, 2) = RESHAPE ((/ 1, 2, 3, 4 /), (/ 2, 2 /))
+
+  ! Malformed declaration.
+  INTEGER, PARAMETER :: arr1(*, *, 5) = mat ! { dg-error "Bad array specification for implied-shape array" }
+
+  ! Rank mismatch in initialization.
+  INTEGER, PARAMETER :: arr2(*, *) = (/ 1, 2, 3, 4 /) ! { dg-error "Incompatible ranks" }
+
+  ! Non-PARAMETER implied-shape, with and without initializer.
+  INTEGER :: arr3(*, *) ! { dg-error "Non-PARAMETER" }
+  INTEGER :: arr4(*, *) = mat ! { dg-error "Non-PARAMETER" }
+
+  ! Missing initializer.
+  INTEGER, PARAMETER :: arr5(*) ! { dg-error "is missing an initializer" }
+
+  ! Initialization from scalar.
+  INTEGER, PARAMETER :: arr6(*) = 0 ! { dg-error "with scalar" }
+
+  ! Automatic bounds.
+  n = 2
+  BLOCK
+    INTEGER, PARAMETER :: arr7(n:*) = (/ 2, 3, 4 /) ! { dg-error "Non-constant lower bound" }
+  END BLOCK
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/import.f90 b/gcc/testsuite/gfortran.dg/import.f90
new file mode 100644
index 000000000..521f87222
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/import.f90
@@ -0,0 +1,78 @@
+! { dg-do run }
+! Test whether import works
+! PR fortran/29601
+
+subroutine test(x)
+  type myType3
+    sequence
+    integer :: i
+  end type myType3
+  type(myType3) :: x
+  if(x%i /= 7) call abort()
+  x%i = 1
+end subroutine test
+
+
+subroutine bar(x,y)
+  type myType
+    sequence
+    integer :: i
+  end type myType
+  type(myType) :: x
+  integer(8) :: y
+  if(y /= 8) call abort()
+  if(x%i /= 2) call abort()
+  x%i = 5
+  y = 42
+end subroutine bar
+
+module testmod
+  implicit none
+  integer, parameter :: kind = 8
+  type modType
+    real :: rv
+  end type modType
+  interface
+    subroutine other(x,y)
+       import
+       real(kind)    :: x
+       type(modType) :: y
+    end subroutine
+  end interface
+end module testmod
+
+program foo
+  integer, parameter :: dp = 8
+  type myType
+    sequence
+    integer :: i
+  end type myType
+  type myType3
+    sequence
+    integer :: i
+  end type myType3
+  interface
+    subroutine bar(x,y)
+      import
+      type(myType) :: x
+      integer(dp)     :: y
+    end subroutine bar
+    subroutine test(x)
+      import :: myType3
+      import myType3 ! { dg-warning "already IMPORTed from" }
+      type(myType3) :: x
+    end subroutine test
+  end interface
+
+  type(myType) :: y
+  type(myType3) :: z
+  integer(8) :: i8
+  y%i = 2
+  i8 = 8
+  call bar(y,i8)
+  if(y%i /= 5 .or. i8/= 42) call abort()
+  z%i = 7
+  call test(z)
+  if(z%i /= 1) call abort()
+end program foo
+! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/import2.f90 b/gcc/testsuite/gfortran.dg/import2.f90
new file mode 100644
index 000000000..4a0128a0b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/import2.f90
@@ -0,0 +1,80 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! { dg-shouldfail "Fortran 2003 feature with -std=f95" }
+! Test whether import does not work with -std=f95
+! PR fortran/29601
+
+subroutine test(x)
+  type myType3
+    sequence
+    integer :: i
+  end type myType3
+  type(myType3) :: x
+  if(x%i /= 7) call abort()
+  x%i = 1
+end subroutine test
+
+
+subroutine bar(x,y)
+  type myType
+    sequence
+    integer :: i
+  end type myType
+  type(myType) :: x
+  integer(8) :: y
+  if(y /= 8) call abort()
+  if(x%i /= 2) call abort()
+  x%i = 5
+  y   = 42
+end subroutine bar
+
+module testmod
+  implicit none
+  integer, parameter :: kind = 8
+  type modType
+    real :: rv
+  end type modType
+  interface
+    subroutine other(x,y)
+      import ! { dg-error "Fortran 2003: IMPORT statement" }
+      type(modType) :: y ! { dg-error "not been declared within the interface" }
+      real(kind)    :: x ! { dg-error "has not been declared" }
+    end subroutine
+  end interface
+end module testmod
+
+program foo
+  integer, parameter :: dp = 8
+  type myType
+    sequence
+    integer :: i
+  end type myType
+  type myType3
+    sequence
+    integer :: i
+  end type myType3
+  interface
+    subroutine bar(x,y)
+      import ! { dg-error "Fortran 2003: IMPORT statement" }
+      type(myType) :: x ! { dg-error "not been declared within the interface" }
+      integer(dp)  :: y ! { dg-error "has not been declared" }
+    end subroutine bar
+    subroutine test(x)
+      import :: myType3 ! { dg-error "Fortran 2003: IMPORT statement" }
+      import myType3 ! { dg-error "Fortran 2003: IMPORT statement" }
+      type(myType3) :: x ! { dg-error "not been declared within the interface" }
+    end subroutine test
+  end interface
+
+  type(myType) :: y
+  type(myType3) :: z
+  integer(dp) :: i8
+  y%i = 2
+  i8 = 8
+  call bar(y,i8) ! { dg-error "Type mismatch in argument" }
+  if(y%i /= 5 .or. i8/= 42) call abort()
+  z%i = 7
+  call test(z) ! { dg-error "Type mismatch in argument" }
+  if(z%i /= 1) call abort()
+end program foo
+! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/import3.f90 b/gcc/testsuite/gfortran.dg/import3.f90
new file mode 100644
index 000000000..74cd5279b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/import3.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-shouldfail "Invalid use of IMPORT" }
+! Test invalid uses of import
+! PR fortran/29601
+
+subroutine test()
+  type myType3
+    import ! { dg-error "only permitted in an INTERFACE body" }
+    sequence
+    integer :: i
+  end type myType3
+end subroutine test
+
+program foo
+  import ! { dg-error "only permitted in an INTERFACE body" }
+  type myType
+    sequence
+    integer :: i
+  end type myType
+  type myType3
+    sequence
+    integer :: i
+  end type myType3
+  interface
+    import ! { dg-error "only permitted in an INTERFACE body" }
+    subroutine bar()
+      import foob ! { dg-error "Cannot IMPORT 'foob' from host scoping unit" }
+    end subroutine bar
+    subroutine test()
+      import :: ! { dg-error "Expecting list of named entities" }
+    end subroutine test
+  end interface
+end program foo
diff --git a/gcc/testsuite/gfortran.dg/import4.f90 b/gcc/testsuite/gfortran.dg/import4.f90
new file mode 100644
index 000000000..761c9846b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/import4.f90
@@ -0,0 +1,99 @@
+! { dg-do run }
+! Test for import in modules
+! PR fortran/29601
+
+subroutine bar(r)
+  implicit none
+  integer(8) :: r
+  if(r /= 42) call abort()
+  r = 13
+end subroutine bar
+
+subroutine foo(a)
+  implicit none
+  type myT
+     sequence
+     character(len=3) :: c
+  end type myT
+  type(myT) :: a
+  if(a%c /= "xyz") call abort()
+  a%c = "abc"
+end subroutine
+
+subroutine new(a,b)
+  implicit none
+  type gType
+     sequence
+     integer(8) :: c
+  end type gType
+  real(8) :: a
+  type(gType) :: b
+  if(a /= 99.0 .or. b%c /= 11) call abort()
+  a = -123.0
+  b%c = -44
+end subroutine new
+
+module general
+  implicit none
+  integer,parameter :: ikind = 8
+  type gType
+     sequence
+     integer(ikind) :: c
+  end type gType
+end module general
+
+module modtest
+  use general
+  implicit none
+  type myT
+     sequence
+     character(len=3) :: c
+  end type myT
+  integer, parameter :: dp = 8
+  interface
+     subroutine bar(x)
+       import :: dp
+       integer(dp) :: x
+     end subroutine bar
+     subroutine foo(c)
+      import :: myT
+       type(myT) :: c
+     end subroutine foo
+     subroutine new(x,y)
+      import :: ikind,gType
+      real(ikind) :: x
+      type(gType) :: y
+     end subroutine new
+  end interface
+  contains
+  subroutine test
+    integer(dp) :: y
+    y = 42
+    call bar(y)
+    if(y /= 13) call abort()
+  end subroutine test
+  subroutine test2()
+    type(myT) :: z
+    z%c = "xyz"
+    call foo(z)
+    if(z%c /= "abc") call abort()
+  end subroutine test2
+end module modtest
+
+program all
+  use modtest
+  implicit none
+  call test()
+  call test2()
+  call test3()
+contains
+  subroutine test3()
+    real(ikind) :: r
+    type(gType) :: t
+    r   = 99.0
+    t%c = 11
+    call new(r,t)
+    if(r /= -123.0 .or. t%c /= -44) call abort()
+  end subroutine test3
+end program all
+! { dg-final { cleanup-modules "modtest general" } }
diff --git a/gcc/testsuite/gfortran.dg/import5.f90 b/gcc/testsuite/gfortran.dg/import5.f90
new file mode 100644
index 000000000..0106c4ec1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/import5.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! Test for import in interfaces PR fortran/30922
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module test_import
+  implicit none
+
+  type :: my_type
+     integer :: data
+  end type my_type
+  integer, parameter :: n = 20
+
+  interface
+     integer function func1(param)
+       import
+       type(my_type) :: param(n)
+     end function func1
+
+     integer function func2(param)
+       import :: my_type
+       type(my_type), value :: param
+     end function func2
+  end interface
+
+contains
+
+  subroutine sub1 ()
+
+    interface
+      integer function func3(param)
+        import
+        type(my_type), dimension (n) :: param
+      end function func3
+
+      integer function func4(param)
+        import :: my_type, n
+        type(my_type), dimension (n) :: param
+      end function func4
+    end interface
+
+  end subroutine sub1
+end module test_import
+! { dg-final { cleanup-modules "test_import" } }
diff --git a/gcc/testsuite/gfortran.dg/import6.f90 b/gcc/testsuite/gfortran.dg/import6.f90
new file mode 100644
index 000000000..1bf9669c5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/import6.f90
@@ -0,0 +1,46 @@
+! { dg-do compile }

+! Tests the fix for PR32827, in which IMPORT :: my_type put the

+! symbol into the interface namespace, thereby generating an error

+! when the declaration of 'x' is compiled.

+!

+! Contributed by Douglas Wells <sysmaint@contek.com>

+!

+subroutine func1(param)

+  type :: my_type

+    integer :: data

+  end type my_type

+  type(my_type) :: param

+  param%data = 99

+end subroutine func1

+

+subroutine func2(param)

+  type :: my_type

+    integer :: data

+  end type my_type

+  type(my_type) :: param

+  param%data = 21

+end subroutine func2

+

+  type :: my_type

+    integer :: data

+  end type my_type

+

+  interface

+    subroutine func1(param)

+      import :: my_type

+      type(my_type) :: param

+    end subroutine func1

+  end interface

+  interface

+    subroutine func2(param)

+      import

+      type(my_type) :: param

+    end subroutine func2

+  end interface

+

+  type(my_type) :: x

+  call func1(x)

+  print *, x%data

+  call func2(x)

+  print *, x%data

+end

diff --git a/gcc/testsuite/gfortran.dg/import7.f90 b/gcc/testsuite/gfortran.dg/import7.f90
new file mode 100644
index 000000000..c115cc3f2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/import7.f90
@@ -0,0 +1,58 @@
+! { dg-do compile }
+!
+! PR39688: IMPORT of derived type fails
+!
+! Contributed by Bob Corbett <robert.corbett@sun.com>
+
+       MODULE MOD
+         TYPE T1
+           SEQUENCE
+           TYPE(T2), POINTER :: P
+         END TYPE
+         TYPE T2
+           SEQUENCE
+           INTEGER I
+         END TYPE
+       END
+
+       PROGRAM MAIN
+         USE MOD, T3 => T1, T4 => T2
+         TYPE T1
+           SEQUENCE
+           TYPE(T2), POINTER :: P
+         END TYPE
+         INTERFACE SUBR
+           SUBROUTINE SUBR1(X)
+             IMPORT T3
+             TYPE(T3) X
+           END SUBROUTINE
+           SUBROUTINE SUBR2(X)
+             IMPORT T1
+             TYPE(T1) X
+           END SUBROUTINE
+         END INTERFACE
+         TYPE T2
+           SEQUENCE
+           REAL X
+         END TYPE
+       END
+
+       SUBROUTINE SUBR1(X)
+         USE MOD
+         TYPE(T1) X
+       END
+
+       SUBROUTINE SUBR2(X)
+         TYPE T1
+           SEQUENCE
+           TYPE(T2), POINTER :: P
+         END TYPE
+         TYPE T2
+           SEQUENCE
+           REAL X
+         END TYPE
+         TYPE(T1) X
+       END
+
+! { dg-final { cleanup-modules "mod" } }
+
diff --git a/gcc/testsuite/gfortran.dg/import8.f90 b/gcc/testsuite/gfortran.dg/import8.f90
new file mode 100644
index 000000000..0d88e625b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/import8.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+!
+! PR fortran/44614
+!
+!
+
+implicit none
+
+type, abstract :: Connection
+end type Connection
+
+abstract interface
+    subroutine generic_desc(self)
+        ! <<< missing IMPORT 
+        class(Connection) :: self ! { dg-error "has not been declared within the interface" }
+    end subroutine generic_desc
+end interface
+end
diff --git a/gcc/testsuite/gfortran.dg/impure_1.f08 b/gcc/testsuite/gfortran.dg/impure_1.f08
new file mode 100644
index 000000000..9d09eaa4c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/impure_1.f08
@@ -0,0 +1,71 @@
+! { dg-do run }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+
+! PR fortran/45197
+! Check that IMPURE and IMPURE ELEMENTAL in particular works.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+MODULE m
+  IMPLICIT NONE
+
+  INTEGER, PARAMETER :: n = 5
+
+  INTEGER :: i
+  INTEGER :: arr(n)
+
+CONTAINS
+
+  ! This ought to work (without any effect).
+  IMPURE SUBROUTINE foobar ()
+  END SUBROUTINE foobar
+
+  IMPURE ELEMENTAL SUBROUTINE impureSub (a)
+    INTEGER, INTENT(IN) :: a
+
+    arr(i) = a
+    i = i + 1
+
+    PRINT *, a
+  END SUBROUTINE impureSub
+
+END MODULE m
+
+PROGRAM main
+  USE :: m
+  IMPLICIT NONE
+
+  INTEGER :: a(n), b(n), s
+
+  a = (/ (i, i = 1, n) /)
+
+  ! Traverse in forward order.
+  s = 0
+  b = accumulate (a, s)
+  IF (ANY (b /= (/ 1, 3, 6, 10, 15 /))) CALL abort ()
+
+  ! And now backward.
+  s = 0
+  b = accumulate (a(n:1:-1), s)
+  IF (ANY (b /= (/ 5, 9, 12, 14, 15 /))) CALL abort ()
+
+  ! Use subroutine.
+  i = 1
+  arr = 0
+  CALL impureSub (a)
+  IF (ANY (arr /= a)) CALL abort ()
+
+CONTAINS
+
+  IMPURE ELEMENTAL FUNCTION accumulate (a, s)
+    INTEGER, INTENT(IN) :: a
+    INTEGER, INTENT(INOUT) :: s
+    INTEGER :: accumulate
+    
+    s = s + a
+    accumulate = s
+  END FUNCTION accumulate
+
+END PROGRAM main
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/impure_2.f08 b/gcc/testsuite/gfortran.dg/impure_2.f08
new file mode 100644
index 000000000..4bc2ca1fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/impure_2.f08
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+
+! PR fortran/45197
+! Check for errors with IMPURE.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+MODULE m
+  IMPLICIT NONE
+
+CONTAINS
+
+  IMPURE PURE SUBROUTINE foobar () ! { dg-error "must not appear both" }
+
+  PURE ELEMENTAL IMPURE FUNCTION xyz () ! { dg-error "must not appear both" }
+
+  IMPURE ELEMENTAL SUBROUTINE mysub ()
+  END SUBROUTINE mysub
+
+  PURE SUBROUTINE purified ()
+    CALL mysub () ! { dg-error "is not PURE" }
+  END SUBROUTINE purified
+
+END MODULE m
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/impure_3.f90 b/gcc/testsuite/gfortran.dg/impure_3.f90
new file mode 100644
index 000000000..1c0d44428
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/impure_3.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! PR fortran/45197
+! Check that IMPURE gets rejected without F2008.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+IMPURE SUBROUTINE foobar () ! { dg-error "Fortran 2008" }
+
+IMPURE ELEMENTAL FUNCTION xyz () ! { dg-error "Fortran 2008" }
diff --git a/gcc/testsuite/gfortran.dg/impure_actual_1.f90 b/gcc/testsuite/gfortran.dg/impure_actual_1.f90
new file mode 100644
index 000000000..43711d421
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/impure_actual_1.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! Tests the fix for PR25056 in which a non-PURE procedure could be
+! passed as the actual argument to a PURE procedure.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+MODULE M1
+CONTAINS
+ FUNCTION L()
+  L=1
+ END FUNCTION L
+ PURE FUNCTION J(K)
+   INTERFACE
+     PURE FUNCTION K()
+     END FUNCTION K
+   END INTERFACE
+   J=K()
+ END FUNCTION J
+END MODULE M1
+USE M1
+ write(6,*) J(L) ! { dg-error "Expected a PURE procedure for argument" }
+END
+
+! { dg-final { cleanup-modules "M1" } }
+
diff --git a/gcc/testsuite/gfortran.dg/impure_assignment_1.f90 b/gcc/testsuite/gfortran.dg/impure_assignment_1.f90
new file mode 100644
index 000000000..6a1660c38
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/impure_assignment_1.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! Tests fix for PR25059, which gave and ICE after error message  
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+MODULE M1
+ TYPE T1
+  INTEGER :: I
+ END TYPE T1
+ INTERFACE ASSIGNMENT(=)
+   MODULE PROCEDURE S1
+ END INTERFACE
+CONTAINS
+   SUBROUTINE S1(I,J)
+     TYPE(T1), INTENT(OUT):: I
+     TYPE(T1), INTENT(IN) :: J
+     I%I=J%I**2
+   END SUBROUTINE S1
+END MODULE M1
+
+USE M1
+CONTAINS
+PURE SUBROUTINE S2(I,J)
+     TYPE(T1), INTENT(OUT):: I
+     TYPE(T1), INTENT(IN) :: J
+     I=J                      ! { dg-error "is not PURE" }
+END SUBROUTINE S2
+END
+! { dg-final { cleanup-modules "M1" } }
+
diff --git a/gcc/testsuite/gfortran.dg/impure_assignment_2.f90 b/gcc/testsuite/gfortran.dg/impure_assignment_2.f90
new file mode 100644
index 000000000..6378ec8a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/impure_assignment_2.f90
@@ -0,0 +1,70 @@
+! { dg-do compile }
+! Tests the fix for PR20863 and PR20882, which were concerned with incorrect
+! application of constraints associated with "impure" variables in PURE
+! procedures.
+!
+! resolve.c (gfc_impure_variable) detects the following: 
+! 12.6 Constraint: In a pure subprogram any variable which is in common or
+! accessed by host or use association, is a dummy argument to a pure function,
+! is a dummy argument with INTENT (IN) to a pure subroutine, or an object that
+! is storage associated with any such variable, shall not be used in the
+! following contexts: (clients of this function).  */
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+MODULE pr20863
+ TYPE node_type
+  TYPE(node_type), POINTER :: next=>null()
+ END TYPE
+CONTAINS
+! Original bug - pointer assignments to "impure" derived type with
+! pointer component.
+  PURE FUNCTION give_next1(node)
+     TYPE(node_type), POINTER :: node
+     TYPE(node_type), POINTER :: give_next
+     give_next => node%next ! { dg-error "Bad target" }
+     node%next => give_next ! { dg-error "variable definition context" }
+  END FUNCTION
+! Comment #2
+  PURE integer FUNCTION give_next2(i)
+     TYPE node_type
+       sequence
+       TYPE(node_type), POINTER :: next
+     END TYPE
+     TYPE(node_type), POINTER :: node
+     TYPE(node_type), target  :: t
+     integer, intent(in)      :: i
+     node%next = t          ! This is OK
+     give_next2 = i
+  END FUNCTION
+  PURE FUNCTION give_next3(node)
+     TYPE(node_type), intent(in) :: node
+     TYPE(node_type) :: give_next
+     give_next = node ! { dg-error "impure variable" }
+  END FUNCTION
+END MODULE pr20863
+
+MODULE pr20882
+  TYPE T1
+    INTEGER :: I
+  END TYPE T1
+  TYPE(T1), POINTER :: B
+CONTAINS
+  PURE FUNCTION TST(A) RESULT(RES)
+    TYPE(T1), INTENT(IN), TARGET :: A
+    TYPE(T1), POINTER :: RES
+    RES => A  ! { dg-error "Bad target" }
+    RES => B  ! { dg-error "Bad target" }
+    B => RES  ! { dg-error "variable definition context" }
+  END FUNCTION
+  PURE FUNCTION TST2(A) RESULT(RES)
+    TYPE(T1), INTENT(IN), TARGET :: A
+    TYPE(T1), POINTER :: RES
+    allocate (RES)
+    RES = A
+    B = RES  ! { dg-error "variable definition context" }
+    RES = B
+  END FUNCTION
+END MODULE pr20882
+! { dg-final { cleanup-modules "pr20863 pr20882" } }
+
diff --git a/gcc/testsuite/gfortran.dg/impure_assignment_3.f90 b/gcc/testsuite/gfortran.dg/impure_assignment_3.f90
new file mode 100644
index 000000000..8be19896e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/impure_assignment_3.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+!
+! PR 43169: [OOP] gfortran rejects PURE procedure with SELECT TYPE construct
+!
+! Original test case by Todd Hay <haymaker@mail.utexas.edu>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+  implicit none
+  real :: g
+
+contains
+
+  pure subroutine sub1(x)
+    type :: myType
+      real :: a
+    end type myType
+    class(myType), intent(inout) :: x
+    real :: r3
+    select type(x)
+    class is (myType)
+      x%a = 42.
+      r3 =  43.
+      g = 44.             ! { dg-error "variable definition context" }
+    end select
+  end subroutine
+
+  pure subroutine sub2
+    real :: r1
+    block
+      real :: r2
+      r1 = 45.
+      r2 = 46.
+      g = 47.             ! { dg-error "variable definition context" }
+    end block
+  end subroutine
+
+  pure subroutine sub3
+    block
+      integer, save :: i  ! { dg-error "cannot be specified in a PURE procedure" }
+      integer :: j = 5    ! { dg-error "is not allowed in a PURE procedure" }
+    end block
+  end subroutine
+
+end
diff --git a/gcc/testsuite/gfortran.dg/impure_constructor_1.f90 b/gcc/testsuite/gfortran.dg/impure_constructor_1.f90
new file mode 100644
index 000000000..6657213d7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/impure_constructor_1.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+!
+! PR fortran/43362
+!
+module m
+  implicit none
+  type t
+    integer, pointer :: a
+  end type t
+  type t2
+    type(t) :: b
+  end type t2
+  type t3
+    type(t), pointer :: b
+  end type t3
+contains
+ pure subroutine foo(x)
+   type(t), target, intent(in) :: x
+   type(t2) :: y
+   type(t3) :: z
+
+   ! The following gave an ICE but is valid:
+   y = t2(x) ! Note: F2003, C1272 (3) and (4) do not apply
+   
+   ! Variant which is invalid as C1272 (3) applies
+   z = t3(x) ! { dg-error "Invalid expression in the derived type constructor" }
+ end subroutine foo
+end module m
+
+
diff --git a/gcc/testsuite/gfortran.dg/impure_spec_expr_1.f90 b/gcc/testsuite/gfortran.dg/impure_spec_expr_1.f90
new file mode 100644
index 000000000..8c42a57c4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/impure_spec_expr_1.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! Checks the fix for PR33664, in which the apparent function reference
+! n(1) caused a seg-fault.
+!
+! Contributed by Henrik Holst <holst@matmech.com>
+!
+module test
+contains
+  subroutine func_1(u,n)
+    integer :: n
+    integer :: u(n(1))  ! { dg-error "must be PURE" }
+  end subroutine
+end module test
+! { dg-final { cleanup-modules "test" } }
+
diff --git a/gcc/testsuite/gfortran.dg/in_pack_rank7.f90 b/gcc/testsuite/gfortran.dg/in_pack_rank7.f90
new file mode 100644
index 000000000..aa6286689
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/in_pack_rank7.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! PR 21354:  Rank 7 was not handled correctly by many library
+!            functions, including in_pack.
+program main
+  real, dimension (2,2,2,2,2,2,2):: a
+  a = 1.0
+  call foo(a(2:1:-1,:,:,:,:,:,:))
+end program main
+
+subroutine foo(a)
+  real, dimension (2,2,2,2,2,2,2):: a
+end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/include_1.f90 b/gcc/testsuite/gfortran.dg/include_1.f90
new file mode 100644
index 000000000..34741ea64
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/include_1.f90
@@ -0,0 +1,9 @@
+! PR debug/33739
+! { dg-do compile }
+! { dg-options "-g3" }
+subroutine a
+include 'include_1.inc'
+end subroutine a
+subroutine b
+include 'include_1.inc'
+end subroutine b
diff --git a/gcc/testsuite/gfortran.dg/include_1.inc b/gcc/testsuite/gfortran.dg/include_1.inc
new file mode 100644
index 000000000..332ac8ccd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/include_1.inc
@@ -0,0 +1 @@
+integer :: i
diff --git a/gcc/testsuite/gfortran.dg/include_2.f90 b/gcc/testsuite/gfortran.dg/include_2.f90
new file mode 100644
index 000000000..e4f553efa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/include_2.f90
@@ -0,0 +1,29 @@
+# 1 "include_2.F90"
+# 1 "/tmp/"
+# 1 "<built-in>"
+# 1 "<command line>"
+# 1 "include_2.F90"
+#define S1 1
+#define B a
+# 1 "include_2.inc" 1
+subroutine a
+#undef S2
+#define S2 1
+integer :: i
+end subroutine a
+# 4 "include_2.F90" 2
+#undef B
+#define B b
+# 1 "include_2.inc" 1
+subroutine b
+#undef S2
+#define S2 1
+integer :: i
+end subroutine b
+# 6 "include_2.F90" 2
+! PR debug/33739
+! { dg-do link }
+! { dg-options "-fpreprocessed -g3" }
+    call a
+    call b
+end
diff --git a/gcc/testsuite/gfortran.dg/include_3.f95 b/gcc/testsuite/gfortran.dg/include_3.f95
new file mode 100644
index 000000000..fba07cbb1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/include_3.f95
@@ -0,0 +1,26 @@
+# 1 "../../../trunk/libgfortran/generated/_abs_c4.F90"
+# 1 "C:\\msys\\1.0.10\\home\\FX\\ibin\\i586-pc-mingw32\\libgfortran//"
+# 1 "<built-in>"
+# 1 "<command-line>"
+# 1 "../../../trunk/libgfortran/generated/_abs_c4.F90"
+!   Comment here
+
+# 1 "./config.h" 1
+
+# 37 "../../../trunk/libgfortran/generated/_abs_c4.F90" 2
+
+# 1 "./kinds.inc" 1
+# 38 "../../../trunk/libgfortran/generated/_abs_c4.F90" 2
+
+# 1 "./c99_protos.inc" 1
+# 39 "../../../trunk/libgfortran/generated/_abs_c4.F90" 2
+
+elemental function abs_c4 (parm)
+   complex (kind=4), intent (in) :: parm
+   real (kind=4) :: abs_c4
+
+   abs_c4 = abs (parm)
+end function
+
+! { dg-do compile }
+! { dg-options "-fpreprocessed -g3" }
diff --git a/gcc/testsuite/gfortran.dg/include_4.f90 b/gcc/testsuite/gfortran.dg/include_4.f90
new file mode 100644
index 000000000..cf1efb159
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/include_4.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+!
+! PR fortran/37821
+!
+! Ensure that for #include "..." and for include the
+! current directory/directory of the source file is
+! included. See also include_5.f90
+
+subroutine one()
+  include "include_4.inc"
+  integer(i4) :: i
+end subroutine one
diff --git a/gcc/testsuite/gfortran.dg/include_4.inc b/gcc/testsuite/gfortran.dg/include_4.inc
new file mode 100644
index 000000000..37b646774
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/include_4.inc
@@ -0,0 +1,4 @@
+! Used by include_4.f90 and include_5.f90
+! PR fortran/37821
+!
+integer, parameter :: i4 = 4
diff --git a/gcc/testsuite/gfortran.dg/include_5.f90 b/gcc/testsuite/gfortran.dg/include_5.f90
new file mode 100644
index 000000000..2bfd2bb09
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/include_5.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-cpp" }
+!
+! PR fortran/37821
+!
+! Ensure that for #include "..." and for include the
+! current directory/directory of the source file is
+! included.
+
+subroutine one()
+  include "include_4.inc"
+  integer(i4) :: i
+end subroutine one
+
+subroutine two()
+# include "include_4.inc"
+  integer(i4) :: i
+end subroutine two
diff --git a/gcc/testsuite/gfortran.dg/index.f90 b/gcc/testsuite/gfortran.dg/index.f90
new file mode 100644
index 000000000..58cd25c70
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/index.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! pr35940
+      program FA1031
+      implicit none
+      integer I
+      INTEGER IDA1(10)
+      LOGICAL GDA1(10)
+      INTEGER RSLT(10)
+      DATA RSLT /4,1,4,1,4,1,4,1,4,1/
+      IDA1   = 0
+      gda1 = (/ (i/2*2 .ne. I, i=1,10) /)
+
+      IDA1 = INDEX ( 'DEFDEF' , 'DEF', GDA1 )    !fails
+      do I = 1, 10
+         if (IDA1(i).NE.RSLT(i)) call abort
+      end do
+      IDA1 = INDEX ( (/ ('DEFDEF',i=1,10) /) , 'DEF', GDA1 )    !works
+      do I = 1, 10
+         if (IDA1(i).NE.RSLT(i)) call abort
+      end do
+
+      END
diff --git a/gcc/testsuite/gfortran.dg/index_2.f90 b/gcc/testsuite/gfortran.dg/index_2.f90
new file mode 100644
index 000000000..74845b966
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/index_2.f90
@@ -0,0 +1,56 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+! PR fortran/36462
+!
+  implicit none
+  character(len=10,kind=1) string1
+  character(len=10,kind=4) string4
+  string1 = 'ABCDEEDCBA'
+  string4 = 'ABCDEEDCBA'
+
+  if(index(string1,1_'A') /= 1) call abort()
+  if(index(string4,4_'A') /= 1) call abort()
+  if(index(string1,1_'A',kind=4) /= 1_4) call abort()
+  if(index(string4,4_'A',kind=4) /= 1_4) call abort()
+  if(index(string1,1_'A',kind=1) /= 1_1) call abort()
+  if(index(string4,4_'A',kind=1) /= 1_1) call abort()
+
+  if(index(string1,1_'A',back=.true.) /= 10) call abort()
+  if(index(string4,4_'A',back=.true.) /= 10) call abort()
+  if(index(string1,1_'A',kind=4,back=.true.) /= 10_4) call abort()
+  if(index(string4,4_'A',kind=4,back=.true.) /= 10_4) call abort()
+  if(index(string1,1_'A',kind=1,back=.true.) /= 10_1) call abort()
+  if(index(string4,4_'A',kind=1,back=.true.) /= 10_1) call abort()
+
+  if(index(string1,1_'A',back=.false.) /= 1) call abort()
+  if(index(string4,4_'A',back=.false.) /= 1) call abort()
+  if(index(string1,1_'A',kind=4,back=.false.) /= 1_4) call abort()
+  if(index(string4,4_'A',kind=4,back=.false.) /= 1_4) call abort()
+  if(index(string1,1_'A',kind=1,back=.false.) /= 1_1) call abort()
+  if(index(string4,4_'A',kind=1,back=.false.) /= 1_1) call abort()
+
+  if(scan(string1,1_'A') /= 1) call abort()
+  if(scan(string4,4_'A') /= 1) call abort()
+  if(scan(string1,1_'A',kind=4) /= 1_4) call abort()
+  if(scan(string4,4_'A',kind=4) /= 1_4) call abort()
+  if(scan(string1,1_'A',kind=1) /= 1_1) call abort()
+  if(scan(string4,4_'A',kind=1) /= 1_1) call abort()
+
+  if(scan(string1,1_'A',back=.true.) /= 10) call abort()
+  if(scan(string4,4_'A',back=.true.) /= 10) call abort()
+  if(scan(string1,1_'A',kind=4,back=.true.) /= 10_4) call abort()
+  if(scan(string4,4_'A',kind=4,back=.true.) /= 10_4) call abort()
+  if(scan(string1,1_'A',kind=1,back=.true.) /= 10_1) call abort()
+  if(scan(string4,4_'A',kind=1,back=.true.) /= 10_1) call abort()
+
+  if(scan(string1,1_'A',back=.false.) /= 1) call abort()
+  if(scan(string4,4_'A',back=.false.) /= 1) call abort()
+  if(scan(string1,1_'A',kind=4,back=.false.) /= 1_4) call abort()
+  if(scan(string4,4_'A',kind=4,back=.false.) /= 1_4) call abort()
+  if(scan(string1,1_'A',kind=1,back=.false.) /= 1_1) call abort()
+  if(scan(string4,4_'A',kind=1,back=.false.) /= 1_1) call abort()
+  end
+
+! { dg-final { scan-tree-dump-times "if ..integer.kind=1.. _gfortran_string_index" 6 "original" } }
+! { dg-final { scan-tree-dump-times "if ..integer.kind=1.. _gfortran_string_scan" 6 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/init_flag_1.f90 b/gcc/testsuite/gfortran.dg/init_flag_1.f90
new file mode 100644
index 000000000..764d32252
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/init_flag_1.f90
@@ -0,0 +1,57 @@
+! { dg-do run }
+! { dg-options "-finit-local-zero -fbackslash" }
+
+program init_flag_1
+  call real_test
+  call logical_test
+  call int_test
+  call complex_test
+  call char_test
+end program init_flag_1
+
+! Test some initializations for both implicitly and
+! explicitly declared local variables.
+subroutine real_test
+  real r1
+  real r2(10)
+  dimension r3(10,10)
+  if (r1 /= 0.0) call abort
+  if (r2(2) /= 0.0) call abort
+  if (r3(5,5) /= 0.0) call abort
+  if (r4 /= 0.0) call abort
+end subroutine real_test
+
+subroutine logical_test
+  logical l1
+  logical l2(2)
+  if (l1 .neqv. .false.) call abort
+  if (l2(2) .neqv. .false.) call abort
+end subroutine logical_test
+
+subroutine int_test
+  integer i1
+  integer i2(10)
+  dimension i3(10,10)
+  if (i1 /= 0) call abort
+  if (i2(2) /= 0) call abort
+  if (i3(5,5) /= 0) call abort
+  if (i4 /= 0) call abort
+end subroutine int_test
+
+subroutine complex_test
+  complex c1
+  complex c2(20,20)
+  if (c1 /= (0.0,0.0)) call abort
+  if (c2(1,1) /= (0.0,0.0)) call abort 
+end subroutine complex_test
+
+subroutine char_test
+  character*1 c1
+  character*8 c2, c3(5)
+  character c4(10)
+  if (c1 /= '\0') call abort
+  if (c2 /= '\0\0\0\0\0\0\0\0') call abort
+  if (c3(1) /= '\0\0\0\0\0\0\0\0') call abort
+  if (c3(5) /= '\0\0\0\0\0\0\0\0') call abort
+  if (c4(5) /= '\0') call abort
+end subroutine char_test
diff --git a/gcc/testsuite/gfortran.dg/init_flag_10.f90 b/gcc/testsuite/gfortran.dg/init_flag_10.f90
new file mode 100644
index 000000000..826a34b81
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/init_flag_10.f90
@@ -0,0 +1,43 @@
+! { dg-do run }
+! { dg-options "-finit-real=NAN" }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+!
+! PR fortran/50619
+!
+! Contributed by Fred Krogh
+!
+! The NaN initialization used to set the associate name to NaN!
+!
+
+module testa2
+type, public ::  test_ty
+  real :: rmult = 1.0e0
+end type test_ty
+
+contains
+  subroutine test(e, var1)
+    type(test_ty) :: e
+    real :: var1, var2 ! Should get NaN initialized
+
+    ! Should be the default value
+    if (e%rmult /= 1.0) call abort ()
+
+    ! Check that NaN initialization is really turned on
+    if (var1 == var1) call abort () 
+    if (var2 == var2) call abort () 
+
+    ! The following was failing:
+    associate (rmult=>e%rmult)
+      if (e%rmult /= 1.0) call abort ()
+    end associate
+  end subroutine test
+end module testa2
+
+program testa1
+  use testa2
+  type(test_ty) :: e
+  real :: var1 ! Should get NaN initialized
+  call test(e, var1)
+  stop
+end program testa1
diff --git a/gcc/testsuite/gfortran.dg/init_flag_2.f90 b/gcc/testsuite/gfortran.dg/init_flag_2.f90
new file mode 100644
index 000000000..c46cf1bd2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/init_flag_2.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+! { dg-options "-finit-integer=1 -finit-logical=true -finit-real=zero" }
+
+program init_flag_2
+  call real_test
+  call logical_test
+  call int_test
+  call complex_test
+end program init_flag_2
+
+! Test some initializations for both implicitly and
+! explicitly declared local variables.
+subroutine real_test
+  real r1
+  real r2(10)
+  dimension r3(10,10)
+  if (r1 /= 0.0) call abort
+  if (r2(2) /= 0.0) call abort
+  if (r3(5,5) /= 0.0) call abort
+  if (r4 /= 0.0) call abort
+end subroutine real_test
+
+subroutine logical_test
+  logical l1
+  logical l2(2)
+  if (l1 .neqv. .true.) call abort
+  if (l2(2) .neqv. .true.) call abort
+end subroutine logical_test
+
+subroutine int_test
+  integer i1
+  integer i2(10)
+  dimension i3(10,10)
+  if (i1 /= 1) call abort
+  if (i2(2) /= 1) call abort
+  if (i3(5,5) /= 1) call abort
+  if (i4 /= 1) call abort
+end subroutine int_test
+
+subroutine complex_test
+  complex c1
+  complex c2(20,20)
+  if (c1 /= (0.0,0.0)) call abort
+  if (c2(1,1) /= (0.0,0.0)) call abort 
+end subroutine complex_test
diff --git a/gcc/testsuite/gfortran.dg/init_flag_3.f90 b/gcc/testsuite/gfortran.dg/init_flag_3.f90
new file mode 100644
index 000000000..e4426177a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/init_flag_3.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! { dg-options "-finit-integer=-1 -finit-logical=false -finit-real=nan" }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+
+program init_flag_3
+  call real_test
+  call logical_test
+  call int_test
+  call complex_test
+end program init_flag_3
+
+! Test some initializations for both implicitly and
+! explicitly declared local variables.
+subroutine real_test
+  real r1
+  real r2(10)
+  dimension r3(10,10)
+  if (r1 .eq. r1) call abort
+  if (r2(2) .eq. r2(2)) call abort
+  if (r3(5,5) .eq. r3(5,5)) call abort
+  if (r4 .eq. r4) call abort
+end subroutine real_test
+
+subroutine logical_test
+  logical l1
+  logical l2(2)
+  if (l1 .neqv. .false.) call abort
+  if (l2(2) .neqv. .false.) call abort
+end subroutine logical_test
+
+subroutine int_test
+  integer i1
+  integer i2(10)
+  dimension i3(10,10)
+  if (i1 /= -1) call abort
+  if (i2(2) /= -1) call abort
+  if (i3(5,5) /= -1) call abort
+  if (i4 /= -1) call abort
+end subroutine int_test
+
+subroutine complex_test
+  complex c1
+  complex c2(20,20)
+  if (c1 .eq. c1) call abort
+  if (c2(1,1) .eq. c2(1,1)) call abort 
+end subroutine complex_test
diff --git a/gcc/testsuite/gfortran.dg/init_flag_4.f90 b/gcc/testsuite/gfortran.dg/init_flag_4.f90
new file mode 100644
index 000000000..b79ec61f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/init_flag_4.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-options "-finit-real=inf" }
+! { dg-add-options ieee }
+
+program init_flag_4
+  call real_test
+end program init_flag_4
+
+! Test some initializations for both implicitly and
+! explicitly declared local variables.
+subroutine real_test
+  real r1
+  real r2(10)
+  dimension r3(10,10)
+  if (r1 .le. 0 .or. r1 .ne. 2*r1) call abort
+  if (r2(2) .le. 0 .or. r2(2) .ne. 2*r2(2)) call abort
+  if (r3(5,5) .le. 0 .or. r3(5,5) .ne. 2*r3(5,5)) call abort
+  if (r4 .le. 0 .or. r4 .ne. 2*r4) call abort
+end subroutine real_test
diff --git a/gcc/testsuite/gfortran.dg/init_flag_5.f90 b/gcc/testsuite/gfortran.dg/init_flag_5.f90
new file mode 100644
index 000000000..54f891f49
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/init_flag_5.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-options "-finit-real=-inf" }
+! { dg-add-options ieee }
+
+program init_flag_5
+  call real_test
+end program init_flag_5
+
+! Test some initializations for both implicitly and
+! explicitly declared local variables.
+subroutine real_test
+  real r1
+  real r2(10)
+  dimension r3(10,10)
+  if (r1 .ge. 0 .or. r1 .ne. 2*r1) call abort
+  if (r2(2) .ge. 0 .or. r2(2) .ne. 2*r2(2)) call abort
+  if (r3(5,5) .ge. 0 .or. r3(5,5) .ne. 2*r3(5,5)) call abort
+  if (r4 .ge. 0 .or. r4 .ne. 2*r4) call abort
+end subroutine real_test
diff --git a/gcc/testsuite/gfortran.dg/init_flag_6.f90 b/gcc/testsuite/gfortran.dg/init_flag_6.f90
new file mode 100644
index 000000000..45b05cd7d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/init_flag_6.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-options "-finit-character=32" }
+
+program init_flag_6
+  call char_test
+end program init_flag_6
+
+! Test some initializations for both implicitly and
+! explicitly declared local variables.
+subroutine char_test
+  character*1 c1
+  character*8 c2, c3(5)
+  character c4(10)
+  if (c1 /= ' ') call abort
+  if (c2 /= '        ') call abort
+  if (c3(1) /= '        ') call abort
+  if (c3(5) /= '        ') call abort
+  if (c4(5) /= ' ') call abort
+end subroutine char_test
+        
diff --git a/gcc/testsuite/gfortran.dg/init_flag_7.f90 b/gcc/testsuite/gfortran.dg/init_flag_7.f90
new file mode 100644
index 000000000..78829811d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/init_flag_7.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! { dg-options "-finit-integer=101" }
+
+program init_flag_7
+  call save_test1 (.true.)
+  call save_test1 (.false.) 
+  call save_test2 (.true.)
+  call save_test2 (.false.)
+end program init_flag_7
+
+! Test some initializations for both implicitly and
+! explicitly declared local variables.
+subroutine save_test1 (first)
+  logical first
+  integer :: i1 = -100
+  integer i2
+  integer i3
+  save i2
+  if (first) then
+     if (i1 .ne. -100) call abort
+     if (i2 .ne. 101) call abort
+     if (i3 .ne. 101) call abort
+  else
+     if (i1 .ne. 1001) call abort
+     if (i2 .ne. 1002) call abort
+     if (i3 .ne. 101) call abort
+  end if
+  i1 = 1001
+  i2 = 1002
+  i3 = 1003
+end subroutine save_test1
+        
+subroutine save_test2 (first)
+  logical first
+  integer :: i1 = -100
+  integer i2
+  save
+  if (first) then
+     if (i1 .ne. -100) call abort
+     if (i2 .ne. 101) call abort
+  else
+     if (i1 .ne. 1001) call abort
+     if (i2 .ne. 1002) call abort
+  end if
+  i1 = 1001
+  i2 = 1002
+end subroutine save_test2
diff --git a/gcc/testsuite/gfortran.dg/init_flag_8.f90 b/gcc/testsuite/gfortran.dg/init_flag_8.f90
new file mode 100644
index 000000000..b3ccc0398
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/init_flag_8.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-fno-automatic -finit-local-zero" }
+!
+! PR fortran/51800
+!
+! Contributed by Mario Baumann
+!
+      SUBROUTINE FOO( N, A )
+      IMPLICIT NONE
+      INTEGER :: N
+      INTEGER :: A(1:N)
+      INTEGER :: J
+      INTEGER :: DUMMY(1:N)
+      DO J=1,N
+         DUMMY(J) = 0
+         A(J) = DUMMY(J)
+      END DO 
+      END SUBROUTINE FOO
diff --git a/gcc/testsuite/gfortran.dg/init_flag_9.f90 b/gcc/testsuite/gfortran.dg/init_flag_9.f90
new file mode 100644
index 000000000..512396455
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/init_flag_9.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-finit-character=89" }
+!
+! PR fortran/51800
+!
+
+subroutine foo(n)
+  character(len=n) :: str
+!  print *, str
+  if (str /= repeat ('Y', n)) call abort()
+end subroutine foo
+
+call foo(3)
+call foo(10)
+end
diff --git a/gcc/testsuite/gfortran.dg/initialization_1.f90 b/gcc/testsuite/gfortran.dg/initialization_1.f90
new file mode 100644
index 000000000..2fb014ece
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_1.f90
@@ -0,0 +1,39 @@
+!==================initialization_1.f90======================
+
+! { dg-do compile }
+! Tests fix for PR25018 in which an ICE resulted from using a
+! variable in a parameter initialization expression. In the course
+! of developing the fix, various other constraints and limitations
+! were tested.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module const
+! The next line is the original error
+  real(8), parameter :: g = - sqrt(2._8) * Gf ! { dg-error "not been declared or is a variable" }
+contains
+  subroutine foo(ch1, x, y)
+    character(*)        :: ch1
+
+! This is OK because it is a restricted expression.
+    character(len(ch1)) :: ch2
+
+    real(8) :: x (1:2, *)
+    real(8) :: y (0:,:)
+    integer :: i
+    real :: z(2, 2)
+
+! However, this gives a warning because it is an initialization expression.
+    integer :: l1 = len (ch1)     ! { dg-error "Assumed or deferred character length variable" }
+
+! These are warnings because they are gfortran extensions.
+    integer :: m3 = size (x, 1)   ! { dg-error "Assumed size array" }
+    integer :: m4(2) = shape (z)
+
+! This does not depend on non-constant properties.
+    real(8) :: big = huge (x)
+
+  end subroutine foo  
+end module const
+
+! { dg-final { cleanup-modules "const" } }
diff --git a/gcc/testsuite/gfortran.dg/initialization_10.f90 b/gcc/testsuite/gfortran.dg/initialization_10.f90
new file mode 100644
index 000000000..92d9df50e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_10.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+!
+! PR fortran/32867 - nested initialization expression not simplified
+!
+! Testcase contributed by H. J. Lu <hjl AT lucon DOT org>
+!
+
+MODULE Readdata_mod
+IMPLICIT NONE
+Private
+Public Parser
+  integer, parameter :: nkeywords = 2
+character(80), PARAMETER, dimension(1:nkeywords) :: keywords = &
+(/'PROBLEMSIZE                                  ',             &
+  'NFTRANS_TD                                   '/)
+
+CONTAINS
+SUBROUTINE Parser(nx, ny, keyword)
+integer, intent(inout) :: nx, ny
+character(80), intent(inout) :: keyword
+
+select case (keyword)
+  case (trim(keywords(1))) ! PROBLEMSIZE
+    nx = 1
+  case (trim(keywords(2))) !'NFTRANS_TD'
+    ny = 1
+end select
+
+END SUBROUTINE Parser
+END MODULE Readdata_mod
+
+! { dg-final { cleanup-modules "Readdata_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/initialization_11.f90 b/gcc/testsuite/gfortran.dg/initialization_11.f90
new file mode 100644
index 000000000..a9acbec22
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_11.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! PR fortran/32903
+!
+program test
+  implicit none
+  type data_type
+    integer :: i=2
+  end type data_type
+  type(data_type) :: d
+  d%i = 4
+  call set(d)
+  if(d%i /= 2) then
+     print *, 'Expect: 2, got: ', d%i
+     call abort()
+  end if
+contains
+  subroutine set(x1)
+    type(data_type),intent(out):: x1
+  end subroutine set
+end program test
diff --git a/gcc/testsuite/gfortran.dg/initialization_12.f90 b/gcc/testsuite/gfortran.dg/initialization_12.f90
new file mode 100644
index 000000000..deef2077a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_12.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! PR fortran/32945 - ICE in init expressions
+!
+! Contributed by Florian Ladstaedter <flad AT gmx DOT at>
+!
+
+MODULE EGOPS_Utilities
+CONTAINS
+  FUNCTION dirname(fullfilename)
+    Character(LEN=*),  Intent(In)    :: fullfilename
+    Character(LEN=LEN(fullfilename)) :: dirname
+    dirname = ''
+  END FUNCTION
+END MODULE EGOPS_Utilities
+
+MODULE AtmoIono
+  CHARACTER(LEN=10), PARAMETER :: ComputeDryAtmModel = 'Dry Atm.  '
+
+  type AtmModel
+    character (len=len(ComputeDryAtmModel)) :: moistDryStr
+  end type AtmModel
+END MODULE AtmoIono
+
+module AtmoIonoSphere
+  use EGOPS_Utilities
+  use AtmoIono
+end module AtmoIonoSphere
+
+! { dg-final { cleanup-modules "EGOPS_Utilities AtmoIono AtmoIonoSphere" } }
diff --git a/gcc/testsuite/gfortran.dg/initialization_13.f90 b/gcc/testsuite/gfortran.dg/initialization_13.f90
new file mode 100644
index 000000000..0cd6fa693
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_13.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/33178
+!
+! Initialization expressions:
+! Fortran 95: Elemental functions w/ integer/character arguments
+! Fortran 2003: restriction lifted
+!
+integer :: a = sign(1,1)   ! Ok F95
+real    :: b = sign(1.,1.) ! { dg-error "Fortran 2003: Elemental function as initialization expression" }
+end
diff --git a/gcc/testsuite/gfortran.dg/initialization_14.f90 b/gcc/testsuite/gfortran.dg/initialization_14.f90
new file mode 100644
index 000000000..4d5b6856c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_14.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! PR 20851
+! Dummy arguments are disallowed in initialization expressions in
+! elemental functions except as arguments to the intrinsic functions
+! BIT_SIZE, KIND, LEN, or to the numeric inquiry functions listed
+! in 13.11.8
+MODULE TT
+INTEGER M
+CONTAINS
+   ELEMENTAL REAL FUNCTION two(N)
+     INTEGER, INTENT(IN) :: N
+     INTEGER, DIMENSION(N) :: scr ! { dg-error "Dummy argument 'n' not allowed in expression" }
+   END FUNCTION
+
+   ELEMENTAL REAL FUNCTION twopointfive(N)
+     INTEGER, INTENT(IN) :: N
+     INTEGER, DIMENSION(MAX(N,2)) :: scr ! { dg-error "Dummy argument 'n' not allowed in expression" }
+   end FUNCTION twopointfive
+
+   REAL FUNCTION three(N)
+     INTEGER, INTENT(IN) :: N
+     INTEGER, DIMENSION(N) :: scr ! this time it's valid
+   END FUNCTION
+
+   ELEMENTAL REAL FUNCTION four(N)
+     INTEGER, INTENT(IN) :: N
+     INTEGER, DIMENSION(bit_size(N)) :: scr ! another valid variant
+   END FUNCTION
+
+   ELEMENTAL REAL FUNCTION gofourit(N)
+     INTEGER, INTENT(IN) :: N
+     INTEGER, DIMENSION(MIN(HUGE(N),1)) :: scr ! another valid variant
+   END FUNCTION
+
+   ELEMENTAL REAL FUNCTION fourplusone(N)
+     INTEGER, INTENT(IN) :: N
+     INTEGER, DIMENSION(M) :: scr ! another valid variant
+   END FUNCTION
+
+   ELEMENTAL REAL FUNCTION five(X)
+     real, intent(in) :: x
+     CHARACTER(LEN=PRECISION(X)) :: C ! valid again
+   END FUNCTION
+END MODULE
+END
diff --git a/gcc/testsuite/gfortran.dg/initialization_15.f90 b/gcc/testsuite/gfortran.dg/initialization_15.f90
new file mode 100644
index 000000000..a3eb1b9d8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_15.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! Test by Dominique d'Humieres (PR 33957)
+function bug(i) result(c)
+  integer, pointer :: i
+  character(len=merge(1,2, associated(i))) :: c
+  c = ""
+end function bug
diff --git a/gcc/testsuite/gfortran.dg/initialization_16.f90 b/gcc/testsuite/gfortran.dg/initialization_16.f90
new file mode 100644
index 000000000..a717eeefc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_16.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-std=f95 -Wall" }
+!
+! PR fortran/34495
+!
+! Check for invalid Fortran 95 initialization expressions
+!
+program main
+  implicit none
+  real, parameter :: r1 = real(33)    ! { dg-error "Fortran 2003: Function 'real' as initialization expression" } 
+  real, parameter :: r2 = dble(33)    ! { dg-error "Fortran 2003: Function 'dble' as initialization expression" }
+  complex, parameter :: z = cmplx(33,33)! { dg-error "Fortran 2003: Function 'cmplx' as initialization expression" }
+  real, parameter :: r4 = sngl(3.d0)  ! { dg-error "Fortran 2003: Function 'sngl' as initialization expression" }
+  real, parameter :: r5 = float(33)   ! { dg-error "Fortran 2003: Function 'float' as initialization expression" }
+end program main
diff --git a/gcc/testsuite/gfortran.dg/initialization_17.f90 b/gcc/testsuite/gfortran.dg/initialization_17.f90
new file mode 100644
index 000000000..c7b73b583
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_17.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+!
+! PR fortran/34514
+!
+! Initialization and typespec changes.
+!
+integer :: n = 5, m = 7
+parameter (n = 42) ! { dg-error "Initializing already initialized variable" }
+dimension :: m(3)  ! { dg-error "after its initialisation" } 
+end
diff --git a/gcc/testsuite/gfortran.dg/initialization_18.f90 b/gcc/testsuite/gfortran.dg/initialization_18.f90
new file mode 100644
index 000000000..4e26e1b9e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_18.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=f95 -Wall" }
+!
+! PR fortran/34915
+! Testcase contributed by Al Greynolds via comp.lang.fortran.
+!
+
+ character(*),dimension(3),parameter :: a=(/'a()  ','b(,) ','c(,,)'/)
+ integer,dimension(3),parameter :: l=len_trim(a)
+end
diff --git a/gcc/testsuite/gfortran.dg/initialization_19.f90 b/gcc/testsuite/gfortran.dg/initialization_19.f90
new file mode 100644
index 000000000..2465f9b33
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_19.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! The following program fails with 4.3.0
+! but works with 4.4.0. See:
+!
+! http://gcc.gnu.org/ml/fortran/2008-05/msg00199.html
+!
+module c
+type d
+  integer :: i=-1
+end type d
+end module c
+
+module s
+use c
+contains
+subroutine g
+ type(d) :: a
+ ! Without the following line it passes with 4.3.0:
+ print *, a%i
+ if(a%i /= -1) call abort()
+ a%i=0
+end subroutine g
+end module s
+
+program t
+use c
+use s
+
+call g
+call g
+
+end program t
+
+! ! { dg-final { cleanup-modules "c s" } }
diff --git a/gcc/testsuite/gfortran.dg/initialization_2.f90 b/gcc/testsuite/gfortran.dg/initialization_2.f90
new file mode 100644
index 000000000..cfc08499b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_2.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! Vector subscripts, ranks and shapes of initialization expressions (PRs 29393,
+! 29630 and 29679)
+program test
+
+    implicit none
+    integer :: i, j
+    integer, parameter :: a(4,4,4) = reshape([ (i,i=1,64) ], [4,4,4])
+    integer, parameter :: v(4) = [4, 1, 3, 2]
+
+    integer :: b1(3,3) = a(1:3, 2, 2:4)
+    integer :: b2(1,3) = a(2:2, 4, [1,4,3])
+    integer :: b2b(3) = a([1,4,3], 2, 4)
+    integer :: b3(4) = a(1, v, 3)
+    integer :: b4(3,3) = a(v([2,4,3]), 2, [2,3,4])
+
+    if (any(b1 /= reshape([21,22,23, 37,38,39, 53,54,55], [3,3]))) call abort()
+    if (any(b2 /= reshape([14, 62, 46], [1,3]))) call abort()
+    if (any(b2b /= [53, 56, 55])) call abort()
+    if (any(b3 /= [45, 33, 41, 37])) call abort()
+    if (any(b4 /= reshape([21,22,23, 37,38,39, 53,54,55], [3,3]))) call abort()
+end program test
diff --git a/gcc/testsuite/gfortran.dg/initialization_20.f90 b/gcc/testsuite/gfortran.dg/initialization_20.f90
new file mode 100644
index 000000000..6af1a00a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_20.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! Test for PR19925
+!
+program pr19925
+  implicit none
+  integer j
+  integer, parameter :: n = 100000
+  integer, parameter :: i(n)=(/(j,j=1,n)/) ! { dg-error "number of elements" }
+  print *, i(5) ! { dg-error "has no IMPLICIT type" }
+end program pr19925
diff --git a/gcc/testsuite/gfortran.dg/initialization_21.f90 b/gcc/testsuite/gfortran.dg/initialization_21.f90
new file mode 100644
index 000000000..d43447679
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_21.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-fmax-array-constructor=100000" }
+! Test for PR19925
+!
+program pr19925
+  implicit none
+  integer j
+  integer, parameter :: n = 100000
+  integer, parameter :: i(n) = (/ (j, j=1, n) /)
+  print *, i(5)
+end program pr19925
diff --git a/gcc/testsuite/gfortran.dg/initialization_22.f90 b/gcc/testsuite/gfortran.dg/initialization_22.f90
new file mode 100644
index 000000000..f788109e6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_22.f90
@@ -0,0 +1,10 @@
+! { dg-do run }
+! tests the fix for PR39292, where the intitialization expression
+! did not simplify and caused an ICE in gfc_conv_array_initializer.
+!
+! Contributed by Richard Guenther <rguenth@gcc.gnu.org>
+!
+  integer :: n
+  real, dimension(2) :: a = (/ ( (float(n))**(1.0), n=1,2) /)
+  if (any (a .ne. (/ ( (float(n))**(1.0), n=1,2) /))) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/initialization_23.f90 b/gcc/testsuite/gfortran.dg/initialization_23.f90
new file mode 100644
index 000000000..cc2aca4e2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_23.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+!
+! PR 40875: The error was missed and an ICE ensued.
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+!
+    MODULE cdf_aux_mod
+      PUBLIC
+      TYPE :: one_parameter
+        CHARACTER :: name
+      END TYPE one_parameter
+      CHARACTER, PARAMETER :: the_alpha = one_parameter('c') ! { dg-error "Can't convert TYPE" }
+      CHARACTER, PARAMETER :: the_beta = (/one_parameter('c')/) ! { dg-error "Incompatible ranks" }
+    END MODULE cdf_aux_mod
+
+! { dg-final { cleanup-modules "cdf_aux_mod" } }
+
diff --git a/gcc/testsuite/gfortran.dg/initialization_24.f90 b/gcc/testsuite/gfortran.dg/initialization_24.f90
new file mode 100644
index 000000000..0ab8dc624
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_24.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR43747 ICE in find_array_section, at fortran/expr.c:1551
+! Test case by Dominique d'Humieres
+INTEGER, PARAMETER ::N=65536
+INTEGER, PARAMETER ::I(N)=(/(MOD(K,2),K=1,N)/)!{ dg-error "number of elements" }
+INTEGER, PARAMETER ::M(N)=I(N:1:-1) ! { dg-error "Syntax error in argument" }
+print *, I(1), M(1), I(N), M(N)
+END
+
diff --git a/gcc/testsuite/gfortran.dg/initialization_25.f90 b/gcc/testsuite/gfortran.dg/initialization_25.f90
new file mode 100644
index 000000000..66c447e2f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_25.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+!
+! PR fortran/35779 - unrelated error message
+! Tescase contributed by
+! Dick Hendrickson <dick DOT hendrickson AT gmail DOT com>
+!
+! Initial patch was reverted as it broke nested loops (see initialization_26.f90).
+!
+
+!   INTEGER :: J1
+!   INTEGER,PARAMETER :: I2(10) = (/(J1,J1=its_bad,1,-1)/) ! { dg - error "does not reduce" }
+END
diff --git a/gcc/testsuite/gfortran.dg/initialization_26.f90 b/gcc/testsuite/gfortran.dg/initialization_26.f90
new file mode 100644
index 000000000..4532216e1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_26.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+!
+! Verify that the outer do-loop counter 'j' is accepted as
+! as end-expression of the inner loop.
+!
+
+  integer i, j
+  integer, parameter :: n = size( [( [(i*j,i=1,j)], j=1,2)] )
+end
diff --git a/gcc/testsuite/gfortran.dg/initialization_27.f90 b/gcc/testsuite/gfortran.dg/initialization_27.f90
new file mode 100644
index 000000000..8e21936f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_27.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+!
+! PR fortran/45489
+!
+! Check that non-referenced variables are default
+! initialized if they are INTENT(OUT) or function results.
+! Only the latter (i.e. "x=f()") was not working before
+! PR 45489 was fixed.
+!
+program test_init
+  implicit none
+  integer, target :: tgt
+  type A
+    integer, pointer:: p => null ()
+    integer:: i=3
+  end type A
+  type(A):: x, y(3)
+  x=f()
+  if (associated(x%p) .or. x%i /= 3) call abort ()
+  y(1)%p => tgt
+  y%i = 99
+  call sub1(3,y)
+  if (associated(y(1)%p) .or. any(y(:)%i /= 3)) call abort ()
+  y(1)%p => tgt
+  y%i = 99
+  call sub2(y)
+  if (associated(y(1)%p) .or. any(y(:)%i /= 3)) call abort ()
+contains
+ function f() result (fr)
+    type(A):: fr
+ end function f
+ subroutine sub1(n,x)
+   integer :: n
+   type(A), intent(out) :: x(n:n+2)
+ end subroutine sub1
+ subroutine sub2(x)
+   type(A), intent(out) :: x(:)
+ end subroutine sub2
+end program test_init
diff --git a/gcc/testsuite/gfortran.dg/initialization_28.f90 b/gcc/testsuite/gfortran.dg/initialization_28.f90
new file mode 100644
index 000000000..f5330534a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_28.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+!
+! PR fortran/50163
+!
+! Contributed by Philip Mason
+!
+character(len=2) :: xx ='aa'
+integer :: iloc=index(xx,'bb') ! { dg-error "has not been declared or is a variable" }
+end
diff --git a/gcc/testsuite/gfortran.dg/initialization_3.f90 b/gcc/testsuite/gfortran.dg/initialization_3.f90
new file mode 100644
index 000000000..61b0f9f22
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_3.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! Check that bounds are checked when using vector subscripts in initialization
+! expressions. (PR 29630)
+program test
+
+    implicit none
+    integer :: i, j
+    integer, parameter :: a(4,4,4) = reshape([ (i,i=1,64) ], [4,4,4])
+    integer, parameter :: v(4) = [5, 1, -4, 2]
+
+    integer :: b2(3) = a(2, 4, [1,7,3]) ! { dg-error "out of bounds" }
+    integer :: b3(4) = a(1, v, 3) ! { dg-error "out of bounds" }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/initialization_4.f90 b/gcc/testsuite/gfortran.dg/initialization_4.f90
new file mode 100644
index 000000000..24ccf9c64
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_4.f90
@@ -0,0 +1,7 @@
+! PR 29441 : No error was given for disallowed function in
+! initialization expression, even if -std=f95 was used
+! { dg-do compile }
+! { dg-options "-std=f95" }
+real, parameter :: pi = 4.0*Atan(1.0) ! { dg-error "Fortran 2003: Elemental function as initialization expression" }
+real, parameter :: three = 27.0**(1.0/3.0) ! { dg-error "Noninteger exponent in an initialization expression" }
+end
diff --git a/gcc/testsuite/gfortran.dg/initialization_5.f90 b/gcc/testsuite/gfortran.dg/initialization_5.f90
new file mode 100644
index 000000000..b5cfe0f0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_5.f90
@@ -0,0 +1,7 @@
+! initialization expression, now allowed in Fortran 2003
+! PR fortran/29962
+! { dg-do run }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+  real, parameter :: three = 27.0**(1.0/3.0)
+  if(abs(three-3.0)>epsilon(three)) call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/initialization_6.f90 b/gcc/testsuite/gfortran.dg/initialization_6.f90
new file mode 100644
index 000000000..71ef1717f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_6.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options -O2 }
+! Tests the fix for PRs29507 and 31404, where elemental functions in
+! initialization expressions could not be simplified with array arguments.
+!
+! Contributed by Steve Kargl <kargl@gcc.gnu.org >
+!             and Vivek Rao <vivekrao4@yahoo.com>
+!
+  real, parameter :: a(2,2) = reshape ((/1.0, 2.0, 3.0, 4.0/), (/2,2/))
+  real, parameter :: b(2,2) = sin (a)
+  character(8), parameter :: oa(1:3)=(/'nint()  ', 'log10() ', 'sqrt()  '/)
+  integer, parameter :: ob(1:3) = index(oa, '(')
+  character(6), parameter :: ch(3) = (/"animal", "person", "mantee"/)
+  character(1), parameter :: ch2(3) = (/"n", "r", "t"/)
+  integer, parameter :: i(3) = index (ch, ch2)
+  integer :: ic(1) = len_trim((/"a"/))
+
+  if (any (reshape (b, (/4/)) .ne. (/(sin(real(k)), k = 1,4)/))) call abort ()
+  if (any (ob .ne. (/5,6,5/))) call abort ()  ! Original PR29507
+  if (any (i .ne. (/2,3,4/))) call abort ()
+  if (ic(1) .ne. 1) call abort ()             ! Original PR31404
+end
diff --git a/gcc/testsuite/gfortran.dg/initialization_7.f90 b/gcc/testsuite/gfortran.dg/initialization_7.f90
new file mode 100644
index 000000000..861518196
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_7.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+!
+! PR fortran/31253 -- ICE on invlid initialization expression
+! Contributed by: Mikael Morin <mikael DOT morin AT tele2 DOT fr>
+!
+
+subroutine probleme(p)
+  real(kind=8), dimension(:) :: p
+  integer :: nx = size(p, 1)          ! { dg-error "Deferred array" }
+  integer :: nix
+
+  nix = nx
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/initialization_8.f90 b/gcc/testsuite/gfortran.dg/initialization_8.f90
new file mode 100644
index 000000000..fdc418342
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_8.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! PR fortran/31639 -- ICE on invalid initialization expression
+
+function f()
+  integer :: i = irand()     ! { dg-error "not permitted in an initialization expression" }
+  f = i
+end function
diff --git a/gcc/testsuite/gfortran.dg/initialization_9.f90 b/gcc/testsuite/gfortran.dg/initialization_9.f90
new file mode 100644
index 000000000..d90404748
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_9.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! PR fortran/31639
+! Contributed by Martin Michlmayr <tbm AT cyrius DOT com>
+
+   integer function xstrcmp(s1)
+     character*(*), intent(in) :: s1
+     integer :: n1 = len(s1)  ! { dg-error "Assumed or deferred character length variable" }
+     n1 = 1
+     return
+   end function xstrcmp
diff --git a/gcc/testsuite/gfortran.dg/inline_transpose_1.f90 b/gcc/testsuite/gfortran.dg/inline_transpose_1.f90
new file mode 100644
index 000000000..a36484251
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inline_transpose_1.f90
@@ -0,0 +1,238 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original -fdump-tree-optimized -Warray-temporaries -fbounds-check" }
+
+  implicit none
+
+  integer :: i, j
+
+  integer, parameter :: nx=3, ny=4
+  integer, parameter, dimension(nx,ny) :: p = &
+    & reshape ((/ (i**2, i=1,size(p)) /), shape(p))
+  integer, parameter, dimension(ny,nx) :: q = &
+    & reshape ((/ (((nx*(i-1)+j)**2, i=1,ny), j=1,nx) /), (/ ny, nx /))
+
+  integer, parameter, dimension(nx,nx) :: r = &
+    & reshape ((/ (i*i, i=1,size(r)) /), shape(r))
+  integer, parameter, dimension(nx,nx) :: s = &
+    & reshape ((/ (((nx*(i-1)+j)**2, i=1,nx), j=1,nx) /), (/ nx, nx /))
+
+
+
+  integer, dimension(nx,ny) :: a, b
+  integer, dimension(ny,nx) :: c
+  integer, dimension(nx,nx) :: e, f, g
+
+  character(144) :: u, v
+
+  a = p
+
+  c = transpose(a)
+  if (any(c /= q)) call abort
+
+  write(u,*) transpose(a)
+  write(v,*) q
+  if (u /= v) call abort
+
+
+  e = r
+  f = s
+
+  g = transpose(e+f)
+  if (any(g /= r + s)) call abort
+
+  write(u,*) transpose(e+f)
+  write(v,*) r + s
+  if (u /= v) call abort
+
+
+  e = transpose(e)      ! { dg-warning "Creating array temporary" }
+  if (any(e /= s)) call abort
+
+  write(u,*) transpose(transpose(e))
+  write(v,*) s
+  if (u /= v) call abort
+
+
+  e = transpose(e+f)     ! { dg-warning "Creating array temporary" }
+  if (any(e /= 2*r)) call abort
+
+  write(u,*) transpose(transpose(e+f))-f
+  write(v,*) 2*r
+  if (u /= v) call abort
+
+
+  a = foo(transpose(c))
+  if (any(a /= p+1)) call abort
+
+  write(u,*) foo(transpose(c))    ! { dg-warning "Creating array temporary" }
+  write(v,*) p+1
+  if (u /= v) call abort
+
+
+  c = transpose(foo(a))      ! Unnecessary { dg-warning "Creating array temporary" }
+  if (any(c /= q+2)) call abort
+
+  write(u,*) transpose(foo(a))     ! { dg-warning "Creating array temporary" }
+  write(v,*) q+2
+  if (u /= v) call abort
+
+
+  e = foo(transpose(e))     ! { dg-warning "Creating array temporary" }
+  if (any(e /= 2*s+1)) call abort
+
+  write(u,*) transpose(foo(transpose(e))-1)     ! { dg-warning "Creating array temporary" }
+  write(v,*) 2*s+1
+  if (u /= v) call abort
+
+
+  e = transpose(foo(e))     ! { dg-warning "Creating array temporary" }
+  if (any(e /= 2*r+2)) call abort
+
+  write(u,*) transpose(foo(transpose(e)-1))     ! 2 temps { dg-warning "Creating array temporary" }
+  write(v,*) 2*r+2
+  if (u /= v) call abort
+
+
+  a = bar(transpose(c))
+  if (any(a /= p+4)) call abort
+
+  write(u,*) bar(transpose(c))
+  write(v,*) p+4
+  if (u /= v) call abort
+
+
+  c = transpose(bar(a))
+  if (any(c /= q+6)) call abort
+
+  write(u,*) transpose(bar(a))
+  write(v,*) q+6
+  if (u /= v) call abort
+
+
+  e = bar(transpose(e))     ! { dg-warning "Creating array temporary" }
+  if (any(e /= 2*s+4)) call abort
+
+  write(u,*) transpose(bar(transpose(e)))-2
+  write(v,*) 2*s+4
+  if (u /= v) call abort
+
+
+  e = transpose(bar(e))     ! { dg-warning "Creating array temporary" }
+  if (any(e /= 2*r+6)) call abort
+
+  write(u,*) transpose(transpose(bar(e))-2)
+  write(v,*) 2*r+6
+  if (u /= v) call abort
+
+
+  if (any(a /= transpose(transpose(a)))) call abort     ! optimized away
+
+  write(u,*) a
+  write(v,*) transpose(transpose(a))
+  if (u /= v) call abort
+
+
+  b = a * a
+
+  if (any(transpose(a+b) /= transpose(a)+transpose(b))) call abort      ! optimized away
+
+  write(u,*) transpose(a+b)
+  write(v,*) transpose(a) + transpose(b)
+  if (u /= v) call abort
+
+
+  if (any(transpose(matmul(a,c)) /= matmul(transpose(c), transpose(a)))) call abort      ! 2 temps { dg-warning "Creating array temporary" }
+
+  write(u,*) transpose(matmul(a,c))     ! { dg-warning "Creating array temporary" }
+  write(v,*) matmul(transpose(c), transpose(a))     ! { dg-warning "Creating array temporary" }
+  if (u /= v) call abort
+
+
+  if (any(transpose(matmul(e,a)) /= matmul(transpose(a), transpose(e)))) call abort     ! 2 temps { dg-warning "Creating array temporary" }
+
+  write(u,*) transpose(matmul(e,a))     ! { dg-warning "Creating array temporary" }
+  write(v,*) matmul(transpose(a), transpose(e))     ! { dg-warning "Creating array temporary" }
+  if (u /= v) call abort
+
+
+  call baz (transpose(a))
+
+
+  call toto1 (a, transpose (c))
+  if (any (a /= 2 * p + 12)) call abort
+
+  call toto1 (e, transpose (e))          ! { dg-warning "Creating array temporary" }
+  if (any (e /= 4 * s + 12)) call abort
+
+
+  call toto2 (c, transpose (a))
+  if (any (c /= 2 * q + 13)) call abort
+
+  call toto2 (e, transpose(e))           ! { dg-warning "Creating array temporary" }
+  if (any (e /= 4 * r + 13)) call abort
+
+  call toto2 (e, transpose(transpose(e)))           ! { dg-warning "Creating array temporary" }
+  if (any (e /= 4 * r + 14)) call abort
+
+
+  call toto3 (e, transpose(e))
+  if (any (e /= 4 * r + 14)) call abort
+
+
+  call titi (nx, e, transpose(e))           ! { dg-warning "Creating array temporary" }
+  if (any (e /= 4 * s + 17)) call abort
+
+  contains
+
+  function foo (x)
+    integer, intent(in) :: x(:,:)
+    integer :: foo(size(x,1), size(x,2))
+    foo = x + 1
+  end function foo
+
+  elemental function bar (x)
+    integer, intent(in) :: x
+    integer :: bar
+    bar = x + 2
+  end function bar
+
+  subroutine baz (x)
+    integer, intent(in) :: x(:,:)
+  end subroutine baz
+
+  elemental subroutine toto1 (x, y)
+    integer, intent(out) :: x
+    integer, intent(in)  :: y
+    x = y + y
+  end subroutine toto1
+
+  subroutine toto2 (x, y)
+    integer, dimension(:,:), intent(out) :: x
+    integer, dimension(:,:), intent(in)  :: y
+    x = y + 1
+  end subroutine toto2
+
+  subroutine toto3 (x, y)
+    integer, dimension(:,:), intent(in) :: x, y
+  end subroutine toto3
+
+end
+
+subroutine titi (n, x, y)
+  integer :: n, x(n,n), y(n,n)
+  x = y + 3
+end subroutine titi
+
+! No call to transpose
+! { dg-final { scan-tree-dump-times "_gfortran_transpose" 0 "original" } }
+!
+! 24 temporaries
+! { dg-final { scan-tree-dump-times "struct\[^\\n\]*atmp" 24 "original" } }
+!
+! 2 tests optimized out
+! { dg-final { scan-tree-dump-times "_gfortran_abort" 39 "original" } }
+! { # Commented out as failing at -O0: dg-final { scan-tree-dump-times "_gfortran_abort" 37 "optimized" } }
+!
+! cleanup
+! { dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-tree-dump "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/inquire-complex.f90 b/gcc/testsuite/gfortran.dg/inquire-complex.f90
new file mode 100644
index 000000000..40d08d4eb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquire-complex.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! PR 23428:  Inquire(iolength) used to give the wrong result.
+program main
+  implicit none
+  integer s4, s8
+  
+  complex(kind=8) c8
+  complex(kind=4) c4
+  
+  inquire (iolength=s4) c4
+  inquire (iolength=s8) c8
+  if (s4 /= 8 .or. s8 /= 16) call abort
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/inquire.f90 b/gcc/testsuite/gfortran.dg/inquire.f90
new file mode 100644
index 000000000..7115913c6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquire.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! check to see that you cannot open a direct access file
+! for sequential i/o.
+! derived from NIST test fm910.for
+        IMPLICIT NONE
+        CHARACTER*10 D4VK
+        OPEN(UNIT=7, ACCESS='DIRECT',RECL=132,STATUS='SCRATCH')
+        INQUIRE(UNIT=7,SEQUENTIAL=D4VK)
+        CLOSE(UNIT=7,STATUS='DELETE')
+        IF (D4VK.NE.'NO') CALL ABORT
+        END
diff --git a/gcc/testsuite/gfortran.dg/inquire_10.f90 b/gcc/testsuite/gfortran.dg/inquire_10.f90
new file mode 100644
index 000000000..5343f2b3a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquire_10.f90
@@ -0,0 +1,16 @@
+  character(len=800) :: cwd
+  integer :: unit
+
+  call getcwd(cwd)
+
+  open(file='cseq', unit=23)
+  inquire(file='cseq',number=unit)
+  if (unit /= 23) call abort
+  inquire(file=trim(cwd) // '/cseq',number=unit)
+  if (unit /= 23) call abort
+
+  inquire(file='foo/../cseq2',number=unit)
+  if (unit >= 0) call abort
+  inquire(file='cseq2',number=unit)
+  if (unit >= 0) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/inquire_11.f90 b/gcc/testsuite/gfortran.dg/inquire_11.f90
new file mode 100644
index 000000000..cc5e26d09
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquire_11.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! PR 33055 Runtime error in INQUIRE unit existance with -fdefault-integer-8
+! Test case from PR33217 prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+MODULE print_it
+CONTAINS
+  SUBROUTINE i()
+    LOGICAL :: qexist
+    INQUIRE (UNIT=1, EXIST=qexist)
+  END SUBROUTINE i
+END MODULE print_it
+! { dg-final { cleanup-modules "print_it" } }
diff --git a/gcc/testsuite/gfortran.dg/inquire_12.f90 b/gcc/testsuite/gfortran.dg/inquire_12.f90
new file mode 100644
index 000000000..4595fb568
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquire_12.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! PR34722 ICE: left-over "@iostat" variable polutes namespace
+program gamsanal
+implicit none
+character :: tmp
+integer iodict
+logical dicexist
+inquire(unit=iodict, exist=dicexist)
+end
+
+subroutine inventnames()
+implicit none
+end subroutine
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/inquire_13.f90 b/gcc/testsuite/gfortran.dg/inquire_13.f90
new file mode 100644
index 000000000..d074861a9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquire_13.f90
@@ -0,0 +1,103 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR34795 inquire statement , direct= specifier incorrectly returns YES
+! Test case from PR, modified by Jerry DeLisle  <jvdelisle@gcc.gnu.org
+program testinquire
+implicit none
+character drct*7, acc*12, frmt*12, seqn*12, fname*15
+logical opn
+
+fname="inquire_13_test"
+inquire(unit=6, direct=drct, opened=opn, access=acc)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
+
+inquire(unit=10, direct=drct, opened=opn, access=acc)
+if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
+
+inquire(unit=10, direct=drct, opened=opn, access=acc, formatted=frmt)
+if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
+if (frmt.ne."UNKNOWN") call abort
+
+open(unit=19,file=fname,status='replace',err=170,form="formatted")
+inquire(unit=19, direct=drct, opened=opn, access=acc,formatted=frmt)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL")  call abort
+if (frmt.ne."YES")  call abort
+
+! Inquire on filename, open file with DIRECT and FORMATTED
+inquire(file=fname, direct=drct, opened=opn, access=acc, FORMATTED=frmt)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL")  call abort
+if (frmt.ne."YES") call abort
+close(19)
+
+! Inquire on filename, closed file with DIRECT and FORMATTED
+inquire(file=fname, direct=drct, opened=opn, access=acc, formatted=frmt)
+if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
+if (frmt.ne."UNKNOWN") call abort
+
+open(unit=19,file=fname,status='replace',err=170,form="unformatted")
+inquire(unit=19, direct=drct, opened=opn, access=acc, formatted=frmt)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
+if (frmt.ne."NO")  call abort
+close(19)
+       
+open(unit=19,file=fname,status='replace',err=170,form="formatted")
+
+inquire(unit=19, direct=drct, opened=opn, access=acc, unformatted=frmt)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
+
+! Inquire on filename, open file with DIRECT and UNFORMATTED
+inquire(file=fname, direct=drct, opened=opn, access=acc, UNFORMATTED=frmt)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL")  call abort
+if (frmt.ne."NO") call abort
+close(19)
+
+! Inquire on filename, closed file with DIRECT and UNFORMATTED
+inquire(file=fname, direct=drct, opened=opn, access=acc, unformatted=frmt)
+if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
+if (frmt.ne."UNKNOWN") call abort
+
+open(unit=19,file=fname,status='replace',err=170,form="unformatted")
+
+inquire(unit=19, direct=drct, opened=opn, access=acc,unformatted=frmt)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
+if (frmt.ne."YES")  call abort
+close(19)
+      
+open(unit=19,file=fname,status='replace',err=170)
+
+inquire(unit=19, direct=drct, opened=opn, access=acc)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
+close(19)
+
+open(unit=19,file=fname,status='replace',err=170,access='SEQUENTIAL')
+
+inquire(unit=19, direct=drct, opened=opn, access=acc)
+if (drct.ne."NO" .and. .not.opn .and. acc.ne."SEQUENTIAL") call abort
+
+! Inquire on filename, open file with SEQUENTIAL
+inquire(file=fname, SEQUENTIAL=seqn, opened=opn, access=acc)
+if (seqn.ne."YES" .and. .not.opn .and. acc.ne."DIRECT") call abort
+close(19)
+
+! Inquire on filename, closed file with SEQUENTIAL
+inquire(file=fname, SEQUENTIAL=seqn, opened=opn, access=acc)
+if (seqn.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
+
+open(unit=19,file=fname,status='replace',err=170,form='UNFORMATTED',access='DIRECT',recl=72)
+
+inquire(unit=19, direct=drct, opened=opn, access=acc)
+if (drct.ne."YES" .and. .not.opn .and. acc.ne."DIRECT") call abort
+
+! Inquire on filename, open file with DIRECT
+inquire(file=fname, direct=drct, opened=opn, access=acc)
+if (drct.ne."YES" .and. .not.opn .and. acc.ne."DIRECT") call abort
+close(19, status="delete")
+
+! Inquire on filename, closed file with DIRECT
+inquire(file=fname, direct=drct, opened=opn, access=acc)
+if (drct.ne."UNKNOWN" .and. opn .and. acc.ne."UNDEFINED") call abort
+stop
+
+170   write(*,*) "ERROR: unable to open testdirect.f"
+end
diff --git a/gcc/testsuite/gfortran.dg/inquire_14.f90 b/gcc/testsuite/gfortran.dg/inquire_14.f90
new file mode 100644
index 000000000..edc9bf388
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquire_14.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! PR47583 Inquire affected by previous read.
+subroutine input(indat)
+   real indat(:)
+   read(*,*) indat
+end subroutine input
+
+subroutine abc(sizedat)
+   real, intent(in) :: sizedat(:)
+   integer :: rl
+   inquire(iolength=rl) sizedat
+   write(*,*) rl
+end subroutine abc
diff --git a/gcc/testsuite/gfortran.dg/inquire_5.f90 b/gcc/testsuite/gfortran.dg/inquire_5.f90
new file mode 100644
index 000000000..fe107a198
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquire_5.f90
@@ -0,0 +1,39 @@
+! { dg-do run { target fd_truncate } }
+! { dg-options "-std=legacy" }
+!
+! pr19314 inquire(..position=..) segfaults
+! test by Thomas.Koenig@online.de
+!         bdavis9659@comcast.net
+      implicit none
+      character*20 chr
+      open(7,STATUS='SCRATCH')
+      inquire(7,position=chr)
+      if (chr.NE.'ASIS') CALL ABORT
+      close(7)
+      open(7,STATUS='SCRATCH',ACCESS='DIRECT',RECL=100)
+      inquire(7,position=chr)
+      if (chr.NE.'UNDEFINED') CALL ABORT
+      close(7)
+      open(7,STATUS='SCRATCH',POSITION='REWIND')
+      inquire(7,position=chr)
+      if (chr.NE.'REWIND') CALL ABORT
+      close(7)
+      open(7,STATUS='SCRATCH',POSITION='ASIS')
+      inquire(7,position=chr)
+      if (chr.NE.'ASIS') CALL ABORT
+      close(7)
+      open(7,STATUS='SCRATCH',POSITION='APPEND')
+      inquire(7,position=chr)
+      if (chr.NE.'APPEND') CALL ABORT
+      close(7)
+      open(7,STATUS='SCRATCH',POSITION='REWIND')
+      write(7,*)'this is a record written to the file'
+      write(7,*)'this is another record'
+      backspace(7)
+      inquire(7,position=chr)
+      if (chr.NE.'ASIS') CALL ABORT
+      rewind(7)
+      inquire(7,position=chr)
+      if (chr.NE.'REWIND') CALL ABORT
+      close(7)
+      end
diff --git a/gcc/testsuite/gfortran.dg/inquire_6.f90 b/gcc/testsuite/gfortran.dg/inquire_6.f90
new file mode 100644
index 000000000..b657df831
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquire_6.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+!pr19313 - inquire(..pad=..)
+      implicit none
+!     logical debug
+!     data debug /.TRUE./
+      character*20 chr
+      chr=''
+!  not connected 
+      inquire(7,pad=chr)
+!     if (debug) print*,chr
+      if (chr.ne.'UNDEFINED') call abort
+      chr=''
+!  not a formatted file
+      open(7,FORM='UNFORMATTED',STATUS='SCRATCH')
+      inquire(7,pad=chr)
+!     if (debug) print*,chr
+      if (chr.ne.'UNDEFINED') call abort
+      chr=''
+! yes
+      open(8,STATUS='SCRATCH',PAD='YES')
+      inquire(8,pad=chr)
+!     if (debug) print*,chr
+      if (chr.ne.'YES') call abort
+      chr=''
+! no
+      open(9,STATUS='SCRATCH',PAD='NO')
+      inquire(9,pad=chr)
+!     if (debug) print*,chr
+      if (chr.ne.'NO') call abort
+      chr=''
+      end
diff --git a/gcc/testsuite/gfortran.dg/inquire_7.f90 b/gcc/testsuite/gfortran.dg/inquire_7.f90
new file mode 100644
index 000000000..02e96ab4d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquire_7.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! pr 19647 / segfault on inquire(..pad=..)
+!   Thomas.Koenig@online.de
+!   bdavis9659@comcast.net
+       program main
+       character(len=10) delim
+! quote
+       open(10,delim='quote',status='SCRATCH')
+       inquire(10,delim=delim)
+       close(10)
+       if (delim .ne. 'QUOTE') call abort
+! apostrophe
+       open(10,delim='apostrophe',status='SCRATCH')
+       inquire(10,delim=delim)
+       close(10)
+       if (delim .ne. 'APOSTROPHE') call abort
+! none
+       open(10,status='SCRATCH')
+       inquire(10,delim=delim)
+       close(10)
+       if (delim .ne. 'NONE') call abort
+! undefined
+       open(10,form='UNFORMATTED',status='SCRATCH')
+       inquire(10,delim=delim)
+       close(10)
+       if (delim .ne. 'UNDEFINED') call abort
+       end program main
diff --git a/gcc/testsuite/gfortran.dg/inquire_8.f90 b/gcc/testsuite/gfortran.dg/inquire_8.f90
new file mode 100644
index 000000000..1d30973b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquire_8.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! fortran/pr20846
+program inquire_8
+  character(len=20) :: n = 'data'
+  integer :: d = 23
+  logical a
+  inquire(file=n,unit=d,opened=a) ! { dg-error "contain both FILE and UNIT" }
+  inquire(unit=d,file=n,opened=a) ! { dg-error "contain both FILE and UNIT" }
+  inquire(opened=a)               ! { dg-error "requires either FILE or UNIT" }
+end program inquire_8
diff --git a/gcc/testsuite/gfortran.dg/inquire_9.f90 b/gcc/testsuite/gfortran.dg/inquire_9.f90
new file mode 100644
index 000000000..99cd1af19
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquire_9.f90
@@ -0,0 +1,24 @@
+! PR fortran/24774
+! { dg-do run }
+  logical :: l
+  l = .true.
+  inquire (file='inquire_9 file that should not exist', exist=l)
+  if (l) call abort
+  l = .true.
+  inquire (unit=-16, exist=l)
+  if (l) call abort
+  open (unit=16, file='inquire_9.tst')
+  write (unit=16, fmt='(a)') 'Test'
+  l = .false.
+  inquire (unit=16, exist=l)
+  if (.not.l) call abort
+  l = .false.
+  inquire (file='inquire_9.tst', exist=l)
+  if (.not.l) call abort
+  close (unit=16)
+  l = .false.
+  inquire (file='inquire_9.tst', exist=l)
+  if (.not.l) call abort
+  open (unit=16, file='inquire_9.tst')
+  close (unit=16, status='delete')
+end
diff --git a/gcc/testsuite/gfortran.dg/inquire_iolength.f90 b/gcc/testsuite/gfortran.dg/inquire_iolength.f90
new file mode 100644
index 000000000..b6dfee249
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquire_iolength.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! PR30014 IOLENGTH does not handle KIND=8.  This patch checks the constraints.
+! Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+! F95 Standard 9.6, R923
+integer (kind=4) small, x
+integer (kind=8) large
+inquire (iolength=small) x
+inquire (iolength=large) x ! { dg-error "requires default INTEGER" }
+end
diff --git a/gcc/testsuite/gfortran.dg/inquire_size.f90 b/gcc/testsuite/gfortran.dg/inquire_size.f90
new file mode 100644
index 000000000..568c3d6a0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquire_size.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! PR43409 I/O: INQUIRE for SIZE does not work.
+integer :: i
+character(30) :: aname = "noname"
+logical :: is_named
+
+open(25, file="testfile", status="replace", access="stream", form="unformatted")
+do i=1,100
+  write(25) i, "abcdefghijklmnopqrstuvwxyz"
+enddo
+flush(25)
+
+inquire(unit=25, named=is_named, name=aname, size=i)
+if (.not.is_named) call abort
+if (aname /= "testfile") call abort
+if (i /= 3000) call abort
+
+inquire(file="testfile", size=i)
+if (.not.is_named) call abort
+if (aname /= "testfile") call abort
+if (i /= 3000) call abort
+
+close(25, status="delete")
+inquire(file="testfile", size=i)
+if (i /= -1)  call abort
+end
+
+
diff --git a/gcc/testsuite/gfortran.dg/int_1.f90 b/gcc/testsuite/gfortran.dg/int_1.f90
new file mode 100644
index 000000000..853578e26
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/int_1.f90
@@ -0,0 +1,175 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+!
+! 13.7.53    INT(A [, KIND])
+!
+! Description.  Convert to integer type.
+! Class.       Elemental function.
+! Arguments.
+!    A               shall be of type integer, real, or complex,
+!                    or a boz-literal-constant .
+!    KIND (optional) shall be a scalar integer initialization expression.
+!
+! Result Characteristics. Integer. If KIND is present, the kind type
+!    parameter is that specified by the value of KIND; otherwise, the
+!    kind type parameter is that of default integer type.
+!
+! Result Value.
+!
+!    Case (1):  If A is of type integer, INT (A) = A.
+!
+!    Case (2):  If A is of type real, there are two cases:
+!      (a) if |A| < 1, INT (A) has the value 0
+!      (b) if |A| .ge. 1, INT (A) is the integer whose magnitude is the
+!          largest integer that does not exceed the magnitude of A and
+!          whose sign is the same as the sign of A.
+!
+!    Case (3):  If A is of type complex, INT(A) = INT(REAL(A, KIND(A))).
+!
+!    Case (4):  If A is a boz-literal-constant, it is treated as if it were
+!               an int-literal-constant with a kind-param that specifies the
+!               representation method with the largest decimal exponent range
+!               supported by the processor.
+!
+!    Example. INT (­3.7) has the value ­3.
+!
+module mykinds
+   integer, parameter :: ik1 = selected_int_kind(2)
+   integer, parameter :: ik2 = selected_int_kind(4)
+   integer, parameter :: ik4 = selected_int_kind(9)
+   integer, parameter :: ik8 = selected_int_kind(18)
+   integer, parameter :: sp = selected_real_kind(6,30)
+   integer, parameter :: dp = selected_real_kind(15,300)
+   integer, parameter :: ck = kind('a')
+end module mykinds
+
+program test_int
+
+   use mykinds
+
+   integer(ik1) i1
+   integer(ik2) i2
+   integer(ik4) i4
+   integer(ik8) i8
+   real(sp) r4
+   real(dp) r8
+   complex(sp) c4
+   complex(dp) c8
+   !
+   ! Case 1
+   !
+   i1 = int(-3)
+   i2 = int(-3)
+   i4 = int(-3)
+   i8 = int(-3)
+   if (i1 /= -3_ik1 .or. i2 /= -3_ik2) call abort
+   if (i4 /= -3_ik4 .or. i8 /= -3_ik8) call abort
+
+   i1 = int(5,  ik1)
+   i2 = int(i1, ik2)
+   i4 = int(i1, ik4)
+   i8 = int(i1, ik8)
+   if (i1 /= 5_ik1 .or. i2 /= 5_ik2) call abort
+   if (i4 /= 5_ik4 .or. i8 /= 5_ik8) call abort
+
+   i8 = int(10, ik8)
+   i1 = int(i8, ik1)
+   i2 = int(i8, ik2)
+   i4 = int(i8, ik4)
+   if (i1 /= 10_ik1 .or. i2 /= 10_ik2) call abort
+   if (i4 /= 10_ik4 .or. i8 /= 10_ik8) call abort
+   !
+   ! case 2(b)
+   !
+   r4 = -3.7_sp
+   i1 = int(r4,  ik1)
+   i2 = int(r4, ik2)
+   i4 = int(r4, ik4)
+   i8 = int(r4, ik8)
+   if (i1 /= -3_ik1 .or. i2 /= -3_ik2) call abort
+   if (i4 /= -3_ik4 .or. i8 /= -3_ik8) call abort
+
+   r8 = -3.7_dp
+   i1 = int(r8,  ik1)
+   i2 = int(r8, ik2)
+   i4 = int(r8, ik4)
+   i8 = int(r8, ik8)
+   if (i1 /= -3_ik1 .or. i2 /= -3_ik2) call abort
+   if (i4 /= -3_ik4 .or. i8 /= -3_ik8) call abort
+   !
+   ! Case 2(a)
+   !
+   r4 = -3.7E-1_sp
+   i1 = int(r4, ik1)
+   i2 = int(r4, ik2)
+   i4 = int(r4, ik4)
+   i8 = int(r4, ik8)
+   if (i1 /= 0_ik1 .or. i2 /= 0_ik2) call abort
+   if (i4 /= 0_ik4 .or. i8 /= 0_ik8) call abort
+
+   r8 = -3.7E-1_dp
+   i1 = int(r8, ik1)
+   i2 = int(r8, ik2)
+   i4 = int(r8, ik4)
+   i8 = int(r8, ik8)
+   if (i1 /= 0_ik1 .or. i2 /= 0_ik2) call abort
+   if (i4 /= 0_ik4 .or. i8 /= 0_ik8) call abort
+   !
+   ! Case 3
+   !
+   c4 = (-3.7E-1_sp,3.7E-1_sp)
+   i1 = int(c4, ik1)
+   i2 = int(c4, ik2)
+   i4 = int(c4, ik4)
+   i8 = int(c4, ik8)
+   if (i1 /= 0_ik1 .or. i2 /= 0_ik2) call abort
+   if (i4 /= 0_ik4 .or. i8 /= 0_ik8) call abort
+
+   c8 = (-3.7E-1_dp,3.7E-1_dp)
+   i1 = int(c8, ik1)
+   i2 = int(c8, ik2)
+   i4 = int(c8, ik4)
+   i8 = int(c8, ik8)
+   if (i1 /= 0_ik1 .or. i2 /= 0_ik2) call abort
+   if (i4 /= 0_ik4 .or. i8 /= 0_ik8) call abort
+
+   c4 = (-3.7_sp,3.7_sp)
+   i1 = int(c4, ik1)
+   i2 = int(c4, ik2)
+   i4 = int(c4, ik4)
+   i8 = int(c4, ik8)
+   if (i1 /= -3_ik1 .or. i2 /= -3_ik2) call abort
+   if (i4 /= -3_ik4 .or. i8 /= -3_ik8) call abort
+
+   c8 = (3.7_dp,3.7_dp)
+   i1 = int(c8, ik1)
+   i2 = int(c8, ik2)
+   i4 = int(c8, ik4)
+   i8 = int(c8, ik8)
+   if (i1 /= 3_ik1 .or. i2 /= 3_ik2) call abort
+   if (i4 /= 3_ik4 .or. i8 /= 3_ik8) call abort
+   !
+   ! Case 4
+   !
+   i1 = int(b'0011', ik1)
+   i2 = int(b'0011', ik2)
+   i4 = int(b'0011', ik4)
+   i8 = int(b'0011', ik8)
+   if (i1 /= 3_ik1 .or. i2 /= 3_ik2) call abort
+   if (i4 /= 3_ik4 .or. i8 /= 3_ik8) call abort
+   i1 = int(o'0011', ik1)
+   i2 = int(o'0011', ik2)
+   i4 = int(o'0011', ik4)
+   i8 = int(o'0011', ik8)
+   if (i1 /= 9_ik1 .or. i2 /= 9_ik2) call abort
+   if (i4 /= 9_ik4 .or. i8 /= 9_ik8) call abort
+   i1 = int(z'0011', ik1)
+   i2 = int(z'0011', ik2)
+   i4 = int(z'0011', ik4)
+   i8 = int(z'0011', ik8)
+   if (i1 /= 17_ik1 .or. i2 /= 17_ik2) call abort
+   if (i4 /= 17_ik4 .or. i8 /= 17_ik8) call abort
+   
+end program test_int
+
+! { dg-final { cleanup-modules "mykinds" } }
diff --git a/gcc/testsuite/gfortran.dg/int_2.f90 b/gcc/testsuite/gfortran.dg/int_2.f90
new file mode 100644
index 000000000..b9a3ec43d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/int_2.f90
@@ -0,0 +1,28 @@
+! PR fortran/32823
+! { dg-do compile }
+! { dg-final { cleanup-modules "token_module" } }
+
+module token_module
+
+      integer,     parameter :: INT8  = SELECTED_INT_KIND(16)
+      integer,     parameter :: REAL8 = SELECTED_REAL_KIND(12)
+
+contains
+      subroutine token_allreduce_i8_v(dowhat, array, result, length)
+
+
+        character(*),  intent(in)    :: dowhat
+        integer,       intent(in)    :: length
+        integer(INT8), intent(in)    :: array(*)
+        integer(INT8), intent(inout) :: result(*)
+
+
+        real(REAL8) :: copy_r8(length), result_r8(length)
+
+
+          result(1:length) = int(result_r8(1:length), INT8)
+
+
+      end subroutine token_allreduce_i8_v
+
+end module token_module
diff --git a/gcc/testsuite/gfortran.dg/int_3.f90 b/gcc/testsuite/gfortran.dg/int_3.f90
new file mode 100644
index 000000000..689beef4b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/int_3.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+subroutine bug1
+  integer, parameter :: ik1 = 1, ik2 = 2
+  integer, parameter :: i = kind(int((0.,0.), kind=ik1))
+  integer, parameter :: j = kind(int((0.,0.), kind=ik2))
+  integer, parameter :: k = kind(int(0.,      kind=ik1))
+  integer, parameter :: l = kind(int(0.,      kind=ik2))
+  integer, parameter :: m = kind(int(0,       kind=ik1))
+  integer, parameter :: n = kind(int(0,       kind=ik2))
+end subroutine bug1
diff --git a/gcc/testsuite/gfortran.dg/int_conv_1.f90 b/gcc/testsuite/gfortran.dg/int_conv_1.f90
new file mode 100644
index 000000000..15f71f933
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/int_conv_1.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+  integer(kind=2) :: i2, j2, k2, l2, m2, n2, o2
+  integer(kind=4) :: i4, j4
+  integer(kind=8) :: i8, j8
+  real :: x
+  complex :: z
+
+  i2 = huge(i2) / 3
+  i8 = int8(i2)
+  i4 = long(i2)
+  j2 = short(i2)
+  k2 = int2(i2)
+  l2 = int2(i8)
+  m2 = short(i8)
+  n2 = int2(i4)
+  o2 = short(i4)
+
+  if (i8 /= i2 .or. i4 /= i2 .or. j2 /= i2 .or. k2 /= i2 &
+      .or. l2 /= i2 .or. m2 /= i2 .or. n2 /= i2 .or. o2 /= i2) call abort
+
+  x = i2
+  i8 = int8(x)
+  i4 = long(x)
+  j2 = short(x)
+  k2 = int2(x)
+  if (i8 /= i2 .or. i4 /= i2 .or. j2 /= i2 .or. k2 /= i2) call abort
+
+  z = i2 + (0.,-42.)
+  i8 = int8(z)
+  i4 = long(z)
+  j2 = short(z)
+  k2 = int2(z)
+  if (i8 /= i2 .or. i4 /= i2 .or. j2 /= i2 .or. k2 /= i2) call abort
+
+  end
diff --git a/gcc/testsuite/gfortran.dg/int_conv_2.f90 b/gcc/testsuite/gfortran.dg/int_conv_2.f90
new file mode 100644
index 000000000..ed7a5f4cd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/int_conv_2.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+! PR fortran/37930
+program test
+  implicit none
+  integer i
+  i = transfer(-1,1.0) ! { dg-error "Conversion" }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/integer_exponentiation_1.f90 b/gcc/testsuite/gfortran.dg/integer_exponentiation_1.f90
new file mode 100644
index 000000000..4dcb3a44c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/integer_exponentiation_1.f90
@@ -0,0 +1,7 @@
+! { dg-do run }
+! { dg-add-options ieee }
+! PR 30981 - this used to go into an endless loop during execution.
+program test
+  a = 3.0
+  b = a**(-2147483647_4-1_4) ! { dg-warning "Integer outside symmetric range" }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/integer_exponentiation_2.f90 b/gcc/testsuite/gfortran.dg/integer_exponentiation_2.f90
new file mode 100644
index 000000000..d55f70c9a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/integer_exponentiation_2.f90
@@ -0,0 +1,254 @@
+! { dg-do run }
+! { dg-options "" }
+! Test various exponentations
+! initially designed for patch to PR31120
+
+program test
+  call run_me (1.0, 1, (1.0,0.0))
+  call run_me (-1.1, -1, (0.0,-1.0))
+  call run_me (42.0, 12, (1.0,7.0))
+end program test
+
+! This subroutine is for runtime tests
+subroutine run_me(a, i, z)
+  implicit none
+
+  real, intent(in) :: a
+  integer, intent(in) :: i
+  complex, intent(in) :: z
+
+  call check_equal_i (i**0, 1)
+  call check_equal_i (i**1, i)
+  call check_equal_i (i**2, i*i)
+  call check_equal_i (i**3, i*(i**2))
+
+  ! i has default integer kind.
+  call check_equal_i (int(i**0_8,kind=kind(i)), 1)
+  call check_equal_i (int(i**1_8,kind=kind(i)), i)
+  call check_equal_i (int(i**2_8,kind=kind(i)), i*i)
+  call check_equal_i (int(i**3_8,kind=kind(i)), i*i*i)
+
+  call check_equal_r (a**0.0, 1.0)
+  call check_equal_r (a**1.0, a)
+  call check_equal_r (a**2.0, a*a)
+  call check_equal_r (a**3.0, a*(a**2))
+  call check_equal_r (a**(-1.0), 1/a)
+  call check_equal_r (a**(-2.0), (1/a)*(1/a))
+
+  call check_equal_r (a**0, 1.0)
+  call check_equal_r (a**1, a)
+  call check_equal_r (a**2, a*a)
+  call check_equal_r (a**3, a*(a**2))
+  call check_equal_r (a**(-1), 1/a)
+  call check_equal_r (a**(-2), (1/a)*(1/a))
+
+  call check_equal_r (a**0_8, 1.0)
+  call check_equal_r (a**1_8, a)
+  call check_equal_r (a**2_8, a*a)
+  call check_equal_r (a**3_8, a*(a**2))
+  call check_equal_r (a**(-1_8), 1/a)
+  call check_equal_r (a**(-2_8), (1/a)*(1/a))
+
+  call check_equal_c (z**0.0, (1.0,0.0))
+  call check_equal_c (z**1.0, z)
+  call check_equal_c (z**2.0, z*z)
+  call check_equal_c (z**3.0, z*(z**2))
+  call check_equal_c (z**(-1.0), 1/z)
+  call check_equal_c (z**(-2.0), (1/z)*(1/z))
+
+  call check_equal_c (z**(0.0,0.0), (1.0,0.0))
+  call check_equal_c (z**(1.0,0.0), z)
+  call check_equal_c (z**(2.0,0.0), z*z)
+  call check_equal_c (z**(3.0,0.0), z*(z**2))
+  call check_equal_c (z**(-1.0,0.0), 1/z)
+  call check_equal_c (z**(-2.0,0.0), (1/z)*(1/z))
+
+  call check_equal_c (z**0, (1.0,0.0))
+  call check_equal_c (z**1, z)
+  call check_equal_c (z**2, z*z)
+  call check_equal_c (z**3, z*(z**2))
+  call check_equal_c (z**(-1), 1/z)
+  call check_equal_c (z**(-2), (1/z)*(1/z))
+
+  call check_equal_c (z**0_8, (1.0,0.0))
+  call check_equal_c (z**1_8, z)
+  call check_equal_c (z**2_8, z*z)
+  call check_equal_c (z**3_8, z*(z**2))
+  call check_equal_c (z**(-1_8), 1/z)
+  call check_equal_c (z**(-2_8), (1/z)*(1/z))
+
+
+contains
+
+  subroutine check_equal_r (a, b)
+    real, intent(in) :: a, b
+    if (abs(a - b) > 1.e-5 * abs(b)) call abort
+  end subroutine check_equal_r
+
+  subroutine check_equal_c (a, b)
+    complex, intent(in) :: a, b
+    if (abs(a - b) > 1.e-5 * abs(b)) call abort
+  end subroutine check_equal_c
+
+  subroutine check_equal_i (a, b)
+    integer, intent(in) :: a, b
+    if (a /= b) call abort
+  end subroutine check_equal_i
+
+end subroutine run_me
+
+! subroutine foo is used for compilation test only
+subroutine foo(a)
+  implicit none
+
+  real, intent(in) :: a
+  integer :: i
+  complex :: z
+
+  ! Integer
+  call gee_i(i**0_1)
+  call gee_i(i**1_1)
+  call gee_i(i**2_1)
+  call gee_i(i**3_1)
+  call gee_i(i**(-1_1))
+  call gee_i(i**(-2_1))
+  call gee_i(i**(-3_1))
+  call gee_i(i**huge(0_1))
+  call gee_i(i**(-huge(0_1)))
+  call gee_i(i**(-huge(0_1)-1_1))
+
+  call gee_i(i**0_2)
+  call gee_i(i**1_2)
+  call gee_i(i**2_2)
+  call gee_i(i**3_2)
+  call gee_i(i**(-1_2))
+  call gee_i(i**(-2_2))
+  call gee_i(i**(-3_2))
+  call gee_i(i**huge(0_2))
+  call gee_i(i**(-huge(0_2)))
+  call gee_i(i**(-huge(0_2)-1_2))
+
+  call gee_i(i**0_4)
+  call gee_i(i**1_4)
+  call gee_i(i**2_4)
+  call gee_i(i**3_4)
+  call gee_i(i**(-1_4))
+  call gee_i(i**(-2_4))
+  call gee_i(i**(-3_4))
+  call gee_i(i**huge(0_4))
+  call gee_i(i**(-huge(0_4)))
+  call gee_i(i**(-huge(0_4)-1_4))
+
+  call gee_i(i**0_8) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**1_8) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**2_8) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**3_8) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**(-1_8)) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**(-2_8)) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**(-3_8)) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**huge(0_8)) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**(-huge(0_8))) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**(-huge(0_8)-1_8)) ! { dg-warning "Type mismatch in argument" }
+
+  ! Real
+  call gee_r(a**0_1)
+  call gee_r(a**1_1)
+  call gee_r(a**2_1)
+  call gee_r(a**3_1)
+  call gee_r(a**(-1_1))
+  call gee_r(a**(-2_1))
+  call gee_r(a**(-3_1))
+  call gee_r(a**huge(0_1))
+  call gee_r(a**(-huge(0_1)))
+  call gee_r(a**(-huge(0_1)-1_1))
+
+  call gee_r(a**0_2)
+  call gee_r(a**1_2)
+  call gee_r(a**2_2)
+  call gee_r(a**3_2)
+  call gee_r(a**(-1_2))
+  call gee_r(a**(-2_2))
+  call gee_r(a**(-3_2))
+  call gee_r(a**huge(0_2))
+  call gee_r(a**(-huge(0_2)))
+  call gee_r(a**(-huge(0_2)-1_2))
+
+  call gee_r(a**0_4)
+  call gee_r(a**1_4)
+  call gee_r(a**2_4)
+  call gee_r(a**3_4)
+  call gee_r(a**(-1_4))
+  call gee_r(a**(-2_4))
+  call gee_r(a**(-3_4))
+  call gee_r(a**huge(0_4))
+  call gee_r(a**(-huge(0_4)))
+  call gee_r(a**(-huge(0_4)-1_4))
+
+  call gee_r(a**0_8)
+  call gee_r(a**1_8)
+  call gee_r(a**2_8)
+  call gee_r(a**3_8)
+  call gee_r(a**(-1_8))
+  call gee_r(a**(-2_8))
+  call gee_r(a**(-3_8))
+  call gee_r(a**huge(0_8))
+  call gee_r(a**(-huge(0_8)))
+  call gee_r(a**(-huge(0_8)-1_8))
+
+  ! Complex
+  call gee_z(z**0_1)
+  call gee_z(z**1_1)
+  call gee_z(z**2_1)
+  call gee_z(z**3_1)
+  call gee_z(z**(-1_1))
+  call gee_z(z**(-2_1))
+  call gee_z(z**(-3_1))
+  call gee_z(z**huge(0_1))
+  call gee_z(z**(-huge(0_1)))
+  call gee_z(z**(-huge(0_1)-1_1))
+
+  call gee_z(z**0_2)
+  call gee_z(z**1_2)
+  call gee_z(z**2_2)
+  call gee_z(z**3_2)
+  call gee_z(z**(-1_2))
+  call gee_z(z**(-2_2))
+  call gee_z(z**(-3_2))
+  call gee_z(z**huge(0_2))
+  call gee_z(z**(-huge(0_2)))
+  call gee_z(z**(-huge(0_2)-1_2))
+
+  call gee_z(z**0_4)
+  call gee_z(z**1_4)
+  call gee_z(z**2_4)
+  call gee_z(z**3_4)
+  call gee_z(z**(-1_4))
+  call gee_z(z**(-2_4))
+  call gee_z(z**(-3_4))
+  call gee_z(z**huge(0_4))
+  call gee_z(z**(-huge(0_4)))
+  call gee_z(z**(-huge(0_4)-1_4))
+
+  call gee_z(z**0_8)
+  call gee_z(z**1_8)
+  call gee_z(z**2_8)
+  call gee_z(z**3_8)
+  call gee_z(z**(-1_8))
+  call gee_z(z**(-2_8))
+  call gee_z(z**(-3_8))
+  call gee_z(z**huge(0_8))
+  call gee_z(z**(-huge(0_8)))
+  call gee_z(z**(-huge(0_8)-1_8))
+end subroutine foo
+
+subroutine gee_i(i)
+  integer :: i
+end subroutine gee_i
+
+subroutine gee_r(r)
+  real :: r
+end subroutine gee_r
+
+subroutine gee_z(c)
+  complex :: c
+end subroutine gee_z
diff --git a/gcc/testsuite/gfortran.dg/integer_exponentiation_3.F90 b/gcc/testsuite/gfortran.dg/integer_exponentiation_3.F90
new file mode 100644
index 000000000..5c6c5bfe5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/integer_exponentiation_3.F90
@@ -0,0 +1,205 @@
+! { dg-do run { xfail spu-*-* } }
+! FAILs on SPU because of wrong compile-time rounding mode
+! { dg-options "" }
+! { dg-options "-ffloat-store" { target { { i?86-*-* x86_64-*-* } && ilp32 } } } 
+!
+!
+module mod_check
+  implicit none
+
+  interface check
+    module procedure check_i8
+    module procedure check_i4
+    module procedure check_r8
+    module procedure check_r4
+    module procedure check_c8
+    module procedure check_c4
+  end interface check
+
+  interface acheck
+    module procedure acheck_c8
+    module procedure acheck_c4
+  end interface acheck
+
+contains
+
+  subroutine check_i8 (a, b)
+    integer(kind=8), intent(in) :: a, b
+    if (a /= b) call abort()
+  end subroutine check_i8
+
+  subroutine check_i4 (a, b)
+    integer(kind=4), intent(in) :: a, b
+    if (a /= b) call abort()
+  end subroutine check_i4
+
+  subroutine check_r8 (a, b)
+    real(kind=8), intent(in) :: a, b
+    if (a /= b) call abort()
+  end subroutine check_r8
+
+  subroutine check_r4 (a, b)
+    real(kind=4), intent(in) :: a, b
+    if (a /= b) call abort()
+  end subroutine check_r4
+
+  subroutine check_c8 (a, b)
+    complex(kind=8), intent(in) :: a, b
+    if (a /= b) call abort()
+  end subroutine check_c8
+
+  subroutine check_c4 (a, b)
+    complex(kind=4), intent(in) :: a, b
+    if (a /= b) call abort()
+  end subroutine check_c4
+
+  subroutine acheck_c8 (a, b)
+    complex(kind=8), intent(in) :: a, b
+    if (abs(a-b) > 1.d-9 * min(abs(a),abs(b))) call abort()
+  end subroutine acheck_c8
+
+  subroutine acheck_c4 (a, b)
+    complex(kind=4), intent(in) :: a, b
+    if (abs(a-b) > 1.e-5 * min(abs(a),abs(b))) call abort()
+  end subroutine acheck_c4
+
+end module mod_check
+
+program test
+  use mod_check
+  implicit none
+
+  integer(kind=4) :: i4
+  integer(kind=8) :: i8
+  real(kind=4) :: r4
+  real(kind=8) :: r8
+  complex(kind=4) :: c4
+  complex(kind=8) :: c8
+
+#define TEST(base,exp,var) var = base; call check((var)**(exp),(base)**(exp))
+#define ATEST(base,exp,var) var = base; call acheck((var)**(exp),(base)**(exp))
+
+!!!!! INTEGER BASE !!!!!
+  TEST(0,0,i4)
+  TEST(0_8,0_8,i8)
+  TEST(1,0,i4)
+  TEST(1_8,0_8,i8)
+  TEST(-1,0,i4)
+  TEST(-1_8,0_8,i8)
+  TEST(huge(0_4),0,i4)
+  TEST(huge(0_8),0_8,i8)
+  TEST(-huge(0_4)-1,0,i4)
+  TEST(-huge(0_8)-1_8,0_8,i8)
+
+  TEST(1,1,i4)
+  TEST(1_8,1_8,i8)
+  TEST(1,2,i4)
+  TEST(1_8,2_8,i8)
+  TEST(1,-1,i4)
+  TEST(1_8,-1_8,i8)
+  TEST(1,-2,i4)
+  TEST(1_8,-2_8,i8)
+  TEST(1,huge(0),i4)
+  TEST(1_8,huge(0_8),i8)
+  TEST(1,-huge(0)-1,i4)
+  TEST(1_8,-huge(0_8)-1_8,i8)
+
+  TEST(-1,1,i4)
+  TEST(-1_8,1_8,i8)
+  TEST(-1,2,i4)
+  TEST(-1_8,2_8,i8)
+  TEST(-1,-1,i4)
+  TEST(-1_8,-1_8,i8)
+  TEST(-1,-2,i4)
+  TEST(-1_8,-2_8,i8)
+  TEST(-1,huge(0),i4)
+  TEST(-1_8,huge(0_8),i8)
+  TEST(-1,-huge(0)-1,i4)
+  TEST(-1_8,-huge(0_8)-1_8,i8)
+
+  TEST(2,9,i4)
+  TEST(2_8,9_8,i8)
+  TEST(-2,9,i4)
+  TEST(-2_8,9_8,i8)
+  TEST(2,-9,i4)
+  TEST(2_8,-9_8,i8)
+  TEST(-2,-9,i4)
+  TEST(-2_8,-9_8,i8)
+
+!!!!! REAL BASE !!!!!
+  TEST(0.0,0,r4)
+  TEST(0.0,1,r4)
+  TEST(0.0,huge(0),r4)
+  TEST(0.0,0_8,r4)
+  TEST(0.0,1_8,r4)
+  TEST(0.0,huge(0_8),r4)
+
+  TEST(1.0,0,r4)
+  TEST(1.0,1,r4)
+  TEST(1.0,-1,r4)
+  TEST(1.0,huge(0),r4)
+  TEST(1.0,-huge(0)-1,r4)
+  TEST(1.0,0_8,r4)
+  TEST(1.0,1_8,r4)
+  TEST(1.0,-1_8,r4)
+  TEST(1.0,huge(0_8),r4)
+  TEST(1.0,-huge(0_8)-1_8,r4)
+
+  TEST(-1.0,0,r4)
+  TEST(-1.0,1,r4)
+  TEST(-1.0,-1,r4)
+  TEST(-1.0,huge(0),r4)
+  TEST(-1.0,-huge(0)-1,r4)
+  TEST(-1.0,0_8,r4)
+  TEST(-1.0,1_8,r4)
+  TEST(-1.0,-1_8,r4)
+  TEST(-1.0,huge(0_8),r4)
+  TEST(-1.0,-huge(0_8)-1_8,r4)
+
+  TEST(2.0,0,r4)
+  TEST(2.0,1,r4)
+  TEST(2.0,-1,r4)
+  TEST(2.0,3,r4)
+  TEST(2.0,-3,r4)
+  TEST(2.0,0_8,r4)
+  TEST(2.0,1_8,r4)
+  TEST(2.0,-1_8,r4)
+  TEST(2.0,3_8,r4)
+  TEST(2.0,-3_8,r4)
+
+  TEST(nearest(1.0,-1.0),0,r4)
+  TEST(nearest(1.0,-1.0),huge(0_4),r4) ! { dg-warning "Arithmetic underflow" }
+  TEST(nearest(1.0,-1.0),0_8,r4)
+  TEST(nearest(1.0_8,-1.0),huge(0_8),r8) ! { dg-warning "Arithmetic underflow" }
+
+  TEST(nearest(1.0,-1.0),107,r4)
+  TEST(nearest(1.0,1.0),107,r4)
+
+!!!!! COMPLEX BASE !!!!!
+  TEST((1.0,0.2),0,c4)
+  TEST((1.0,0.2),1,c4)
+  TEST((1.0,0.2),2,c4)
+  ATEST((1.0,0.2),9,c4)
+  ATEST((1.0,0.2),-1,c4)
+  ATEST((1.0,0.2),-2,c4)
+  ATEST((1.0,0.2),-9,c4)
+
+  TEST((0.0,0.2),0,c4)
+  TEST((0.0,0.2),1,c4)
+  TEST((0.0,0.2),2,c4)
+  ATEST((0.0,0.2),9,c4)
+  ATEST((0.0,0.2),-1,c4)
+  ATEST((0.0,0.2),-2,c4)
+  ATEST((0.0,0.2),-9,c4)
+
+  TEST((1.0,0.),0,c4)
+  TEST((1.0,0.),1,c4)
+  TEST((1.0,0.),2,c4)
+  TEST((1.0,0.),9,c4)
+  ATEST((1.0,0.),-1,c4)
+  ATEST((1.0,0.),-2,c4)
+  ATEST((1.0,0.),-9,c4)
+
+end program test
+
+! { dg-final { cleanup-modules "mod_check" } }
diff --git a/gcc/testsuite/gfortran.dg/integer_exponentiation_4.f90 b/gcc/testsuite/gfortran.dg/integer_exponentiation_4.f90
new file mode 100644
index 000000000..655f6514c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/integer_exponentiation_4.f90
@@ -0,0 +1,46 @@
+! { dg-do compile }
+! { dg-options "" }
+program test
+  implicit none
+
+!!!!!! INTEGER BASE !!!!!!
+  print *, 0**0
+  print *, 0**1
+  print *, 0**(-1) ! { dg-error "Division by zero" }
+  print *, 0**(huge(0))
+  print *, 0**(-huge(0)-1) ! { dg-error "Division by zero" }
+  print *, 0**(2_8**32)
+  print *, 0**(-(2_8**32)) ! { dg-error "Division by zero" }
+
+  print *, 1**huge(0)
+  print *, 1**(-huge(0)-1)
+  print *, 1**huge(0_8)
+  print *, 1**(-huge(0_8)-1_8)
+  print *, (-1)**huge(0)
+  print *, (-1)**(-huge(0)-1)
+  print *, (-1)**huge(0_8)
+  print *, (-1)**(-huge(0_8)-1_8)
+
+  print *, 2**huge(0) ! { dg-error "Arithmetic overflow" }
+  print *, 2**huge(0_8) ! { dg-error "Arithmetic overflow" }
+  print *, (-2)**huge(0) ! { dg-error "Arithmetic overflow" }
+  print *, (-2)**huge(0_8) ! { dg-error "Arithmetic overflow" }
+
+  print *, 2**(-huge(0)-1)
+  print *, 2**(-huge(0_8)-1_8)
+  print *, (-2)**(-huge(0)-1)
+  print *, (-2)**(-huge(0_8)-1_8)
+
+!!!!!! REAL BASE !!!!!!
+  print *, 0.0**(-1) ! { dg-error "Arithmetic overflow" }
+  print *, 0.0**(-huge(0)-1) ! { dg-error "Arithmetic overflow" }
+  print *, 2.0**huge(0) ! { dg-error "Arithmetic overflow" }
+  print *, nearest(1.0,-1.0)**(-huge(0)) ! { dg-error "Arithmetic overflow" }
+
+!!!!!! COMPLEX BASE !!!!!!
+  print *, (2.0,-4.3)**huge(0) ! { dg-error "Arithmetic overflow" }
+  print *, (2.0,-4.3)**huge(0_8) ! { dg-error "Arithmetic overflow" }
+  print *, (2.0,-4.3)**(-huge(0))
+  print *, (2.0,-4.3)**(-huge(0_8))
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/integer_exponentiation_5.F90 b/gcc/testsuite/gfortran.dg/integer_exponentiation_5.F90
new file mode 100644
index 000000000..58c7614d5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/integer_exponentiation_5.F90
@@ -0,0 +1,80 @@
+! { dg-do run { xfail spu-*-* } }
+! FAILs on SPU because of invalid result of 1.0/0.0 inline code
+! { dg-options "-fno-range-check" }
+! { dg-add-options ieee }
+module mod_check
+  implicit none
+
+  interface check
+    module procedure check_i8
+    module procedure check_i4
+    module procedure check_r8
+    module procedure check_r4
+    module procedure check_c8
+    module procedure check_c4
+  end interface check
+
+contains
+
+  subroutine check_i8 (a, b)
+    integer(kind=8), intent(in) :: a, b
+    if (a /= b) call abort()
+  end subroutine check_i8
+
+  subroutine check_i4 (a, b)
+    integer(kind=4), intent(in) :: a, b
+    if (a /= b) call abort()
+  end subroutine check_i4
+
+  subroutine check_r8 (a, b)
+    real(kind=8), intent(in) :: a, b
+    if (a /= b) call abort()
+  end subroutine check_r8
+
+  subroutine check_r4 (a, b)
+    real(kind=4), intent(in) :: a, b
+    if (a /= b) call abort()
+  end subroutine check_r4
+
+  subroutine check_c8 (a, b)
+    complex(kind=8), intent(in) :: a, b
+    if (a /= b) call abort()
+  end subroutine check_c8
+
+  subroutine check_c4 (a, b)
+    complex(kind=4), intent(in) :: a, b
+    if (a /= b) call abort()
+  end subroutine check_c4
+
+end module mod_check
+
+program test
+  use mod_check
+  implicit none
+
+  integer(kind=4) :: i4
+  integer(kind=8) :: i8
+  real(kind=4) :: r4
+  real(kind=8) :: r8
+  complex(kind=4) :: c4
+  complex(kind=8) :: c8
+
+#define TEST(base,exp,var) var = base; call check((var)**(exp),(base)**(exp))
+
+!!!!! INTEGER BASE !!!!!
+  TEST(3,23,i4)
+  TEST(-3,23,i4)
+  TEST(3_8,43_8,i8)
+  TEST(-3_8,43_8,i8)
+
+  TEST(17_8,int(huge(0_4),kind=8)+1,i8)
+
+!!!!! REAL BASE !!!!!
+  TEST(0.0,-1,r4)
+  TEST(0.0,-huge(0)-1,r4)
+  TEST(2.0,huge(0),r4)
+  TEST(nearest(1.0,-1.0),-huge(0),r4)
+
+end program test
+
+! { dg-final { cleanup-modules "mod_check" } }
diff --git a/gcc/testsuite/gfortran.dg/intent_optimize_1.f90 b/gcc/testsuite/gfortran.dg/intent_optimize_1.f90
new file mode 100644
index 000000000..dbe0128d7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_optimize_1.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-optimized" }
+!
+! Check whether the "does_not_exist" subroutine has been
+! optimized away, i.e. check that "foo"'s intent(IN) gets
+! honoured.
+!
+! PR fortran/43665
+!
+interface
+  subroutine foo(x)
+    integer, intent(in) :: x
+  end subroutine foo
+end interface
+
+integer :: y
+
+y = 5
+call foo(y)
+if (y /= 5) call does_not_exist ()
+end
+
+! { dg-final { scan-tree-dump-times "does_not_exist" 0 "optimized" } }
+! { dg-final { cleanup-tree-dump "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/intent_out_1.f90 b/gcc/testsuite/gfortran.dg/intent_out_1.f90
new file mode 100644
index 000000000..98338bf47
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_out_1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! Tests the fix for PRs 18578, 18579 and their repeats 20857 and 20885.
+! Contributed by Paul Thomas  <pault@gcc@gnu.org>
+  real, parameter :: a =42.0
+  real :: b
+  call foo(b + 2.0)    ! { dg-error "variable definition context" }
+  call foo(a)          ! { dg-error "variable definition context" }
+  call bar(b + 2.0)    ! { dg-error "variable definition context" }
+  call bar(a)          ! { dg-error "variable definition context" }
+contains
+  subroutine foo(a)
+    real, intent(out) :: a
+    a = 0.0
+  end subroutine foo
+  subroutine bar(a)
+    real, intent(INout) :: a
+    a = 0.0
+  end subroutine bar
+end
diff --git a/gcc/testsuite/gfortran.dg/intent_out_2.f90 b/gcc/testsuite/gfortran.dg/intent_out_2.f90
new file mode 100644
index 000000000..4dc5191e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_out_2.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! Tests the fix for PR33554, in which the default initialization
+! of temp, in construct_temp, caused a segfault because it was
+! being done before the array offset and lower bound were
+! available.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de> 
+!
+module gfcbug72
+  implicit none
+
+  type t_datum
+    character(len=8) :: mn = 'abcdefgh'
+  end type t_datum
+
+  type t_temp
+    type(t_datum) :: p
+  end type t_temp
+
+contains
+
+  subroutine setup ()
+    integer :: i
+    type (t_temp), pointer :: temp(:) => NULL ()
+
+    do i=1,2
+       allocate (temp (2))
+       call construct_temp (temp)
+       if (any (temp % p% mn .ne. 'ijklmnop')) call abort ()
+       deallocate (temp)
+    end do
+  end subroutine setup
+  !--
+  subroutine construct_temp (temp)
+    type (t_temp), intent(out) :: temp (:)
+    if (any (temp % p% mn .ne. 'abcdefgh')) call abort ()
+    temp(:)% p% mn = 'ijklmnop'
+  end subroutine construct_temp
+end module gfcbug72
+
+program test
+  use gfcbug72
+  implicit none
+  call setup ()
+end program test
+! { dg-final { cleanup-modules "gfcbug72" } }
+
diff --git a/gcc/testsuite/gfortran.dg/intent_out_3.f90 b/gcc/testsuite/gfortran.dg/intent_out_3.f90
new file mode 100644
index 000000000..e3300c988
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_out_3.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+!
+! PR fortran/34662
+! The INTENT error was not detected.
+! Test case contributed by Joost VandeVondele.
+!
+MODULE M1
+ TYPE T1
+  INTEGER :: I(3)
+ END TYPE T1
+ TYPE(T1), PARAMETER :: D1=T1((/1,2,3/))
+CONTAINS
+ SUBROUTINE S1(J)
+  INTEGER, INTENT(INOUT) :: J
+ END SUBROUTINE S1
+END MODULE M1
+USE M1
+CALL S1(D1%I(3)) ! { dg-error "variable definition context" }
+END
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/intent_out_4.f90 b/gcc/testsuite/gfortran.dg/intent_out_4.f90
new file mode 100644
index 000000000..93d7612e4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_out_4.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+!
+! PR fortran/34689
+!
+! The following (cf. libgomp.fortran/appendix-a/a.33.3.f90)
+! was rejected because the intent check missed a FL_FUNCTION
+! for the result variable.
+!
+function test()
+  implicit none
+  integer :: test
+  interface
+    subroutine foo(a)
+      integer, intent(inout) :: a
+    end subroutine foo
+  end interface
+  call foo(test)
+end function test
diff --git a/gcc/testsuite/gfortran.dg/intent_out_5.f90 b/gcc/testsuite/gfortran.dg/intent_out_5.f90
new file mode 100644
index 000000000..6a9c6f4bd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_out_5.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+!
+! PR fortran/41479
+!
+! Contributed by Juergen Reuter.
+!
+program main
+ type :: container_t
+    integer :: n = 42
+    ! if the following line is omitted, the problem disappears
+    integer, dimension(:), allocatable :: a
+ end type container_t
+
+ type(container_t) :: container
+
+ if (container%n /= 42) call abort()
+ if (allocated(container%a)) call abort()
+ container%n = 1
+ allocate(container%a(50))
+ call init (container)
+ if (container%n /= 42) call abort()
+ if (allocated(container%a)) call abort()
+contains
+ subroutine init (container)
+   type(container_t), intent(out) :: container
+ end subroutine init
+end program main
diff --git a/gcc/testsuite/gfortran.dg/intent_out_6.f90 b/gcc/testsuite/gfortran.dg/intent_out_6.f90
new file mode 100644
index 000000000..1a411072f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_out_6.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+!
+! PR fortran/41850
+!
+module test_module
+  implicit none
+contains
+  subroutine sub2(a)
+    implicit none
+    real,allocatable,intent(out),optional :: a(:)
+    if(present(a)) then
+      if(allocated(a)) call abort()
+      allocate(a(1))
+      a(1) = 5
+    end if
+  end subroutine sub2
+  subroutine sub1(a)
+    implicit none
+    real,allocatable,intent(out),optional :: a(:)
+!    print *,'in sub1'
+    call sub2(a)
+    if(present(a)) then
+      if(a(1) /= 5) call abort()
+    end if
+  end subroutine sub1
+end module test_module
+
+program test
+  use test_module
+  implicit none
+  real, allocatable :: x(:)
+  allocate(x(1))
+  call sub1()
+  x = 8
+  call sub1(x)
+  if(x(1) /= 5) call abort()
+end program
+
+! { dg-final { cleanup-modules "test_module" } }
diff --git a/gcc/testsuite/gfortran.dg/intent_used_1.f90 b/gcc/testsuite/gfortran.dg/intent_used_1.f90
new file mode 100644
index 000000000..ec23bf585
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_used_1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! Tests the fix for the regression caused by the patch for PR20869
+! which itself is tested and described by intrinsic_external_1.f90
+!
+! reported to the fortran list by Dominique Dhumieres  dominiq@lps.ens.fr
+
+MODULE global
+   INTERFACE
+      SUBROUTINE foo(i, j)
+      IMPLICIT NONE
+      INTEGER :: j
+      integer, DIMENSION(j,*) :: i ! This constituted usage of j and so triggered....
+      INTENT (IN) j  ! Would give "Cannot change attributes of symbol at (1) after it has been used"
+      INTENT (INOUT) i
+      END SUBROUTINE foo
+   END INTERFACE
+END MODULE global
+
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_1.f90 b/gcc/testsuite/gfortran.dg/interface_1.f90
new file mode 100644
index 000000000..e170f870e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_1.f90
@@ -0,0 +1,42 @@
+! { dg-do compile }
+! This program would segfault without the patch for PR fortran/24005.
+module y
+  !
+  ! If private statement is removed, then we get a bunch of errors
+  !
+  private f
+  !
+  ! If we rename 'f' in module y to say 'g', then gfortran correctly
+  ! identifies ambiguous as being ambiguous.
+  !
+  interface ambiguous
+    module procedure f
+  end interface
+
+  contains
+
+    real function f(a)
+      real a
+      f = a
+    end function
+
+end module y
+
+module z
+
+  use y
+
+  interface ambiguous
+    module procedure f    ! { dg-warning "in generic interface" "" }
+  end interface
+
+  contains
+
+    real function f(a)
+      real a
+      f = a
+    end function
+
+end module z
+
+! { dg-final { cleanup-modules "y z" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_10.f90 b/gcc/testsuite/gfortran.dg/interface_10.f90
new file mode 100644
index 000000000..99ecc8c85
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_10.f90
@@ -0,0 +1,57 @@
+! { dg-do compile }
+! PR fortran/30683
+! Code contributed by Salvatore Filippone.
+!
+module class_fld
+   integer, parameter :: int_ = 1
+  integer, parameter :: bnd_ = 2
+  type fld
+     integer                 :: size(2)
+  end type fld
+  !
+  !  This interface is extending the SIZE intrinsic procedure,  
+  !  which led to a segmentation fault when trying to resolve
+  !  the intrinsic symbol name.
+  !
+  interface size
+     module procedure get_fld_size
+  end interface
+contains
+  function get_fld_size(f)
+    integer :: get_fld_size(2)
+    type(fld), intent(in) :: f
+    get_fld_size(int_) = f%size(int_)
+    get_fld_size(bnd_) = f%size(bnd_)
+  end function get_fld_size
+end module class_fld
+
+module class_s_fld
+  use class_fld
+  type s_fld
+     type(fld) :: base
+     real(kind(1.d0)), pointer :: x(:)  => null()
+  end type s_fld
+  interface x_
+     module procedure get_s_fld_x
+  end interface
+contains
+  function get_s_fld_x(fld)
+    real(kind(1.d0)), pointer :: get_s_fld_x(:)
+    type(s_fld), intent(in) :: fld
+    get_s_fld_x => fld%x
+  end function get_s_fld_x
+end module class_s_fld
+
+module class_s_foo
+contains
+  subroutine solve_s_foo(phi,var)
+    use class_s_fld
+    type(s_fld), intent(inout) :: phi
+    real(kind(1.d0)), intent(out), optional :: var
+    integer :: nsz
+    real(kind(1.d0)), pointer :: x(:)
+    x => x_(phi)
+    nsz=size(x)
+  end subroutine solve_s_foo
+end module class_s_foo
+! { dg-final { cleanup-modules "class_s_fld class_fld class_s_foo" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_11.f90 b/gcc/testsuite/gfortran.dg/interface_11.f90
new file mode 100644
index 000000000..a143bb374
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_11.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! Tests the fix for PR30883 in which interface functions and
+! their results did not get an implicit type.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+MODULE M1
+  IMPLICIT NONE
+CONTAINS
+  SUBROUTINE S1(F1, F2, G1, G2)
+    INTERFACE
+      FUNCTION F1(i, a)
+      END FUNCTION F1
+      FUNCTION F2(i, a)
+        implicit complex (a-z)
+      END FUNCTION F2
+    END INTERFACE
+    INTERFACE
+      FUNCTION g1(i, a) result(z)
+      END FUNCTION g1
+      FUNCTION g2(i, a) result(z)
+        implicit complex (a-z)
+      END FUNCTION g2
+    END INTERFACE
+  END SUBROUTINE S1
+END MODULE
+
+END
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_12.f90 b/gcc/testsuite/gfortran.dg/interface_12.f90
new file mode 100644
index 000000000..a45817dab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_12.f90
@@ -0,0 +1,90 @@
+! { dg-do run }
+! Test the fix for PR31293.
+!
+! File: interface4.f90
+! http://home.comcast.net/%7Ekmbtib/Fortran_stuff/interface4.f90
+! Public domain 2004 James Van Buskirk
+! Second attempt to actually create function with LEN
+! given by specification expression via function name,
+! and SIZE given by specification expression via
+! result name.
+
+! g95 12/18/04: Error: Circular specification in variable 'r'.
+! ISO/IEC 1539-1:1997(E) section 512.5.2.2:
+! "If RESULT is specified, the name of the result variable
+! of the function is result-name, its characteristics
+! (12.2.2) are those of the function result, and..."
+! Also from the same section:
+! The type and type parameters (if any) of the result of the
+! function subprogram may be specified by a type specification
+! in the FUNCTION statement or by the name of the result variable
+! appearing in a type statement in the declaration part of the
+! function subprogram.  It shall not be specified both ways."
+! Also in section 7.1.6.2:
+! "A restricted expression is one in which each operation is
+! intrinsic and each primary is
+! ...
+! (7) A reference to an intrinsic function that is
+! ...
+!     (c) the character inquiry function LEN,
+! ...
+!     and where each primary of the function is
+! ...
+!     (b) a variable whose properties inquired about are not
+!         (i)   dependent on the upper bound of the last
+!               dimension of an assumed-shape array.
+!         (ii)  defined by an expression that is not a
+!               restricted expression
+!         (iii) definable by an ALLOCATE or pointer
+!               assignment statement."
+! So I think there is no problem with the specification of
+! the function result attributes; g95 flunks.
+
+! CVF 6.6C3: Error: This name does not have a type, and must
+! have an explicit type. [R]
+! Clearly R has a type here: the type and type parameters of
+! the function result; CVF flunks.
+
+! LF95 5.70f: Type parameters or bounds of variable r may
+! not be inquired.
+! Again, the type parameters, though not the bounds, of
+! variable r may in fact be inquired; LF95 flunks.
+
+module test1
+   implicit none
+   contains
+      character(f (x)) function test2 (x) result(r)
+         implicit integer (x)
+         dimension r(modulo (len (r) - 1, 3) + 1)
+         integer, intent(in) :: x
+         interface
+            pure function f (x)
+               integer, intent(in) :: x
+               integer f
+            end function f
+         end interface
+         integer i
+
+         do i = 1, len (r)
+            r(:)(i:i) = achar (mod (i, 32) + iachar ('@'))
+         end do
+      end function test2
+end module test1
+
+program test
+   use test1
+   implicit none
+   character(21) :: chr (3)
+   chr = "ABCDEFGHIJKLMNOPQRSTU"
+
+   if (len (test2 (10)) .ne. 21) call abort ()
+   if (any (test2 (10) .ne. chr)) call abort ()
+end program test
+
+pure function f (x)
+   integer, intent(in) :: x
+   integer f
+
+   f = 2*x+1
+end function f
+! { dg-final { cleanup-modules "test1" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_13.f90 b/gcc/testsuite/gfortran.dg/interface_13.f90
new file mode 100644
index 000000000..42c794a3e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_13.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! PR32612 gfortran - incorrectly flags error on interface module
+! Test case is that of the reporters
+   module files_module
+      implicit none
+          integer, parameter :: REAL8 = SELECTED_REAL_KIND(12)      
+      save
+      private
+      interface my_sio_file_read_common
+        module procedure my_sio_file_read_common ! This was rejected before
+      end interface
+    contains
+      subroutine my_sio_file_read_all_i4(serial, data, data_lengths, error)
+        logical, intent(in)  :: serial
+        integer, intent(out) :: data(*)
+        integer, intent(in)  :: data_lengths(0:*)
+        integer, intent(out) :: error
+        call my_sio_file_read_common(data_lengths, error, data_i4 = data)
+      end subroutine my_sio_file_read_all_i4
+      subroutine my_sio_file_read_common(data_lengths, error, &
+                                         data_i4, &
+                                         data_r8)
+        integer,     intent(in)  :: data_lengths(0:*)
+        integer,     intent(out) :: error
+        integer,     intent(out), optional :: data_i4(*)
+        real(REAL8), intent(out), optional :: data_r8(*)
+          error=0
+          data_i4(1)=0
+          data_r8(1)=0
+      end subroutine my_sio_file_read_common
+    end module files_module
+
+! { dg-final { cleanup-modules "files_module" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_14.f90 b/gcc/testsuite/gfortran.dg/interface_14.f90
new file mode 100644
index 000000000..ea4345b04
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_14.f90
@@ -0,0 +1,73 @@
+! { dg-do compile }
+! Checks the fix for a regression PR32526, which was caused by
+! the patch for PR31494.  The problem here was that the symbol
+! 'new' was determined to be ambiguous.
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+!
+    module P_Class
+      implicit none
+      private :: init_Personnel
+      interface new
+         module procedure init_Personnel
+      end interface
+      contains
+         subroutine init_Personnel(this)
+         integer, intent (in) :: this
+         print *, "init personnel", this
+         end subroutine init_Personnel
+    end module P_Class
+
+    module S_Class
+      use P_Class
+      implicit none
+      private :: init_Student
+      type Student
+         private
+         integer :: personnel = 1
+      end type Student
+      interface new
+         module procedure init_Student
+      end interface
+      contains
+         subroutine init_Student(this)
+         type (Student), intent (in) :: this
+         call new(this%personnel)
+         end subroutine init_Student
+    end module S_Class
+
+    module T_Class
+      use P_Class
+      implicit none
+      private :: init_Teacher
+      type Teacher
+         private
+         integer :: personnel = 2
+      end type Teacher
+      interface new
+         module procedure init_Teacher
+      end interface
+      contains
+         subroutine init_Teacher(this)
+         type (Teacher), intent (in) :: this
+         call new(this%personnel)
+         end subroutine init_Teacher
+    end module T_Class
+
+    module poly_Class
+      use S_Class
+      use T_Class
+    end module poly_Class
+
+    module D_Class
+      use poly_Class
+    end module D_Class
+
+      use D_Class
+      type (Teacher) :: a
+      type (Student) :: b
+      call new (a)
+      call new (b)
+      end
+
+! { dg-final { cleanup-modules "P_class S_Class T_Class D_Class poly_Class" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_15.f90 b/gcc/testsuite/gfortran.dg/interface_15.f90
new file mode 100644
index 000000000..218606158
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_15.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-c -std=f95" }
+! Testcase from PR fortran/25094
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+
+MODULE M1
+  TYPE T1
+    INTEGER :: I
+  END TYPE T1
+  INTERFACE I
+    MODULE PROCEDURE F1
+  END INTERFACE
+  PRIVATE ! :: T1,F1
+  PUBLIC  :: I
+CONTAINS
+  INTEGER FUNCTION F1(D)  ! { dg-error "PUBLIC interface" }
+    TYPE(T1) :: D
+    F1 = D%I
+  END FUNCTION
+END MODULE
+
+! { dg-final { cleanup-modules "M1" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_16.f90 b/gcc/testsuite/gfortran.dg/interface_16.f90
new file mode 100644
index 000000000..8be9d684a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_16.f90
@@ -0,0 +1,101 @@
+! { dg-do compile }
+! This tests the fix for PR32634, in which the generic interface
+! in foo_pr_mod was given the original rather than the local name.
+! This meant that the original name had to be used in the calll
+! in foo_sub.
+!
+! Contributed by Salvatore Filippone <salvatore.filippone@uniroma2.it>
+
+module foo_base_mod
+  type foo_dmt
+    real(kind(1.d0)), allocatable  :: rv(:)
+    integer, allocatable :: iv1(:), iv2(:)
+  end type foo_dmt
+  type foo_zmt
+    complex(kind(1.d0)), allocatable  :: rv(:)
+    integer, allocatable  :: iv1(:), iv2(:)
+  end type foo_zmt
+  type foo_cdt
+     integer, allocatable :: md(:)
+     integer, allocatable :: hi(:), ei(:)
+  end type foo_cdt
+end module foo_base_mod
+
+module bar_prt
+  use foo_base_mod, only : foo_dmt, foo_zmt, foo_cdt
+  type bar_dbprt
+    type(foo_dmt), allocatable :: av(:) 
+    real(kind(1.d0)), allocatable      :: d(:)  
+    type(foo_cdt)                :: cd 
+  end type bar_dbprt
+  type bar_dprt
+    type(bar_dbprt), allocatable  :: bpv(:) 
+  end type bar_dprt
+  type bar_zbprt
+    type(foo_zmt), allocatable :: av(:) 
+    complex(kind(1.d0)), allocatable   :: d(:)  
+    type(foo_cdt)                :: cd 
+  end type bar_zbprt
+  type bar_zprt
+    type(bar_zbprt), allocatable  :: bpv(:) 
+  end type bar_zprt
+end module bar_prt
+
+module bar_pr_mod
+  use bar_prt
+  interface bar_pwrk
+    subroutine bar_dppwrk(pr,x,y,cd,info,trans,work)
+      use foo_base_mod
+      use bar_prt
+      type(foo_cdt),intent(in)    :: cd
+      type(bar_dprt), intent(in)  :: pr
+      real(kind(0.d0)),intent(inout)    :: x(:), y(:)
+      integer, intent(out)              :: info
+      character(len=1), optional        :: trans
+      real(kind(0.d0)),intent(inout), optional, target :: work(:)
+    end subroutine bar_dppwrk
+    subroutine bar_zppwrk(pr,x,y,cd,info,trans,work)
+      use foo_base_mod
+      use bar_prt
+      type(foo_cdt),intent(in)    :: cd
+      type(bar_zprt), intent(in)  :: pr
+      complex(kind(0.d0)),intent(inout) :: x(:), y(:)
+      integer, intent(out)              :: info
+      character(len=1), optional        :: trans
+      complex(kind(0.d0)),intent(inout), optional, target :: work(:)
+    end subroutine bar_zppwrk
+  end interface
+end module bar_pr_mod
+
+module foo_pr_mod
+  use bar_prt, &
+       & foo_dbprt  => bar_dbprt,&
+       & foo_zbprt  => bar_zbprt,&
+       & foo_dprt   => bar_dprt,&
+       & foo_zprt   => bar_zprt 
+  use bar_pr_mod, &
+       & foo_pwrk  => bar_pwrk
+end module foo_pr_mod
+
+Subroutine foo_sub(a,pr,b,x,eps,cd,info)
+  use foo_base_mod
+  use foo_pr_mod
+  Implicit None
+!!$  parameters 
+  Type(foo_dmt), Intent(in)  :: a
+  Type(foo_dprt), Intent(in)   :: pr 
+  Type(foo_cdt), Intent(in)    :: cd
+  Real(Kind(1.d0)), Intent(in)       :: b(:)
+  Real(Kind(1.d0)), Intent(inout)    :: x(:)
+  Real(Kind(1.d0)), Intent(in)       :: eps
+  integer, intent(out)               :: info
+!!$   Local data
+  Real(Kind(1.d0)), allocatable, target   :: aux(:),wwrk(:,:)
+  Real(Kind(1.d0)), allocatable   :: p(:), f(:)
+  info = 0
+  Call foo_pwrk(pr,p,f,cd,info,work=aux)  ! This worked if bar_pwrk was called!
+  return
+End Subroutine foo_sub
+
+! { dg-final { cleanup-modules "foo_base_mod foo_pr_mod bar_pr_mod bar_prt" } }
+
diff --git a/gcc/testsuite/gfortran.dg/interface_17.f90 b/gcc/testsuite/gfortran.dg/interface_17.f90
new file mode 100644
index 000000000..44b8a4615
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_17.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! Tests the fix for PR32727, which was a regression caused
+! by the fix for PR32634
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+MODULE kinds
+  INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND ( 14, 200 )
+END MODULE kinds
+
+MODULE util
+  USE kinds,                           ONLY: dp
+  INTERFACE sort
+     MODULE PROCEDURE sort2
+  END INTERFACE
+CONTAINS
+  SUBROUTINE sort2 ( )
+  END SUBROUTINE sort2
+END MODULE util
+
+MODULE graphcon
+  USE util,                            ONLY: sort
+END MODULE graphcon
+! { dg-final { cleanup-modules "kinds util graphcon" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_18.f90 b/gcc/testsuite/gfortran.dg/interface_18.f90
new file mode 100644
index 000000000..d0a547548
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_18.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! Public procedures with private types for the dummies
+! is valid F2003, but invalid per Fortran 95, Sect. 5.2.3
+! See interface_15.f90 for the F95 test case.
+!
+   module mytype_application
+     implicit none
+     private
+     public :: mytype_test
+     type :: mytype_type
+       integer :: i=0
+     end type mytype_type
+   contains
+     subroutine mytype_test( mytype )
+       type(mytype_type), intent(in out) :: mytype
+     end subroutine mytype_test
+   end module mytype_application 
+
+! { dg-final { cleanup-modules "mytype_application" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_19.f90 b/gcc/testsuite/gfortran.dg/interface_19.f90
new file mode 100644
index 000000000..7a88fc91b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_19.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! PR33162 INTRINSIC functions as ACTUAL argument
+! Test case adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+module m
+implicit none
+contains
+  subroutine sub(a)
+    optional :: a
+    character(25) :: temp
+    interface
+      function a(x)
+        real(kind=8):: a
+        real(kind=8):: x
+        intent(in) :: x
+      end function a
+    end interface
+    if(present(a)) then
+      write(temp,'(f16.10)')a(4.0d0)
+      if (trim(temp) /= '   -0.6536436209') call abort
+    endif
+  end subroutine sub
+end module m
+
+use m
+implicit none
+intrinsic dcos
+call sub()
+call sub(dcos)
+end
+
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/interface_2.f90 b/gcc/testsuite/gfortran.dg/interface_2.f90
new file mode 100644
index 000000000..4a813d084
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_2.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! PR fortran/24545
+MODULE Compare_Float_Numbers
+
+  IMPLICIT NONE
+
+  INTERFACE Compare_Float
+    MODULE PROCEDURE Compare_Float_Single
+  END INTERFACE Compare_Float
+
+  INTERFACE OPERATOR (.EqualTo.)
+    MODULE PROCEDURE Is_Equal_To_Single
+  END INTERFACE OPERATOR (.EqualTo.)
+
+CONTAINS
+
+  FUNCTION Is_Equal_To_Single(x, y) RESULT(Equal_To)
+    REAL(4), INTENT(IN) :: x, y
+    LOGICAL :: Equal_To
+    Equal_To = .true.
+  END FUNCTION Is_Equal_To_Single
+
+  FUNCTION Compare_Float_Single(x, y) RESULT(Compare)
+    REAL(4), INTENT(IN) :: x, y
+    LOGICAL :: Compare
+    Compare = .true.
+  END FUNCTION Compare_Float_Single
+
+END MODULE Compare_Float_Numbers
+
+! { dg-final { cleanup-modules "Compare_Float_Numbers" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_20.f90 b/gcc/testsuite/gfortran.dg/interface_20.f90
new file mode 100644
index 000000000..9a7dc5cb1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_20.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! PR33162 INTRINSIC functions as ACTUAL argument
+! Test case adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+module m
+implicit none
+contains
+  subroutine sub(a)
+    interface
+      function a()
+        real :: a
+      end function a
+    end interface
+    print *, a()
+  end subroutine sub
+end module m
+use m
+implicit none
+intrinsic cos
+call sub(cos) ! { dg-error "wrong number of arguments" }
+end
+
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/interface_21.f90 b/gcc/testsuite/gfortran.dg/interface_21.f90
new file mode 100644
index 000000000..566a9ef37
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_21.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! PR33162 INTRINSIC functions as ACTUAL argument
+! Test case adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+module m
+implicit none
+contains
+  subroutine sub(a)
+    interface
+      function a(x)
+        real :: a, x
+        intent(in) :: x
+      end function a
+    end interface
+    print *, a(4.0)
+  end subroutine sub
+end module m
+
+use m
+implicit none
+EXTERNAL foo  ! implicit interface is undefined
+call sub(foo) ! { dg-error "is not a function" }
+end
+
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/interface_22.f90 b/gcc/testsuite/gfortran.dg/interface_22.f90
new file mode 100644
index 000000000..fa8e517a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_22.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! This is a check for error recovery: we used to ICE in various places, or
+! emit bogus error messages (PR 25252)
+!
+module foo
+  interface bar
+    module procedure X, Y, ! { dg-error "Syntax error in MODULE PROCEDURE statement" }
+  end interface bar
+end module
+
+module g
+  interface i
+    module procedure sint => sreal ! { dg-error "Syntax error in MODULE PROCEDURE statement" }
+  end interface i
+end module g
+
+module gswap
+  type points
+    real :: x, y
+  end type points
+  interface swap
+    module procedure sreal, schar, sint => sreal ! { dg-error "Syntax error in MODULE PROCEDURE statement" }
+  end interface swap
+end module gswap
+
+! { dg-final { cleanup-modules "foo g gswap" } }
+
diff --git a/gcc/testsuite/gfortran.dg/interface_23.f90 b/gcc/testsuite/gfortran.dg/interface_23.f90
new file mode 100644
index 000000000..60b6e7969
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_23.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+!
+! This tests the fix for PR36325, which corrected for the fact that a
+! specific or generic INTERFACE statement implies the EXTERNAL attibute.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module a
+  interface
+    subroutine foo
+    end subroutine
+  end interface
+  external foo  ! { dg-error "Duplicate EXTERNAL attribute" }
+end module
+
+module b
+  interface
+    function sin (x)
+      real :: sin, x
+    end function
+  end interface
+  intrinsic sin  ! { dg-error "EXTERNAL attribute conflicts with INTRINSIC attribute" }
+end module
+
+! argument checking was not done for external procedures with explicit interface
+program c
+  interface
+    subroutine bar(x)
+      real :: x
+    end subroutine
+  end interface
+  call bar()  ! { dg-error "Missing actual argument" }
+end program
+
+! { dg-final { cleanup-modules "a b" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_24.f90 b/gcc/testsuite/gfortran.dg/interface_24.f90
new file mode 100644
index 000000000..1afc5ef2f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_24.f90
@@ -0,0 +1,66 @@
+! { dg-do compile }
+!
+! This tests the fix for PR36361: If a function was declared in an INTERFACE
+! statement, no attributes may be declared outside of the INTERFACE body.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m1
+  interface
+    real function f1()
+    end function
+  end interface
+  dimension :: f1(4)  ! { dg-error "outside its INTERFACE body" }
+end module
+
+
+module m2
+  dimension :: f2(4)
+  interface
+    real function f2()  ! { dg-error "outside its INTERFACE body" }
+    !end function
+  end interface
+end module
+
+
+! valid
+module m3
+  interface
+    real function f3()
+      dimension :: f3(4)
+    end function
+  end interface
+end module
+
+
+module m4
+  interface
+    function f4()  ! { dg-error "cannot have a deferred shape" }
+      real :: f4(:)
+    end function
+  end interface
+  allocatable :: f4  ! { dg-error "outside of INTERFACE body" }
+end module
+
+
+module m5
+  allocatable :: f5(:)
+  interface
+    function f5()  ! { dg-error "outside its INTERFACE body" }
+      !real f5(:)
+    !end function
+  end interface
+end module
+
+
+!valid
+module m6
+  interface
+    function f6()
+      real f6(:)
+      allocatable :: f6
+    end function
+  end interface
+end module
+
+! { dg-final { cleanup-modules "m1 m2 m3 m4 m5 m6" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_25.f90 b/gcc/testsuite/gfortran.dg/interface_25.f90
new file mode 100644
index 000000000..0118cd563
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_25.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! Tests the fix for PR39295, in which the check of the interfaces
+! at lines 25 and 42 failed because opfunc1 is identified as a 
+! function by usage, whereas opfunc2 is not.
+!
+! Contributed by Jon Hurst <jhurst@ucar.edu>
+!
+MODULE  funcs
+CONTAINS
+  INTEGER FUNCTION test1(a,b,opfunc1) 
+    INTEGER :: a,b
+    INTEGER, EXTERNAL :: opfunc1
+    test1 = opfunc1( a, b ) 
+  END FUNCTION test1
+  INTEGER FUNCTION sumInts(a,b)
+    INTEGER :: a,b
+    sumInts = a + b
+  END FUNCTION sumInts
+END MODULE funcs
+
+PROGRAM test
+  USE funcs 
+  INTEGER :: rs
+  INTEGER, PARAMETER :: a = 2, b = 1
+  rs = recSum( a, b, test1, sumInts )
+  write(*,*) "Results", rs
+CONTAINS
+  RECURSIVE INTEGER FUNCTION recSum( a,b,UserFunction,UserOp ) RESULT( res )
+    IMPLICIT NONE
+    INTEGER :: a,b
+    INTERFACE 
+       INTEGER FUNCTION UserFunction(a,b,opfunc2) 
+         INTEGER :: a,b
+         INTEGER, EXTERNAL :: opfunc2
+       END FUNCTION UserFunction
+    END INTERFACE
+    INTEGER, EXTERNAL :: UserOp 
+
+    res = UserFunction( a,b, UserOp )
+
+    if( res .lt. 10 ) then
+       res = recSum( a, res, UserFunction, UserOp ) 
+    end if
+  END FUNCTION recSum
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/interface_26.f90 b/gcc/testsuite/gfortran.dg/interface_26.f90
new file mode 100644
index 000000000..c1af6c67d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_26.f90
@@ -0,0 +1,46 @@
+! { dg-do compile }
+! Tests the fix for PR39295, in which the check of the interfaces
+! at lines 26 and 43 failed because opfunc1 is identified as a 
+! function by usage, whereas opfunc2 is not. This testcase checks
+! that TKR is stll OK in these cases.
+!
+! Contributed by Jon Hurst <jhurst@ucar.edu>
+!
+MODULE  funcs
+CONTAINS
+  INTEGER FUNCTION test1(a,b,opfunc1) 
+    INTEGER :: a,b
+    INTEGER, EXTERNAL :: opfunc1
+    test1 = opfunc1( a, b ) 
+  END FUNCTION test1
+  INTEGER FUNCTION sumInts(a,b)
+    INTEGER :: a,b
+    sumInts = a + b
+  END FUNCTION sumInts
+END MODULE funcs
+
+PROGRAM test
+  USE funcs 
+  INTEGER :: rs
+  INTEGER, PARAMETER :: a = 2, b = 1
+  rs = recSum( a, b, test1, sumInts ) ! { dg-error "Type/rank mismatch in argument" }
+  write(*,*) "Results", rs
+CONTAINS
+  RECURSIVE INTEGER FUNCTION recSum( a,b,UserFunction,UserOp ) RESULT( res )
+    IMPLICIT NONE
+    INTEGER :: a,b
+    INTERFACE 
+       INTEGER FUNCTION UserFunction(a,b,opfunc2) 
+         INTEGER :: a,b
+         REAL, EXTERNAL :: opfunc2
+       END FUNCTION UserFunction
+    END INTERFACE
+    INTEGER, EXTERNAL :: UserOp 
+
+    res = UserFunction( a,b, UserOp ) ! { dg-error "Type/kind mismatch in return value" }
+
+    if( res .lt. 10 ) then
+       res = recSum( a, res, UserFunction, UserOp ) 
+    end if
+  END FUNCTION recSum
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/interface_27.f90 b/gcc/testsuite/gfortran.dg/interface_27.f90
new file mode 100644
index 000000000..71975b6b7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_27.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+!
+! PR 40039: Procedures as actual arguments: Check intent of arguments
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m
+
+contains
+
+subroutine a(x,f)
+  real :: x
+  interface
+    real function f(y)
+      real,intent(in) :: y
+    end function
+  end interface
+  print *,f(x)
+end subroutine
+
+real function func(z)
+  real,intent(inout) :: z
+  func = z**2
+end function
+
+subroutine caller
+  interface
+    real function p(y)
+      real,intent(in) :: y
+    end function
+  end interface
+  pointer :: p
+
+  call a(4.3,func)  ! { dg-error "INTENT mismatch in argument" }
+  p => func         ! { dg-error "INTENT mismatch in argument" }
+end subroutine
+
+end module 
+
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/interface_28.f90 b/gcc/testsuite/gfortran.dg/interface_28.f90
new file mode 100644
index 000000000..42a8208f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_28.f90
@@ -0,0 +1,43 @@
+! { dg-do compile }
+!
+! PR 36947: Attributes not fully checked comparing actual vs dummy procedure
+!
+! Original test case by Walter Spector <w6ws@earthlink.net>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+module testsub
+  contains
+  subroutine test(sub)
+    interface
+      subroutine sub(x)
+        integer, intent(in), optional:: x
+      end subroutine
+    end interface
+    call sub()
+  end subroutine
+end module
+
+module sub
+  contains
+  subroutine subActual(x)
+    ! actual subroutine's argment is different in intent
+    integer, intent(inout),optional:: x
+  end subroutine
+  subroutine subActual2(x)
+    ! actual subroutine's argment is missing OPTIONAL
+    integer, intent(in):: x
+  end subroutine
+end module
+
+program interfaceCheck
+  use testsub
+  use sub
+
+  integer :: a
+
+  call test(subActual)  ! { dg-error "INTENT mismatch in argument" }
+  call test(subActual2)  ! { dg-error "OPTIONAL mismatch in argument" }
+end program
+
+! { dg-final { cleanup-modules "sub testsub" } }
+
diff --git a/gcc/testsuite/gfortran.dg/interface_29.f90 b/gcc/testsuite/gfortran.dg/interface_29.f90
new file mode 100644
index 000000000..e94571f43
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_29.f90
@@ -0,0 +1,52 @@
+! { dg-do compile }
+!
+! PR 36947: Attributes not fully checked comparing actual vs dummy procedure
+!
+! Contributed by Tobias Burnus <burnus@net-b.de>
+
+module m
+interface foo
+  module procedure one, two
+end interface foo
+contains
+subroutine one(op,op2)
+    interface
+      subroutine op(x, y)
+        complex, intent(in)  :: x(:)
+        complex, intent(out) :: y(:)
+      end subroutine op
+      subroutine op2(x, y)
+        complex, intent(in)  :: x(:)
+        complex, intent(out) :: y(:)
+      end subroutine op2
+    end interface
+end subroutine one
+subroutine two(ops,i,j)
+    interface
+      subroutine op(x, y)
+        complex, intent(in)  :: x(:)
+        complex, intent(out) :: y(:)
+      end subroutine op
+    end interface
+    real :: i,j
+end subroutine two
+end module m
+
+module test
+contains
+subroutine bar()
+  use m
+  call foo(precond_prop,prop2)
+end subroutine bar
+  subroutine precond_prop(x, y)
+    complex, intent(in)  :: x(:)
+    complex, intent(out) :: y(:)
+  end subroutine
+  subroutine prop2(x, y)
+    complex, intent(in)  :: x(:)
+    complex, intent(out) :: y(:)
+  end subroutine
+end module test
+
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/interface_3.f90 b/gcc/testsuite/gfortran.dg/interface_3.f90
new file mode 100644
index 000000000..0a23fb098
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_3.f90
@@ -0,0 +1,69 @@
+! { dg-do compile }
+! Tests the fix for PR20880, which was due to failure to the failure
+! to detect the USE association of a nameless interface for a
+! procedure with the same name as the encompassing scope.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+module test_mod
+interface
+  subroutine my_sub (a)
+    real a
+  end subroutine
+end interface
+interface
+  function my_fun (a)
+    real a, my_fun
+  end function
+end interface
+end module
+
+module test_mod2
+interface
+  function my_fun (a)
+    real a, my_fun
+  end function
+end interface
+end module
+
+
+! This is the original PR, excepting that the error requires the symbol
+! to be referenced.
+subroutine my_sub (a)
+  use test_mod
+  real a
+  call my_sub (a)  ! { dg-error "ambiguous reference" }
+  print *, a
+end subroutine
+
+integer function my_fun (a)
+  use test_mod
+  real a
+  print *, a
+  my_fun = 1  ! { dg-error "ambiguous reference" }
+end function
+
+! This was found whilst investigating => segfault
+subroutine thy_sub (a)
+  interface 
+    subroutine thy_sub (a) ! { dg-error "enclosing procedure" }
+      real a
+    end subroutine
+  end interface
+  real a
+  print *, a
+end subroutine
+
+subroutine thy_fun (a)
+  use test_mod
+  use test_mod2  ! OK because there is no reference to my_fun
+  print *, a
+end subroutine thy_fun
+
+subroutine his_fun (a)
+  use test_mod
+  use test_mod2
+  print *, my_fun (a)  ! { dg-error "ambiguous reference" }
+end subroutine his_fun
+
+! { dg-final { cleanup-modules "test_mod test_mod2" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_30.f90 b/gcc/testsuite/gfortran.dg/interface_30.f90
new file mode 100644
index 000000000..cfea7068a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_30.f90
@@ -0,0 +1,37 @@
+! { dg-do compile }
+!
+! PR39850: Too strict checking for procedures as actual argument
+!
+! Original test case by Tobias Burnus <burnus@gcc.gnu.org>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+real function func()
+  print *,"func"
+  func = 42.0
+end function func
+
+program test
+  external func1,func2,func3,func4  ! subroutine or implicitly typed real function
+  call sub1(func1)
+  call sub2(func2)
+  call sub1(func3)
+  call sub2(func3)  ! { dg-error "is not a subroutine" }
+  call sub2(func4)
+  call sub1(func4)  ! { dg-error "is not a function" }
+contains
+  subroutine sub1(a1)
+    interface
+      real function a1()
+      end function
+    end interface
+    print *, a1()
+  end subroutine sub1
+  subroutine sub2(a2)
+    interface
+      subroutine a2
+      end subroutine
+    end interface
+    call a2()
+  end subroutine
+end
+
diff --git a/gcc/testsuite/gfortran.dg/interface_31.f90 b/gcc/testsuite/gfortran.dg/interface_31.f90
new file mode 100644
index 000000000..3b0e8f828
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_31.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+! PR42684 (42680) Ice with Interface.
+MODULE mod1
+  IMPLICIT NONE  
+  TYPE ta
+    INTEGER i
+  END TYPE ta
+  INTERFACE OPERATOR(+)
+    MODULE PROCEDURE add_a
+  END INTERFACE OPERATOR(+)  
+CONTAINS  
+  FUNCTION add_a(lhs, rhs) RESULT(r)
+    TYPE(ta), INTENT(IN) :: lhs
+    TYPE(ta), INTENT(IN) :: rhs
+    TYPE(ta) :: r
+    !****
+    r%i = lhs%i + rhs%i
+  END FUNCTION add_a  
+END MODULE mod1
+
+MODULE mod2
+  IMPLICIT NONE 
+  TYPE tb
+    INTEGER j
+  END TYPE tb
+  INTERFACE OPERATOR(+)
+    MODULE PROCEDURE add_b
+  END INTERFACE OPERATOR(+)  
+CONTAINS  
+  SUBROUTINE other_proc()
+    USE mod1    ! Causes ICE
+  END SUBROUTINE other_proc  
+  FUNCTION add_b(lhs, rhs) RESULT(r)
+    TYPE(tb), INTENT(IN) :: lhs
+    TYPE(tb), INTENT(IN) :: rhs
+    TYPE(tb) :: r
+    !****
+    r%j = lhs%j + rhs%j
+  END FUNCTION add_b  
+END MODULE mod2
+! { dg-final { cleanup-modules "mod1 mod2" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_32.f90 b/gcc/testsuite/gfortran.dg/interface_32.f90
new file mode 100644
index 000000000..6cdb091ae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_32.f90
@@ -0,0 +1,81 @@
+! { dg-do compile }
+module m1
+  implicit none
+
+  type, abstract :: vector_class
+  end type vector_class
+end module m1
+!---------------------------------------------------------------
+module m2
+  use m1
+  implicit none
+
+  type, abstract :: inner_product_class
+  contains
+    procedure(dot), deferred :: dot_v_v
+    procedure(dot), deferred :: dot_g_g
+    procedure(sub), deferred :: D_times_v
+    procedure(sub), deferred :: D_times_g
+  end type inner_product_class
+
+  abstract interface
+    function dot (this,a,b)
+      import :: inner_product_class
+      import :: vector_class
+      class(inner_product_class), intent(in) :: this
+      class(vector_class),        intent(in) :: a,b
+      real                                   :: dot
+    end function
+    subroutine sub (this,a)
+      import :: inner_product_class
+      import :: vector_class
+      class(inner_product_class), intent(in)    :: this
+      class(vector_class),        intent(inout) :: a
+    end subroutine
+  end interface
+end module m2
+!---------------------------------------------------------------
+module m3
+  use :: m1
+  use :: m2
+  implicit none
+  private
+  public :: gradient_class
+
+  type, abstract, extends(vector_class) :: gradient_class
+    class(inner_product_class), pointer :: my_inner_product => NULL()
+  contains
+    procedure, non_overridable  :: inquire_inner_product
+    procedure(op_g_v), deferred :: to_vector
+  end type gradient_class
+
+  abstract interface
+    subroutine op_g_v(this,v)
+      import vector_class
+      import gradient_class
+      class(gradient_class), intent(in)    :: this
+      class(vector_class),   intent(inout) :: v
+    end subroutine
+  end interface
+contains
+  function inquire_inner_product (this)
+    class(gradient_class)               :: this
+    class(inner_product_class), pointer :: inquire_inner_product
+
+    inquire_inner_product => this%my_inner_product
+  end function inquire_inner_product
+end module m3
+!---------------------------------------------------------------
+module m4
+  use m3
+  use m2
+  implicit none
+contains
+  subroutine cg (g_initial)
+    class(gradient_class),  intent(in)    :: g_initial
+
+    class(inner_product_class), pointer   :: ip_save
+    ip_save => g_initial%inquire_inner_product()
+  end subroutine cg
+end module m4
+! { dg-final { cleanup-modules "m1 m2 m3 m4" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_33.f90 b/gcc/testsuite/gfortran.dg/interface_33.f90
new file mode 100644
index 000000000..955d50731
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_33.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+!
+! PR fortran/33117, PR fortran/46478
+! Procedures of a generic interface must be either
+! all SUBROUTINEs or all FUNCTIONs.
+!
+
+!
+! PR fortran/33117
+!
+module m1
+  interface gen
+    subroutine sub()            ! { dg-error "all SUBROUTINEs or all FUNCTIONs" }
+    end subroutine sub
+    function bar()
+      real :: bar
+    end function bar
+  end interface gen
+end module
+
+!
+! PR fortran/46478
+!
+MODULE m2
+  INTERFACE new_name
+    MODULE PROCEDURE func_name
+    MODULE PROCEDURE subr_name
+  END INTERFACE
+CONTAINS
+   LOGICAL FUNCTION func_name()  ! { dg-error "all SUBROUTINEs or all FUNCTIONs" }
+   END FUNCTION
+   SUBROUTINE subr_name()
+   END SUBROUTINE
+END MODULE
+
+! { dg-final { cleanup-modules "m1 m2" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_34.f90 b/gcc/testsuite/gfortran.dg/interface_34.f90
new file mode 100644
index 000000000..880f179e6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_34.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+!
+! PR fortran/47042
+!
+! Contribued by Jerry DeLisle
+!
+
+program bug
+
+contains
+function get_cstring ()
+  character              :: get_cstring
+  character, pointer     :: ptmp
+  character, allocatable :: atmp
+
+  get_cstring = ptmp(i) ! { dg-error "must have an explicit function interface" }
+  get_cstring = atmp(i) ! { dg-error "must have an explicit function interface" }
+end function
+
+function get_cstring2 ()
+  EXTERNAL :: ptmp, atmp
+  character              :: get_cstring2
+  character, pointer     :: ptmp
+  character, allocatable :: atmp
+
+  get_cstring2 = atmp(i) ! { dg-error "must have an explicit function interface" }
+
+  ! The following is regarded as call to a procedure pointer,
+  ! which is in principle valid:
+  get_cstring2 = ptmp(i)
+end function
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/interface_35.f90 b/gcc/testsuite/gfortran.dg/interface_35.f90
new file mode 100644
index 000000000..20aa4af78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_35.f90
@@ -0,0 +1,79 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
+! PR fortran/48112 (module_m)
+! PR fortran/48279 (sidl_string_array, s_Hard)
+!
+! Contributed by mhp77@gmx.at (module_m)
+! and Adrian Prantl (sidl_string_array, s_Hard)
+!
+
+module module_m
+  interface test
+     function test1( )  result( test )
+       integer ::  test
+     end function test1
+  end interface test
+end module module_m
+
+! -----
+
+module sidl_string_array
+  type sidl_string_1d
+  end type sidl_string_1d
+  interface set
+    module procedure &
+      setg1_p
+  end interface
+contains
+  subroutine setg1_p(array, index, val)
+    type(sidl_string_1d), intent(inout) :: array
+  end subroutine setg1_p
+end module sidl_string_array
+
+module s_Hard
+  use sidl_string_array
+  type :: s_Hard_t
+     integer(8) :: dummy
+  end type s_Hard_t
+  interface set_d_interface
+  end interface 
+  interface get_d_string
+    module procedure get_d_string_p
+  end interface 
+  contains ! Derived type member access functions
+    type(sidl_string_1d) function get_d_string_p(s)
+      type(s_Hard_t), intent(in) :: s
+    end function get_d_string_p
+    subroutine set_d_objectArray_p(s, d_objectArray)
+    end subroutine set_d_objectArray_p
+end module s_Hard
+
+subroutine initHard(h, ex)
+  use s_Hard
+  type(s_Hard_t), intent(inout) :: h
+  call set(get_d_string(h), 0, 'Three') ! { dg-error "There is no specific subroutine for the generic" }
+end subroutine initHard
+
+! -----
+
+  interface get
+    procedure get1
+  end interface
+
+  integer :: h
+  call set1 (get (h))
+
+contains
+
+  subroutine set1 (a)
+    integer, intent(in) :: a
+  end subroutine
+
+  integer function get1 (s) ! { dg-error "Extension: Internal procedure .get1. in generic interface .get." }
+    integer :: s
+  end function
+
+end
+
+! { dg-final { cleanup-modules "module_m module_m2 s_hard sidl_string_array" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_36.f90 b/gcc/testsuite/gfortran.dg/interface_36.f90
new file mode 100644
index 000000000..503229134
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_36.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR fortran/48800
+!
+! Contributed by Daniel Carrera
+!
+     pure function runge_kutta_step(t, r_, dr, h) result(res)
+         real, intent(in) :: t, r_(:), h
+         real, dimension(:), allocatable :: k1, k2, k3, k4, res
+         integer :: N
+
+         interface
+             pure function dr(t, r_)  ! { dg-error "cannot have a deferred shape" }
+                 real, intent(in) :: t, r_(:)
+                 real :: dr(:)
+             end function
+         end interface
+
+         N = size(r_)
+         allocate(k1(N),k2(N),k3(N),k4(N),res(N))
+
+         k1 = dr(t, r_)
+         k2 = dr(t + h/2, r_ + k1*h/2)
+         k3 = dr(t + h/2, r_ + k2*h/2)
+         k4 = dr(t + h  , r_ + k3*h)
+
+         res = r_ + (k1 + 2*k2 + 2*k3 + k4) * h/6
+     end function
diff --git a/gcc/testsuite/gfortran.dg/interface_4.f90 b/gcc/testsuite/gfortran.dg/interface_4.f90
new file mode 100644
index 000000000..8f6c3317e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_4.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+! Tests the fix for the interface bit of PR29975, in which the
+! interfaces bl_copy were rejected as ambiguous, even though
+! they import different specific interfaces.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk> and
+! simplified by Tobias Burnus <burnus@gcc.gnu.org>
+!
+SUBROUTINE RECOPY(N, c)
+  real, INTENT(IN) :: N
+  character(6) :: c
+  c = "recopy"
+END SUBROUTINE RECOPY
+
+MODULE f77_blas_extra
+PUBLIC :: BL_COPY
+INTERFACE BL_COPY
+  MODULE PROCEDURE SDCOPY
+END INTERFACE BL_COPY
+CONTAINS
+   SUBROUTINE SDCOPY(N, c)
+    INTEGER, INTENT(IN) :: N
+    character(6) :: c
+    c = "sdcopy"
+   END SUBROUTINE SDCOPY
+END MODULE f77_blas_extra
+
+MODULE f77_blas_generic
+INTERFACE BL_COPY
+   SUBROUTINE RECOPY(N, c)
+    real, INTENT(IN) :: N
+    character(6) :: c
+   END SUBROUTINE RECOPY
+END INTERFACE BL_COPY
+END MODULE f77_blas_generic
+
+program main
+  USE f77_blas_extra
+  USE f77_blas_generic
+  character(6) :: chr
+  call bl_copy(1, chr)
+  if (chr /= "sdcopy") call abort ()
+  call bl_copy(1.0, chr)
+  if (chr /= "recopy") call abort ()  
+end program main
+! { dg-final { cleanup-modules "f77_blas_generic f77_blas_extra" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_5.f90 b/gcc/testsuite/gfortran.dg/interface_5.f90
new file mode 100644
index 000000000..cc5a7129d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_5.f90
@@ -0,0 +1,56 @@
+! { dg-do compile }
+! Tests the fix for the interface bit of PR29975, in which the
+! interfaces bl_copy were rejected as ambiguous, even though
+! they import different specific interfaces.  In this testcase,
+! it is verified that ambiguous specific interfaces are caught.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk> and
+! simplified by Tobias Burnus <burnus@gcc.gnu.org>
+!
+SUBROUTINE RECOPY(N, c)
+  real, INTENT(IN) :: N
+  character(6) :: c
+  print *, n
+  c = "recopy"
+END SUBROUTINE RECOPY
+
+MODULE f77_blas_extra
+PUBLIC :: BL_COPY
+INTERFACE BL_COPY
+  MODULE PROCEDURE SDCOPY
+END INTERFACE BL_COPY
+CONTAINS
+   SUBROUTINE SDCOPY(N, c)
+    REAL, INTENT(IN) :: N
+    character(6) :: c
+    print *, n
+    c = "sdcopy"
+   END SUBROUTINE SDCOPY
+END MODULE f77_blas_extra
+
+MODULE f77_blas_generic
+INTERFACE BL_COPY
+   SUBROUTINE RECOPY(N, c)
+    real, INTENT(IN) :: N
+    character(6) :: c
+   END SUBROUTINE RECOPY
+END INTERFACE BL_COPY
+END MODULE f77_blas_generic
+
+subroutine i_am_ok
+  USE f77_blas_extra ! { dg-warning "ambiguous interfaces" }
+  USE f77_blas_generic
+  character(6) :: chr
+  chr = ""
+  if (chr /= "recopy") call abort ()  
+end subroutine i_am_ok
+
+program main
+  USE f77_blas_extra ! { dg-error "Ambiguous interfaces" }
+  USE f77_blas_generic
+  character(6) :: chr
+  chr = ""
+  call bl_copy(1.0, chr)
+  if (chr /= "recopy") call abort ()  
+end program main
+! { dg-final { cleanup-modules "f77_blas_generic f77_blas_extra" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_6.f90 b/gcc/testsuite/gfortran.dg/interface_6.f90
new file mode 100644
index 000000000..2e7f85afa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_6.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! One of the tests of the patch for PR30068.
+! Taken from the fortran 2003 standard C11.2.
+!
+! The standard specifies that the optional arguments should be
+! ignored in the counting of like type/kind, so the specific
+! procedures below are invalid, even though actually unambiguous.
+!
+INTERFACE BAD8
+  SUBROUTINE S8A(X,Y,Z)
+    REAL,OPTIONAL :: X
+    INTEGER :: Y
+    REAL :: Z
+  END SUBROUTINE S8A
+  SUBROUTINE S8B(X,Z,Y)
+    INTEGER,OPTIONAL :: X
+    INTEGER :: Z
+    REAL :: Y
+  END SUBROUTINE S8B ! { dg-error "Ambiguous interfaces" }
+END INTERFACE BAD8
+real :: a, b
+integer :: i, j
+call bad8(x,i,b)
+end
diff --git a/gcc/testsuite/gfortran.dg/interface_7.f90 b/gcc/testsuite/gfortran.dg/interface_7.f90
new file mode 100644
index 000000000..9f59b4972
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_7.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! One of the tests of the patch for PR30068.
+!  Taken from the fortran 2003 standard C11.2.
+!
+! The interface is invalid although it is unambiguous because the
+! standard explicitly does not require recursion into the formal
+! arguments of procedures that themselves are interface arguments.
+!
+module xx
+  INTERFACE BAD9
+    SUBROUTINE S9A(X)
+      REAL :: X
+    END SUBROUTINE S9A
+    SUBROUTINE S9B(X)
+      INTERFACE
+        FUNCTION X(A)
+          REAL :: X,A
+        END FUNCTION X
+      END INTERFACE
+    END SUBROUTINE S9B
+    SUBROUTINE S9C(X)
+      INTERFACE
+        FUNCTION X(A)
+          REAL :: X
+          INTEGER :: A
+        END FUNCTION X
+      END INTERFACE
+    END SUBROUTINE S9C  ! { dg-error "Ambiguous interfaces" }
+  END INTERFACE BAD9
+end module xx
+
+! { dg-final { cleanup-modules "xx" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_8.f90 b/gcc/testsuite/gfortran.dg/interface_8.f90
new file mode 100644
index 000000000..7feccb38b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_8.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! One of the tests of the patch for PR30068.
+! Taken from comp.lang.fortran 3rd December 2006.
+!
+! Although the generic procedure is not referenced and it would
+! normally be permissible for it to be ambiguous, the USE, ONLY
+! statement is effectively a reference and is invalid.
+!
+module mod1
+   interface generic
+      subroutine foo(a)
+         real :: a
+      end subroutine
+   end interface generic
+end module  mod1
+
+module mod2
+   interface generic
+      subroutine bar(a)
+         real :: a
+      end subroutine
+   end interface generic
+end module  mod2
+
+program main
+  use mod1, only: generic   ! { dg-warning "has ambiguous interfaces" }
+  use mod2
+end program main
+
+! { dg-final { cleanup-modules "mod1 mod2" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_9.f90 b/gcc/testsuite/gfortran.dg/interface_9.f90
new file mode 100644
index 000000000..b407ab065
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_9.f90
@@ -0,0 +1,47 @@
+! { dg-do compile }
+! Test of the patch for PR30096, in which gfortran incorrectly.
+! compared local with host associated interfaces.
+! 
+! Based on contribution by Harald Anlauf <anlauf@gmx.de>
+!
+module module1
+  interface inverse
+     module procedure A, B
+  end interface
+contains
+  function A (X) result (Y)
+    real                        :: X, Y
+    Y = 1.0
+  end function A
+  function B (X) result (Y)
+    integer                     :: X, Y
+    Y = 3
+  end function B
+end module module1
+
+module module2
+  interface inverse
+     module procedure C
+  end interface
+contains
+  function C (X) result (Y)
+    real                        :: X, Y
+    Y = 2.0
+  end function C
+end module module2
+
+program gfcbug48
+  use module1, only : inverse
+  call sub ()
+  if (inverse(1.0_4) /= 1.0_4) call abort ()
+  if (inverse(1_4) /= 3_4) call abort ()
+contains
+  subroutine sub ()
+    use module2, only : inverse
+    if (inverse(1.0_4) /= 2.0_4) call abort ()
+    if (inverse(1_4) /= 3_4) call abort ()
+  end subroutine sub
+end program gfcbug48
+
+! { dg-final { cleanup-modules "module1 module2" } }
+
diff --git a/gcc/testsuite/gfortran.dg/interface_abstract_1.f90 b/gcc/testsuite/gfortran.dg/interface_abstract_1.f90
new file mode 100644
index 000000000..3b2934fd1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_abstract_1.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+!
+module mod_interf_abstract
+implicit none
+abstract interface :: one ! { dg-error "Syntax error in ABSTRACT INTERFACE statement" }
+end interface ! { dg-error "Expecting END MODULE statement" }
+
+abstract interface
+  subroutine two() bind(C)
+  end subroutine two
+  subroutine three() bind(C,name="three") ! { dg-error "NAME not allowed on BIND.C. for ABSTRACT INTERFACE" }
+  end subroutine three ! { dg-error "Expecting END INTERFACE statement" }
+  subroutine real() ! { dg-error "cannot be the same as an intrinsic type" }
+  end subroutine real
+end interface
+
+contains
+
+  subroutine sub() bind(C,name="subC")
+  end subroutine
+
+end module mod_interf_abstract
diff --git a/gcc/testsuite/gfortran.dg/interface_abstract_2.f90 b/gcc/testsuite/gfortran.dg/interface_abstract_2.f90
new file mode 100644
index 000000000..5eb5a0e53
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_abstract_2.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+abstract interface ! { dg-error "Fortran 2003: ABSTRACT INTERFACE" }
+  subroutine two()
+  end subroutine two
+end interface ! { dg-error "Expecting END PROGRAM statement" }
+end
diff --git a/gcc/testsuite/gfortran.dg/interface_abstract_3.f90 b/gcc/testsuite/gfortran.dg/interface_abstract_3.f90
new file mode 100644
index 000000000..3008d1040
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_abstract_3.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! test for C1204 of Fortran 2003 standard:
+! module procedure not allowed in abstract interface
+module m
+  abstract interface
+     module procedure p	! { dg-error "must be in a generic module interface" }
+  end interface
+contains
+  subroutine p()
+  end subroutine
+end module m
diff --git a/gcc/testsuite/gfortran.dg/interface_abstract_4.f90 b/gcc/testsuite/gfortran.dg/interface_abstract_4.f90
new file mode 100644
index 000000000..50f101577
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_abstract_4.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+!
+! PR 41873: Bogus Error: ABSTRACT INTERFACE must not be referenced...
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+
+  implicit none
+
+  type, abstract :: abstype
+  contains
+    procedure(f), nopass, deferred :: f_bound
+    procedure(s), nopass, deferred :: s_bound
+  end type
+
+  abstract interface
+    real function f ()
+    end function
+  end interface
+
+  abstract interface
+    subroutine s
+    end subroutine
+  end interface
+
+contains
+
+  subroutine cg (c)
+    class(abstype) :: c
+    print *, f()             ! { dg-error "must not be referenced" }
+    call s                   ! { dg-error "must not be referenced" }
+    print *, c%f_bound ()
+    call c%s_bound ()
+  end subroutine
+
+end
diff --git a/gcc/testsuite/gfortran.dg/interface_assignment_1.f90 b/gcc/testsuite/gfortran.dg/interface_assignment_1.f90
new file mode 100644
index 000000000..6740ba140
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_assignment_1.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! Checks the fix for PR31205, in which temporaries were not
+! written for the interface assignment and the parentheses below.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+MODULE TT
+ TYPE data_type
+   INTEGER :: I=2
+ END TYPE data_type
+ INTERFACE ASSIGNMENT (=)
+   MODULE PROCEDURE set
+ END INTERFACE
+CONTAINS
+  PURE SUBROUTINE set(x1,x2)
+    TYPE(data_type), INTENT(IN) :: x2
+    TYPE(data_type), INTENT(OUT) :: x1
+    CALL S1(x1,x2)
+  END SUBROUTINE
+  PURE SUBROUTINE S1(x1,x2)
+    TYPE(data_type), INTENT(IN) :: x2
+    TYPE(data_type), INTENT(OUT) :: x1
+    x1%i=x2%i
+  END SUBROUTINE
+END MODULE
+
+USE TT
+TYPE(data_type) :: D,E
+
+D%I=4
+D=D
+
+E%I=4
+CALL set(E,(E))
+
+IF (D%I.NE.4) call abort ()
+IF (4.NE.E%I) call abort ()
+END
+! { dg-final { cleanup-modules "TT" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_assignment_2.f90 b/gcc/testsuite/gfortran.dg/interface_assignment_2.f90
new file mode 100644
index 000000000..8d7484b31
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_assignment_2.f90
@@ -0,0 +1,49 @@
+! { dg-do run }
+! Checks the fix for PR32842, in which the interface assignment
+! below caused a segfault.  This testcase is reduced from vst_2.f95
+! in the iso_varying_string testsuite, from Lawrie Schonfelder
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module iso_varying_string
+  implicit none
+  integer, parameter :: GET_BUFFER_LEN = 256
+  type varying_string
+     character(LEN=1), dimension(:), allocatable :: chars
+  end type varying_string
+  interface assignment(=)
+     module procedure op_assign_VS_CH
+  end interface assignment(=)
+contains
+  elemental subroutine op_assign_VS_CH (var, expr)
+    type(varying_string), intent(out) :: var
+    character(LEN=*), intent(in)      :: expr
+    var = var_str(expr)
+  end subroutine op_assign_VS_CH
+  elemental function var_str (chr) result (string)
+    character(LEN=*), intent(in) :: chr
+    type(varying_string)         :: string
+    integer                      :: length
+    integer                      :: i_char
+    length = LEN(chr)
+    ALLOCATE(string%chars(length))
+    forall(i_char = 1:length)
+       string%chars(i_char) = chr(i_char:i_char)
+    end forall
+  end function var_str
+end module iso_varying_string
+
+PROGRAM VST_2
+  USE ISO_VARYING_STRING
+  IMPLICIT NONE
+  CHARACTER(LEN=5)     :: char_arb(2)
+  CHARACTER(LEN=1)     :: char_elm(10)
+  equivalence (char_arb, char_elm)
+  type(VARYING_STRING) :: str_ara(2)
+  char_arb(1)= "Hello"
+  char_arb(2)= "World"
+  str_ara = char_arb
+  if (any (str_ara(1)%chars(1:5) .ne. char_elm(1:5))) call abort
+  if (any (str_ara(2)%chars(1:5) .ne. char_elm(6:10))) call abort
+END PROGRAM VST_2
+! { dg-final { cleanup-modules "iso_varying_string" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_assignment_3.f90 b/gcc/testsuite/gfortran.dg/interface_assignment_3.f90
new file mode 100644
index 000000000..6b7881bd1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_assignment_3.f90
@@ -0,0 +1,49 @@
+! { dg-do compile }
+! Checks the fix for PR34008, in which INTENT(INOUT) was disallowed
+! for the first argument of assign_m, whereas both INOUT and OUT
+! should be allowed.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de> 
+!
+module mo_memory
+  implicit none
+  type t_mi
+     logical       :: alloc = .false.
+  end type t_mi
+  type t_m
+     type(t_mi)    :: i                         ! meta data
+     real, pointer :: ptr (:,:,:,:) => NULL ()
+  end type t_m
+
+  interface assignment (=)
+     module  procedure assign_m
+  end interface
+contains
+  elemental subroutine assign_m (y, x)
+    !---------------------------------------
+    ! overwrite intrinsic assignment routine
+    !---------------------------------------
+    type (t_m), intent(inout) :: y
+    type (t_m), intent(in)    :: x
+    y% i = x% i
+    if (y% i% alloc) y% ptr = x% ptr
+  end subroutine assign_m
+end module mo_memory
+
+module gfcbug74
+  use mo_memory, only: t_m, assignment (=)
+  implicit none
+  type t_atm
+     type(t_m) :: m(42)
+  end type t_atm
+contains
+  subroutine assign_atm_to_atm (y, x)
+    type (t_atm), intent(inout) :: y
+    type (t_atm), intent(in)    :: x
+    integer :: i
+!   do i=1,42; y% m(i) = x% m(i); end do    ! Works
+    y% m = x% m                             ! ICE
+  end subroutine assign_atm_to_atm
+end module gfcbug74
+! { dg-final { cleanup-modules "mo_memory gfcbug74" } }
+
diff --git a/gcc/testsuite/gfortran.dg/interface_assignment_4.f90 b/gcc/testsuite/gfortran.dg/interface_assignment_4.f90
new file mode 100644
index 000000000..d55af2905
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_assignment_4.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+!
+! PR 40743: [4.5 Regression] ICE when compiling iso_varying_string.f95 at revision 149591
+!
+! Reduced from http://www.fortran.com/iso_varying_string.f95
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+  implicit none
+
+  type :: varying_string
+  end type
+
+  interface assignment(=)
+     procedure op_assign_VS_CH
+  end interface
+
+contains
+
+  subroutine op_assign_VS_CH (var, exp) ! { dg-warning "Extension: Internal procedure" }
+    type(varying_string), intent(out) :: var
+    character(LEN=*), intent(in)      :: exp
+  end subroutine
+
+  subroutine split_VS
+    type(varying_string) :: string
+    call split_CH(string)
+  end subroutine
+
+  subroutine split_CH (string)
+    type(varying_string) :: string
+    string = ""
+  end subroutine
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/interface_assignment_5.f90 b/gcc/testsuite/gfortran.dg/interface_assignment_5.f90
new file mode 100644
index 000000000..8444dd084
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_assignment_5.f90
@@ -0,0 +1,49 @@
+! { dg-do compile }
+!
+! PR 42677: [4.5 Regression] Bogus Error: Ambiguous interfaces '...' in intrinsic assignment operator
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+
+module mod1
+  implicit none
+  type t_m
+     integer :: i = 0
+  end type t_m
+!------------------------------------------------------------------------------
+  interface assignment (=)
+     module procedure assign_m
+  end interface
+!------------------------------------------------------------------------------
+contains
+  subroutine assign_m (y, x)
+    type(t_m) ,intent(inout) :: y
+    type(t_m) ,intent(in)    :: x
+  end subroutine assign_m
+end module mod1
+!==============================================================================
+module mod2
+  use mod1, only: t_m, assignment(=)
+  implicit none
+  type t_atm
+     integer :: k
+  end type t_atm
+!------------------------------------------------------------------------------
+  interface assignment(=)
+     module procedure assign_to_atm
+  end interface
+!------------------------------------------------------------------------------
+  interface
+     pure subroutine delete_m (x)
+       use mod1
+       type(t_m) ,intent(in) :: x
+     end subroutine delete_m
+  end interface
+!------------------------------------------------------------------------------
+contains
+  subroutine assign_to_atm (atm, r)
+    type(t_atm) ,intent(inout) :: atm
+    integer     ,intent(in)    :: r
+  end subroutine assign_to_atm
+end module mod2
+ 
+! { dg-final { cleanup-modules "mod1 mod2" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_derived_type_1.f90 b/gcc/testsuite/gfortran.dg/interface_derived_type_1.f90
new file mode 100644
index 000000000..a2c4d02be
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_derived_type_1.f90
@@ -0,0 +1,56 @@
+! { dg-do compile }
+! Test the fix for PR20903, in which derived types could be host associated within
+! interface bodies.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+! 
+module test
+  implicit none
+  type fcnparms
+    integer :: i
+  end type fcnparms
+contains
+  subroutine sim_1(func1,params)
+    interface
+      function func1(fparams)
+        type(fcnparms) :: fparams ! { dg-error "not been declared within the interface" }
+        real :: func1
+      end function func1
+    end interface
+    type(fcnparms)     :: params
+   end subroutine sim_1
+
+  subroutine sim_2(func2,params)
+    interface
+      function func2(fparams)     ! This is OK because of the derived type decl.
+        type fcnparms
+          integer :: i
+        end type fcnparms
+        type(fcnparms)  :: fparams
+        real :: func2
+      end function func2
+    end interface
+    type(fcnparms)      :: params ! This is OK, of course
+   end subroutine sim_2
+end module  test
+
+module type_decl
+  implicit none
+  type fcnparms
+    integer :: i
+  end type fcnparms
+end module type_decl
+
+subroutine sim_3(func3,params)
+  use type_decl
+  interface
+    function func3(fparams)
+      use type_decl
+      type(fcnparms)   :: fparams ! This is OK - use associated
+      real :: func3
+    end function func3
+  end interface
+  type(fcnparms)       :: params  !         -ditto-
+end subroutine sim_3
+
+! { dg-final { cleanup-modules "test type_decl" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_proc_end.f90 b/gcc/testsuite/gfortran.dg/interface_proc_end.f90
new file mode 100644
index 000000000..2fc9921df
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_proc_end.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+!
+! PR fortran/34763
+! Before, gfortran did not allow for the "END" in
+! the interface, which is no module procedure.
+!
+! Test case contributed by Dick Hendrickson
+!
+      module n
+      contains
+      subroutine n_interface
+      INTERFACE
+            SUBROUTINE NGSXDY(TLS1,TLS2)
+            REAL  ::  TLS1,TLS2
+            END ! OK
+      END INTERFACE
+      end subroutine
+      end module
diff --git a/gcc/testsuite/gfortran.dg/internal_dummy_1.f90 b/gcc/testsuite/gfortran.dg/internal_dummy_1.f90
new file mode 100644
index 000000000..28ca7a4b4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_dummy_1.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! Tests the fix for 20861, in which internal procedures were permitted to
+! be dummy arguments.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+CALL DD(TT) ! { dg-error "Fortran 2008: Internal procedure 'tt' is used as actual argument" }
+CONTAINS
+SUBROUTINE DD(F)
+  INTERFACE
+   SUBROUTINE F(X)
+    REAL :: X
+   END SUBROUTINE F
+  END INTERFACE
+END SUBROUTINE DD
+SUBROUTINE TT(X)
+  REAL :: X
+END SUBROUTINE
+END
diff --git a/gcc/testsuite/gfortran.dg/internal_dummy_2.f08 b/gcc/testsuite/gfortran.dg/internal_dummy_2.f08
new file mode 100644
index 000000000..7ec6ad4c6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_dummy_2.f08
@@ -0,0 +1,64 @@
+! { dg-do run }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+
+! PR fortran/34162
+! Internal procedures as actual arguments (like restricted closures).
+! Check it works basically.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+MODULE m
+  IMPLICIT NONE
+
+  ABSTRACT INTERFACE
+    FUNCTION returnValue ()
+      INTEGER :: returnValue
+    END FUNCTION returnValue
+
+    SUBROUTINE doSomething ()
+    END SUBROUTINE doSomething
+  END INTERFACE
+
+CONTAINS
+
+  FUNCTION callIt (proc)
+    PROCEDURE(returnValue) :: proc
+    INTEGER :: callIt
+
+    callIt = proc ()
+  END FUNCTION callIt
+
+  SUBROUTINE callSub (proc)
+    PROCEDURE(doSomething) :: proc
+
+    CALL proc ()
+  END SUBROUTINE callSub
+
+END MODULE m
+
+PROGRAM main
+  USE :: m
+  IMPLICIT NONE
+
+  INTEGER :: a
+
+  a = 42
+  IF (callIt (myA) /= 42) CALL abort ()
+
+  CALL callSub (incA)
+  IF (a /= 43) CALL abort ()
+
+CONTAINS
+
+  FUNCTION myA ()
+    INTEGER :: myA
+    myA = a
+  END FUNCTION myA
+
+  SUBROUTINE incA ()
+    a = a + 1
+  END SUBROUTINE incA
+
+END PROGRAM main
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/internal_dummy_3.f08 b/gcc/testsuite/gfortran.dg/internal_dummy_3.f08
new file mode 100644
index 000000000..9780c27b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_dummy_3.f08
@@ -0,0 +1,66 @@
+! { dg-do run }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+
+! PR fortran/34162
+! Internal procedures as actual arguments (like restricted closures).
+! More challenging test involving recursion.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+MODULE m
+  IMPLICIT NONE
+
+  ABSTRACT INTERFACE
+    FUNCTION returnValue ()
+      INTEGER :: returnValue
+    END FUNCTION returnValue
+  END INTERFACE
+
+  PROCEDURE(returnValue), POINTER :: first
+
+CONTAINS
+
+  RECURSIVE SUBROUTINE test (level, current, previous)
+    INTEGER, INTENT(IN) :: level
+    PROCEDURE(returnValue), OPTIONAL :: previous, current
+
+    IF (PRESENT (current)) THEN
+      IF (current () /= level - 1) CALL abort ()
+    END IF
+
+    IF (PRESENT (previous)) THEN
+      IF (previous () /= level - 2) CALL abort ()
+    END IF
+
+    IF (level == 1) THEN
+      first => myLevel
+    END IF
+    IF (first () /= 1) CALL abort ()
+
+    IF (level == 10) RETURN
+
+    IF (PRESENT (current)) THEN
+      CALL test (level + 1, myLevel, current)
+    ELSE
+      CALL test (level + 1, myLevel)
+    END IF
+
+  CONTAINS
+
+    FUNCTION myLevel ()
+      INTEGER :: myLevel
+      myLevel = level
+    END FUNCTION myLevel
+    
+  END SUBROUTINE test
+
+END MODULE m
+
+PROGRAM main
+  USE :: m
+  IMPLICIT NONE
+
+  CALL test (1)
+END PROGRAM main
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/internal_dummy_4.f08 b/gcc/testsuite/gfortran.dg/internal_dummy_4.f08
new file mode 100644
index 000000000..1d8b8b228
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_dummy_4.f08
@@ -0,0 +1,57 @@
+! { dg-do run }
+! PR fortran/34133
+! PR fortran/34162
+!
+! Test of using internal bind(C) procedures as
+! actual argument. Bind(c) on internal procedures and
+! internal procedures are actual argument are
+! Fortran 2008 (draft) extension.
+!
+module test_mod
+  use iso_c_binding
+  implicit none
+contains
+  subroutine test_sub(a, arg, res)
+    interface
+      subroutine a(x) bind(C)
+        import
+        integer(c_int), intent(inout) :: x
+      end subroutine a
+    end interface
+    integer(c_int), intent(inout) :: arg
+    integer(c_int), intent(in) :: res
+    call a(arg)
+    if(arg /= res) call abort()
+  end subroutine test_sub
+  subroutine test_func(a, arg, res)
+    interface
+      integer(c_int) function a(x) bind(C)
+        import
+        integer(c_int), intent(in) :: x
+      end function a
+    end interface
+    integer(c_int), intent(in) :: arg
+    integer(c_int), intent(in) :: res
+    if(a(arg) /= res) call abort()
+  end subroutine test_func
+end module test_mod
+
+program main
+  use test_mod
+  implicit none
+  integer :: a
+  a = 33
+  call test_sub (one, a, 7*33)
+  a = 23
+  call test_func(two, a, -123*23)
+contains
+  subroutine one(x) bind(c)
+     integer(c_int),intent(inout) :: x
+     x = 7*x
+  end subroutine one
+  integer(c_int) function two(y) bind(c)
+     integer(c_int),intent(in) :: y
+     two = -123*y
+  end function two
+end program main
+! { dg-final { cleanup-modules "test_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/internal_io_unf.f90 b/gcc/testsuite/gfortran.dg/internal_io_unf.f90
new file mode 100644
index 000000000..227b0267c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_io_unf.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! PR fortran/34654
+!
+! Disallow unformatted write to internal unit.
+! Test case was contributed by Joost VandeVondele.
+!
+implicit none
+CHARACTER :: a(3)
+WRITE(a) 0 ! { dg-error "Unformatted I/O not allowed with internal unit" }
+END
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_1.f90 b/gcc/testsuite/gfortran.dg/internal_pack_1.f90
new file mode 100644
index 000000000..aded78dc2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_pack_1.f90
@@ -0,0 +1,136 @@
+! { dg-do run }
+! Test that the internal pack and unpack routines work OK
+! for different data types
+
+program main
+  integer(kind=1), dimension(3) :: i1
+  integer(kind=2), dimension(3) :: i2
+  integer(kind=4), dimension(3) :: i4
+  integer(kind=8), dimension(3) :: i8
+  real(kind=4), dimension(3) :: r4
+  real(kind=8), dimension(3) :: r8
+  complex(kind=4), dimension(3) :: c4
+  complex(kind=8), dimension(3) :: c8
+  type i8_t
+     sequence
+     integer(kind=8) :: v
+  end type i8_t
+  type(i8_t), dimension(3) :: d_i8
+
+  i1 = (/ -1, 1, -3 /)
+  call sub_i1(i1(1:3:2))
+  if (any(i1 /= (/ 3, 1, 2 /))) call abort
+
+  i2 = (/ -1, 1, -3 /)
+  call sub_i2(i2(1:3:2))
+  if (any(i2 /= (/ 3, 1, 2 /))) call abort
+
+  i4 = (/ -1, 1, -3 /)
+  call sub_i4(i4(1:3:2))
+  if (any(i4 /= (/ 3, 1, 2 /))) call abort
+
+  i8 = (/ -1, 1, -3 /)
+  call sub_i8(i8(1:3:2))
+  if (any(i8 /= (/ 3, 1, 2 /))) call abort
+
+  r4 = (/ -1.0, 1.0, -3.0 /)
+  call sub_r4(r4(1:3:2))
+  if (any(r4 /= (/ 3.0, 1.0, 2.0/))) call abort
+
+  r8 = (/ -1.0_8, 1.0_8, -3.0_8 /)
+  call sub_r8(r8(1:3:2))
+  if (any(r8 /= (/ 3.0_8, 1.0_8, 2.0_8/))) call abort
+
+  c4 = (/ (-1.0_4, 0._4), (1.0_4, 0._4), (-3.0_4, 0._4) /)
+  call sub_c4(c4(1:3:2))
+  if (any(real(c4) /= (/ 3.0_4, 1.0_4, 2.0_4/))) call abort
+  if (any(aimag(c4) /= 0._4)) call abort
+
+  c8 = (/ (-1.0_4, 0._4), (1.0_4, 0._4), (-3.0_4, 0._4) /)
+  call sub_c8(c8(1:3:2))
+  if (any(real(c8) /= (/ 3.0_4, 1.0_4, 2.0_4/))) call abort
+  if (any(aimag(c8) /= 0._4)) call abort
+
+  d_i8%v = (/ -1, 1, -3 /)
+  call sub_d_i8(d_i8(1:3:2))
+  if (any(d_i8%v /= (/ 3, 1, 2 /))) call abort
+
+end program main
+
+subroutine sub_i1(i)
+  integer(kind=1), dimension(2) :: i
+  if (i(1) /= -1) call abort
+  if (i(2) /= -3) call abort
+  i(1) = 3
+  i(2) = 2
+end subroutine sub_i1
+
+subroutine sub_i2(i)
+  integer(kind=2), dimension(2) :: i
+  if (i(1) /= -1) call abort
+  if (i(2) /= -3) call abort
+  i(1) = 3
+  i(2) = 2
+end subroutine sub_i2
+
+subroutine sub_i4(i)
+  integer(kind=4), dimension(2) :: i
+  if (i(1) /= -1) call abort
+  if (i(2) /= -3) call abort
+  i(1) = 3
+  i(2) = 2
+end subroutine sub_i4
+
+subroutine sub_i8(i)
+  integer(kind=8), dimension(2) :: i
+  if (i(1) /= -1) call abort
+  if (i(2) /= -3) call abort
+  i(1) = 3
+  i(2) = 2
+end subroutine sub_i8
+
+subroutine sub_r4(r)
+  real(kind=4), dimension(2) :: r
+  if (r(1) /= -1.) call abort
+  if (r(2) /= -3.) call abort
+  r(1) = 3.
+  r(2) = 2.
+end subroutine sub_r4
+
+subroutine sub_r8(r)
+  real(kind=8), dimension(2) :: r
+  if (r(1) /= -1._8) call abort
+  if (r(2) /= -3._8) call abort
+  r(1) = 3._8
+  r(2) = 2._8
+end subroutine sub_r8
+
+subroutine sub_c8(r)
+  implicit none
+  complex(kind=8), dimension(2) :: r
+  if (r(1) /= (-1._8,0._8)) call abort
+  if (r(2) /= (-3._8,0._8)) call abort
+  r(1) = 3._8
+  r(2) = 2._8
+end subroutine sub_c8
+
+subroutine sub_c4(r)
+  implicit none
+  complex(kind=4), dimension(2) :: r
+  if (r(1) /= (-1._4,0._4)) call abort
+  if (r(2) /= (-3._4,0._4)) call abort
+  r(1) = 3._4
+  r(2) = 2._4
+end subroutine sub_c4
+
+subroutine sub_d_i8(i)
+  type i8_t
+     sequence
+     integer(kind=8) :: v
+  end type i8_t
+  type(i8_t), dimension(2) :: i
+  if (i(1)%v /= -1) call abort
+  if (i(2)%v /= -3) call abort
+  i(1)%v = 3
+  i(2)%v = 2
+end subroutine sub_d_i8
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_10.f90 b/gcc/testsuite/gfortran.dg/internal_pack_10.f90
new file mode 100644
index 000000000..8d972f44c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_pack_10.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+! Test the fix for PR43180, in which patch which reduced the use of
+! internal_pack/unpack messed up the passing of ru(1)%c as the actual
+! argument at line 23 in this testcase.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+! further reduced by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module mo_obs_rules
+  type t_set
+     integer :: use = 42
+  end type t_set
+  type t_rules
+     character(len=40) :: comment
+     type(t_set)       :: c (1)
+  end type t_rules
+  type (t_rules), save :: ru (1)
+contains
+  subroutine get_rule (c)
+    type(t_set) :: c (:)
+    ru(1)%c(:)%use = 99
+    if (any (c(:)%use .ne. 42)) call abort
+    call set_set_v (ru(1)%c, c)
+    if (any (c(:)%use .ne. 99)) call abort
+  contains
+    subroutine set_set_v (src, dst)
+      type(t_set), intent(in)    :: src(1)
+      type(t_set), intent(inout) :: dst(1)
+    if (any (src%use .ne. 99)) call abort
+    if (any (dst%use .ne. 42)) call abort
+      dst = src
+    end subroutine set_set_v
+  end subroutine get_rule
+end module mo_obs_rules
+
+program test
+  use mo_obs_rules
+  type(t_set) :: c (1)
+  call get_rule (c)
+end program test
+! { dg-final { cleanup-modules "mo_obs_rules" } }
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_11.f90 b/gcc/testsuite/gfortran.dg/internal_pack_11.f90
new file mode 100644
index 000000000..8f573b4fd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_pack_11.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for PR43173, where unnecessary calls to internal_pack/unpack
+! were being produced below. These references are contiguous and so do not
+! need a temporary.
+!
+! Contributed Tobias Burnus <burnus@gcc.gnu.org>
+!
+  REAL, allocatable :: ot(:)
+  integer :: time_steps
+
+  call foo (ot) ! OK, no temporary
+  call foo (ot(0:5:1)) ! Was an unnecessary temporary
+  call foo (ot(0:time_steps)) ! Was an unnecessary temporary
+  end
+! { dg-final { scan-tree-dump-times "unpack" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_12.f90 b/gcc/testsuite/gfortran.dg/internal_pack_12.f90
new file mode 100644
index 000000000..32bacfa39
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_pack_12.f90
@@ -0,0 +1,61 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for PR43243, where unnecessary calls to internal_pack/unpack
+! were being produced below. These references are contiguous and so do not
+! need a temporary. In addition, the final call to 'bar' required a pack/unpack
+! which had been missing since r156680, at least.
+!
+! Contributed Tobias Burnus <burnus@gcc.gnu.org>
+!
+module m
+  type t
+    integer, allocatable :: a(:)
+    integer, pointer :: b(:)
+    integer :: c(5)
+  end type t
+end module m
+
+subroutine foo(a,d,e,n)
+  use m
+  implicit none
+  integer :: n
+  type(t) :: a
+  type(t), allocatable :: d(:)
+  type(t), pointer :: e(:)
+  call bar(   a%a) ! OK - no array temp needed
+  call bar(   a%c) ! OK - no array temp needed
+
+  call bar(   a%a(1:n)) ! Missed: No pack needed
+  call bar(   a%b(1:n)) ! OK: pack needed
+  call bar(   a%c(1:n)) ! Missed: No pack needed
+
+  call bar(d(1)%a(1:n)) ! Missed: No pack needed
+  call bar(d(1)%b(1:n)) ! OK: pack needed
+  call bar(d(1)%c(1:n)) ! Missed: No pack needed
+
+  call bar(e(1)%a(1:n)) ! Missed: No pack needed
+  call bar(e(1)%b(1:n)) ! OK: pack needed
+  call bar(e(1)%c(1:n)) ! Missed: No pack needed
+end subroutine foo
+
+use m
+implicit none
+integer :: i
+integer, target :: z(6)
+type(t) :: y
+
+z = [(i, i=1,6)]
+y%b => z(::2)
+call bar(y%b)  ! Missed: Pack needed
+end
+
+subroutine bar(x)
+  integer :: x(1:*)
+  print *, x(1:3)
+  if (any (x(1:3) /= [1,3,5])) call abort ()
+end subroutine bar
+! { dg-final { scan-tree-dump-times "unpack" 4 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_13.f90 b/gcc/testsuite/gfortran.dg/internal_pack_13.f90
new file mode 100644
index 000000000..21fdc5418
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_pack_13.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+!
+! PR 55072: [4.6/4.7/4.8 Regression] Missing internal_pack leads to wrong code with derived type
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+implicit none
+type t
+integer :: i
+end type t
+type(t), target :: tgt(4,4)
+type(t), pointer :: p(:,:)
+integer :: i,j,k
+
+k = 1
+do i = 1, 4
+  do j = 1, 4
+    tgt(i,j)%i = k
+    k = k+1
+  end do
+end do
+
+p => tgt(::2,::2)
+print *,p%i
+call bar(p)
+
+contains
+
+  subroutine bar(x)
+    type(t) :: x(*)
+    print *,x(1:4)%i
+    if (any (x(1:4)%i /= [1, 9, 3, 11])) call abort()
+  end subroutine
+end
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_14.f90 b/gcc/testsuite/gfortran.dg/internal_pack_14.f90
new file mode 100644
index 000000000..1a4b3725f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_pack_14.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+!
+! PR 55072: [4.6/4.7/4.8 Regression] Missing internal_pack leads to wrong code with derived type
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+program GiBUU_neutrino_bug
+
+  Type particle
+    integer :: ID
+  End Type
+
+  type(particle), dimension(1:2,1:2) :: OutPart
+
+  OutPart(1,:)%ID = 1
+  OutPart(2,:)%ID = 2
+
+  call s1(OutPart(1,:))
+
+contains
+
+  subroutine s1(j)
+    type(particle) :: j(:)
+    print *,j(:)%ID
+    call s2(j)
+  end subroutine
+
+  subroutine s2(k)
+    type(particle) :: k(1:2)
+    print *,k(:)%ID
+    if (any (k(1:2)%ID /= [1, 1])) call abort()
+  end subroutine
+
+end
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_2.f90 b/gcc/testsuite/gfortran.dg/internal_pack_2.f90
new file mode 100644
index 000000000..1f0473e24
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_pack_2.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+! Test that the internal pack and unpack routines work OK
+! for our large real type.
+
+program main
+  implicit none
+  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+  real(kind=k), dimension(3) :: rk
+  complex(kind=k), dimension(3) :: ck
+
+  rk = (/ -1.0_k, 1.0_k, -3.0_k /)
+  call sub_rk(rk(1:3:2))
+  if (any(rk /= (/ 3.0_k, 1.0_k, 2.0_k/))) call abort
+
+  ck = (/ (-1.0_k, 0._k), (1.0_k, 0._k), (-3.0_k, 0._k) /)
+  call sub_ck(ck(1:3:2))
+  if (any(real(ck) /= (/ 3.0_k, 1.0_k, 2.0_k/))) call abort
+  if (any(aimag(ck) /= 0._k)) call abort
+
+end program main
+
+subroutine sub_rk(r)
+  implicit none
+  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+  real(kind=k), dimension(2) :: r
+  if (r(1) /= -1._k) call abort
+  if (r(2) /= -3._k) call abort
+  r(1) = 3._k
+  r(2) = 2._k
+end subroutine sub_rk
+
+subroutine sub_ck(r)
+  implicit none
+  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+  complex(kind=k), dimension(2) :: r
+  if (r(1) /= (-1._k,0._k)) call abort
+  if (r(2) /= (-3._k,0._k)) call abort
+  r(1) = 3._k
+  r(2) = 2._k
+end subroutine sub_ck
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_3.f90 b/gcc/testsuite/gfortran.dg/internal_pack_3.f90
new file mode 100644
index 000000000..08f3c7d15
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_pack_3.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_int }
+! Test that the internal pack and unpack routines work OK
+! for our large integer type.
+
+program main
+  integer,parameter :: k = selected_int_kind (range (0_8) + 1)
+  integer(kind=k), dimension(3) :: ik
+
+  ik = (/ -1, 1, -3 /)
+  call sub_ik(ik(1:3:2))
+  if (any(ik /= (/ 3, 1, 2 /))) call abort
+end program main
+
+subroutine sub_ik(i)
+  integer,parameter :: k = selected_int_kind (range (0_8) + 1)
+  integer(kind=k), dimension(2) :: i
+  if (i(1) /= -1) call abort
+  if (i(2) /= -3) call abort
+  i(1) = 3
+  i(2) = 2
+end subroutine sub_ik
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_4.f90 b/gcc/testsuite/gfortran.dg/internal_pack_4.f90
new file mode 100644
index 000000000..5ddc035e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_pack_4.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/36132
+!
+! Before invalid memory was accessed because an absent, optional
+! argument was packed before passing it as absent actual.
+! Getting it to crash is difficult, but valgrind shows the problem.
+!
+MODULE M1
+  INTEGER, PARAMETER :: dp=KIND(0.0D0)
+CONTAINS
+  SUBROUTINE S1(a)
+         REAL(dp), DIMENSION(45), INTENT(OUT), &
+      OPTIONAL                               :: a
+      if (present(a)) call abort()
+  END SUBROUTINE S1
+  SUBROUTINE S2(a)
+          REAL(dp), DIMENSION(:, :), INTENT(OUT), &
+      OPTIONAL                               :: a
+      CALL S1(a)
+  END SUBROUTINE
+END MODULE M1
+
+USE M1
+CALL S2()
+END
+
+! { dg-final { scan-tree-dump-times "a != 0B \\? \\\(.*\\\) _gfortran_internal_pack" 1 "original" } }
+! { dg-final { scan-tree-dump-times "if \\(a != 0B &&" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_5.f90 b/gcc/testsuite/gfortran.dg/internal_pack_5.f90
new file mode 100644
index 000000000..87705fa71
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_pack_5.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/36909
+!
+! Check that no unneeded internal_unpack is
+! called (INTENT(IN)!).
+!
+program test
+  implicit none
+  integer :: a(3,3)
+  call foo(a(1,:))
+contains
+  subroutine foo(x)
+    integer,intent(in) :: x(3)
+  end subroutine foo
+end program test
+
+! { dg-final { scan-tree-dump-times "_gfortran_internal_pack" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_internal_unpack" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_6.f90 b/gcc/testsuite/gfortran.dg/internal_pack_6.f90
new file mode 100644
index 000000000..51af7264b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_pack_6.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for PR41113 and PR41117, in which unnecessary calls
+! to internal_pack and internal_unpack were being generated.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+MODULE M1
+ TYPE T1
+   REAL :: data(10) = [(i, i = 1, 10)]
+ END TYPE T1
+CONTAINS
+ SUBROUTINE S1(data, i, chksum)
+   REAL, DIMENSION(*) :: data
+   integer :: i, j
+   real :: subsum, chksum
+   subsum = 0
+   do j = 1, i
+     subsum = subsum + data(j)
+   end do
+   if (abs(subsum - chksum) > 1e-6) call abort
+ END SUBROUTINE S1
+END MODULE
+
+SUBROUTINE S2
+ use m1
+ TYPE(T1) :: d
+
+ real :: data1(10) = [(i, i = 1, 10)]
+ REAL :: data(-4:5,-4:5) = reshape ([(real(i), i = 1, 100)], [10,10])
+
+! PR41113
+ CALL S1(d%data, 10, sum (d%data))
+ CALL S1(data1, 10, sum (data1))
+
+! PR41117
+ DO i=-4,5
+    CALL S1(data(:,i), 10, sum (data(:,i)))
+ ENDDO
+
+! With the fix for PR41113/7 this is the only time that _internal_pack
+! was called.  The final part of the fix for PR43072 put paid to it too.
+ DO i=-4,5
+    CALL S1(data(-2:,i), 8, sum (data(-2:,i)))
+ ENDDO
+ DO i=-4,4
+    CALL S1(data(:,i:i+1), 20, sum (reshape (data(:,i:i+1), [20])))
+ ENDDO
+ DO i=-4,5
+    CALL S1(data(2,i), 1, data(2,i))
+ ENDDO
+END SUBROUTINE S2
+
+ call s2
+end
+! { dg-final { cleanup-modules "M1" } }
+! { dg-final { scan-tree-dump-times "_gfortran_internal_pack" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_7.f90 b/gcc/testsuite/gfortran.dg/internal_pack_7.f90
new file mode 100644
index 000000000..0bc30e508
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_pack_7.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for PR43072, in which unnecessary calls to
+! internal PACK/UNPACK were being generated.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+MODULE M1
+  PRIVATE
+  REAL, PARAMETER :: c(2)=(/(i,i=1,2)/)
+CONTAINS
+  ! WAS OK
+  SUBROUTINE S0
+    real :: r
+     r=0
+     r=S2(c)
+     r=S2((/(real(i),i=1,2)/)) ! See comment #1 of the PR
+  END SUBROUTINE S0
+  ! WAS NOT OK
+  SUBROUTINE S1
+    real :: r
+     r=0
+     r=r+S2(c)
+     r=r+S2((/(real(i),i=1,2)/)) ! See comment #1 of the PR
+  END SUBROUTINE S1
+
+  FUNCTION S2(c)
+     REAL, INTENT(IN) :: c(2)
+     s2=0
+  END FUNCTION S2
+END MODULE M1
+! { dg-final { cleanup-modules "M1" } }
+! { dg-final { scan-tree-dump-times "pack" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_8.f90 b/gcc/testsuite/gfortran.dg/internal_pack_8.f90
new file mode 100644
index 000000000..91d6a6646
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_pack_8.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! Test the fix for PR43111, in which necessary calls to
+! internal PACK/UNPACK were not being generated because
+! of an over agressive fix to PR41113/7.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+SUBROUTINE S2(I)
+ INTEGER :: I(4)
+ !write(6,*) I
+ IF (ANY(I.NE.(/3,5,7,9/))) CALL ABORT()
+END SUBROUTINE S2
+
+MODULE M1
+ TYPE T1
+  INTEGER, POINTER, DIMENSION(:) :: data
+ END TYPE T1
+CONTAINS
+ SUBROUTINE S1()
+   TYPE(T1) :: d
+   INTEGER, TARGET, DIMENSION(10) :: scratch=(/(i,i=1,10)/)
+   INTEGER :: i=2
+   d%data=>scratch(1:9:2)
+!   write(6,*) d%data(i:)
+   CALL S2(d%data(i:))
+ END SUBROUTINE S1
+END MODULE M1
+
+USE M1
+CALL S1
+END
+! { dg-final { cleanup-modules "M1" } }
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_9.f90 b/gcc/testsuite/gfortran.dg/internal_pack_9.f90
new file mode 100644
index 000000000..6e69745e6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_pack_9.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! During the discussion of the fix for PR43072, in which unnecessary
+! calls to internal PACK/UNPACK were being generated, the following,
+! further unnecessary temporaries or PACk/UNPACK were found.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+! Case 1: Substring encompassing the whole string
+subroutine foo2
+  implicit none
+  external foo
+  character(len=20) :: str(2) = '1234567890'
+  call foo(str(:)(1:20)) ! This is still not fixed.
+end
+
+! Case 2: Contiguous array section
+subroutine bar
+  implicit none
+  external foo
+  integer :: a(3,3,3)
+  call foo(a(:,:,:)) ! OK, no temporary
+  call foo(a(:,:,1)) ! OK, no temporary
+  call foo(a(:,2,2)) ! Used unnecessarily a temporary -FIXED
+  call foo(a(2,:,1)) ! OK, creates a temporary(1)
+end
+
+! Case 3: Stride 1 section.
+subroutine foobar
+  implicit none
+  external foo
+  integer :: A(10,10)
+  call foo(A(3:7,4)) ! Used unnecessarily a temporary - FIXED
+  call foo(A(:,3:7)) ! OK (no temporary)
+  call foo(A(1:10,3:7)) ! OK (no temporary)
+  call foo(A(4,3:7)) ! temporary OK(2)
+  call foo(A(:,3:7:-1)) ! temporary(3) OK because of stride
+end
+! { dg-final { scan-tree-dump-times "unpack" 3 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/internal_readwrite_1.f90 b/gcc/testsuite/gfortran.dg/internal_readwrite_1.f90
new file mode 100644
index 000000000..405f58154
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_readwrite_1.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! PR 34565 - internal writes with negative strides
+! didn't work.
+program main
+  implicit none
+  integer :: i
+  integer :: lo, up, st
+  character(len=2) :: c (5)
+  integer, dimension(5) :: n
+  c = (/ 'a', 'b', 'c', 'd', 'e' /)
+  write (unit=c(5:1:-2),fmt="(A)") '5','3', '1'
+  write (unit=c(2:4:2),fmt="(A)") '2', '4'
+  read  (c(5:1:-1),fmt="(I2)") (n(i), i=5,1,-1)
+  if (any(n /= (/ (i,i=1,5) /))) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/internal_readwrite_2.f90 b/gcc/testsuite/gfortran.dg/internal_readwrite_2.f90
new file mode 100644
index 000000000..48b658652
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_readwrite_2.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! PR 34565 - intenal writes with negative strides.  This
+! test case tries out a negative stride in a higher
+! dimension.
+program main
+  implicit none
+  integer :: i
+  integer, parameter :: n1=2, n2=3, n3=5
+  character(len=n1*n2*n3*2) :: line
+  character(len=2), dimension(n1,n2,n3):: c
+  write (unit=c(:,n2:1:-1,:),fmt="(I2)") (i,i=1,n1*n2*n3)
+  line = transfer(c,mold=line)
+  if (line /=" 5 6 3 4 1 21112 910 7 8171815161314232421221920293027282526") call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/internal_references_1.f90 b/gcc/testsuite/gfortran.dg/internal_references_1.f90
new file mode 100644
index 000000000..73b9da67c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_references_1.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! This tests the patch for PRs 24327, 25024 & 25625, which
+! are all connected with references to internal procedures.
+! This is a composite of the PR testcases; and each is
+! labelled by PR.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+! PR25625 - would neglect to point out that there were 2 subroutines p.
+module m
+  implicit none
+contains
+
+  subroutine p (i)   ! { dg-error "is already defined" }
+    integer :: i
+  end subroutine
+
+  subroutine p (i)   ! { dg-error "is already defined" }
+   integer :: i
+  end subroutine
+end module
+!
+! PR25124 - would happily ignore the declaration of foo in the main program.
+program test
+real :: foo, x      ! { dg-error "explicit interface and must not have attributes declared" }
+x = bar ()          ! This is OK because it is a regular reference.
+x = foo ()
+contains
+    function foo () ! { dg-error "explicit interface and must not have attributes declared" }
+      foo = 1.0
+    end function foo
+    function bar ()
+      bar = 1.0
+    end function bar
+end program test
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/internal_references_2.f90 b/gcc/testsuite/gfortran.dg/internal_references_2.f90
new file mode 100644
index 000000000..6d4c21dc2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_references_2.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! This tests the fix for the regression caused by the internal references
+! patc, which is tested by internal_references_1.f90. Reported as PR25901.
+!
+! Based on test cases provided by Toon Moene  <toon@moene.indiv.nluug.nl>
+!                          and by Martin Reinecke <martin@mpa-garching.mpg.de>
+module aap
+  interface s
+    module procedure sub,sub1
+  end interface
+contains
+  subroutine sub1(i)
+    integer i
+    real a
+    call sub(a)      ! For the original test, this "defined" the procedure.
+  end subroutine sub1
+  subroutine sub(a)  ! Would give an error on "already defined" here
+    real a
+  end subroutine sub
+end module aap
+
+! { dg-final { cleanup-modules "aap" } }
diff --git a/gcc/testsuite/gfortran.dg/internal_write_1.f90 b/gcc/testsuite/gfortran.dg/internal_write_1.f90
new file mode 100644
index 000000000..3dfcaad26
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_write_1.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! { dg-shouldfail "End of file" }
+program main
+  character(len=20) :: line
+  integer, dimension(4) :: n
+  n = 1
+  write(line,'(2I2)') n
+end program main
+! { dg-output "Fortran runtime error: End of file" }
diff --git a/gcc/testsuite/gfortran.dg/interop_params.f03 b/gcc/testsuite/gfortran.dg/interop_params.f03
new file mode 100644
index 000000000..ea3dadac0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interop_params.f03
@@ -0,0 +1,24 @@
+! { dg-do compile }
+module interop_params
+use, intrinsic :: iso_c_binding
+
+type my_f90_type
+   integer :: i
+   real :: x
+end type my_f90_type
+
+contains
+  subroutine test_0(my_f90_int) bind(c) ! { dg-warning "may not be C interoperable" }
+    use, intrinsic :: iso_c_binding
+    integer, value :: my_f90_int 
+  end subroutine test_0
+
+  subroutine test_1(my_f90_real) bind(c)
+    real(c_int), value :: my_f90_real    ! { dg-warning "is for type INTEGER" }
+  end subroutine test_1
+
+  subroutine test_2(my_type) bind(c) ! { dg-error "is not C interoperable" }
+    use, intrinsic :: iso_c_binding
+    type(my_f90_type) :: my_type 
+  end subroutine test_2
+end module interop_params
diff --git a/gcc/testsuite/gfortran.dg/intrinsic.f90 b/gcc/testsuite/gfortran.dg/intrinsic.f90
new file mode 100644
index 000000000..e3ac35ef5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! { dg-options "-c -Wall" }
+!
+! PR fortran/20373
+! cf. also PR fortran/40041
+
+subroutine valid
+  intrinsic :: abs                 ! ok, intrinsic function
+  intrinsic :: cpu_time            ! ok, intrinsic subroutine
+end subroutine
+
+subroutine warnings
+  ! the follow three are ok in general, but ANY 
+  ! type is ignored, even the correct one
+  real, intrinsic :: sin           ! { dg-warning "is ignored" }
+
+  real :: asin                     ! { dg-warning "is ignored" }
+  intrinsic :: asin
+
+  intrinsic :: tan                 ! { dg-warning "is ignored" }
+  real :: tan
+
+  ! wrong types here
+  integer, intrinsic :: cos        ! { dg-warning "is ignored" }
+
+  integer :: acos                  ! { dg-warning "is ignored" }
+  intrinsic :: acos
+
+  ! ordering shall not matter
+  intrinsic :: atan                ! { dg-warning "is ignored" }
+  integer :: atan
+end subroutine
+
+subroutine errors
+  intrinsic :: foo                 ! { dg-error "does not exist" }
+  real, intrinsic :: bar           ! { dg-error "does not exist" }
+
+  real, intrinsic :: mvbits        ! { dg-error "shall not have a type" }
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_1.f90
new file mode 100644
index 000000000..b2413de1a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_1.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR 39861/39864
+!
+! Test cases provided by Dominique d'Humieres <dominiq@lps.ens.fr>
+! and Michael Richmond <michael.a.richmond@nasa.gov>.
+
+module vector_calculus
+  intrinsic :: dot_product, sqrt
+
+contains
+
+  function len(r)
+    real, dimension(:), intent(in) :: r
+    real :: len
+    len = sqrt(dot_product(r,r))
+  end function len
+
+  FUNCTION next_state()
+    INTRINSIC :: RESHAPE
+    INTEGER, PARAMETER :: trantb(1,1) = RESHAPE((/1,2/), shape=(/1,1/))
+    next_state = trantb(1, 1)
+  END FUNCTION next_state
+
+end module vector_calculus
+
+! { dg-final { cleanup-modules "vector_calculus" } }
+
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_2.f90
new file mode 100644
index 000000000..b4919a13c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_2.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+! { dg-options "-c -Wall" }
+!
+! PR fortran/40041
+! cf. also PR fortran/20373
+
+subroutine valid_one
+  REAL :: a
+  INTEGER :: n
+  INTRINSIC   ABS, MAX
+  a(n) = MAX(ABS(2),ABS(3),n)
+end subroutine
+
+subroutine valid_two
+  IMPLICIT NONE
+  REAL :: a
+  INTEGER :: n
+  INTRINSIC   ABS, MAX
+  a(n) = MAX(ABS(2),ABS(3),n)
+end subroutine
+
+subroutine warnings_one
+  REAL :: a
+  INTEGER :: n
+  REAL :: ABS ! { dg-warning "Type specified for intrinsic function" }
+  REAL :: MAX ! { dg-warning "Type specified for intrinsic function" }
+  INTRINSIC   ABS, MAX
+  a(n) = MAX(ABS(2),ABS(3),n)
+end subroutine
+
+subroutine warnings_two
+  IMPLICIT NONE
+  REAL :: a
+  INTEGER :: n
+  INTRINSIC ABS ! { dg-warning "Type specified for intrinsic function" }
+  INTRINSIC MAX ! { dg-warning "Type specified for intrinsic function" }
+  REAL :: ABS
+  REAL :: MAX
+  a(n) = MAX(ABS(2),ABS(3),n)
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_3.f90 b/gcc/testsuite/gfortran.dg/intrinsic_3.f90
new file mode 100644
index 000000000..fcd40e94b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_3.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR 39876: module procedure name that collides with the GNU intrinsic
+!
+! Contributed by Alexei Matveev <alexei.matveev+gcc@gmail.com>
+
+module p                           
+  implicit none                                                                 
+
+  contains
+
+    subroutine test()
+      implicit none
+      print *, avg(erfc)
+    end subroutine test
+
+    function avg(f)
+      implicit none
+      double precision :: avg
+      interface
+        double precision function f(x)
+          implicit none
+          double precision, intent(in) :: x
+        end function f
+      end interface
+      avg = ( f(1.0D0) + f(2.0D0) ) / 2
+    end function avg
+
+    function erfc(x)
+      implicit none
+      double precision, intent(in) :: x
+      double precision             :: erfc
+      erfc = x
+    end function erfc
+
+end module p
+
+! { dg-final { cleanup-modules "p" } }
+
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_4.f90 b/gcc/testsuite/gfortran.dg/intrinsic_4.f90
new file mode 100644
index 000000000..300dfde1f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_4.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-Wsurprising" }
+!
+! PR 40995: [4.5 Regression] Spurious "Type specified for intrinsic function...ignored" message
+!
+! Contributed by Mat Cross <mathewc@nag.co.uk>
+
+subroutine sub(n,x)
+  intrinsic abs
+  integer n, x(abs(n))
+end
+
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_5.f90 b/gcc/testsuite/gfortran.dg/intrinsic_5.f90
new file mode 100644
index 000000000..77ecf32be
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_5.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-fimplicit-none" }
+!
+! PR 41121: [4.5 Regression] compile-time error when building BLAS with -fimplicit-none
+!
+! Original test case: http://www.netlib.org/blas/dgbmv.f
+! Reduced by Joost VandeVondele <jv244@cam.ac.uk>
+
+  INTRINSIC MIN
+  INTEGER :: I,J
+  print *,MIN(I,J)
+END
+
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_6.f90 b/gcc/testsuite/gfortran.dg/intrinsic_6.f90
new file mode 100644
index 000000000..1dccb556f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_6.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-fimplicit-none" }
+!
+! PR 45748: [4.5/4.6 Regression] -fimplicit-none failures when using intrinsic MAX
+!
+! Contributed by Themos Tsikas <themos.tsikas@gmail.com>
+
+SUBROUTINE BUG(WORK)
+  INTRINSIC MAX
+  DOUBLE PRECISION WORK(MAX(2,3))
+END
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_7.f90 b/gcc/testsuite/gfortran.dg/intrinsic_7.f90
new file mode 100644
index 000000000..69bca663b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_7.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+!
+! PR fortran/46411
+!
+! MOVE_ALLOC and other non-elemental but pure
+! procedures where regarded as impure.
+!
+
+pure subroutine test()
+  integer, allocatable :: a, b
+  allocate(a,b)
+  call move_alloc(a,b)
+end subroutine test
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_8.f90 b/gcc/testsuite/gfortran.dg/intrinsic_8.f90
new file mode 100644
index 000000000..a427c70b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_8.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+! PR fortran/52452
+!
+! Contributed by Roger Ferrer Ibanez
+!
+PROGRAM test_etime
+    IMPLICIT NONE
+    INTRINSIC :: etime
+    REAL(4) :: tarray(1:2)
+    REAL(4) :: result
+
+    CALL etime(tarray, result)
+END PROGRAM test_etime
+
+subroutine test_etime2
+    IMPLICIT NONE
+    INTRINSIC :: etime
+    REAL(4) :: tarray(1:2)
+    REAL(4) :: result
+
+    result = etime(tarray)
+END subroutine test_etime2
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_actual_1.f b/gcc/testsuite/gfortran.dg/intrinsic_actual_1.f
new file mode 100644
index 000000000..7596e3223
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_actual_1.f
@@ -0,0 +1,49 @@
+! { dg-do compile }
+! Tests the fix for PR27554, where the actual argument reference
+! to abs would not be recognised as being to an intrinsic
+! procedure and would produce junk in the assembler.
+!
+! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> 
+!
+      subroutine foo (proc, z)
+        external proc
+        real proc, z
+        if ((proc(z) .ne. abs (z)) .and. 
+     &      (proc(z) .ne. alog10 (abs(z)))) call abort ()
+        return
+      end
+
+        external cos
+        interface
+          function sin (a)
+            real a, sin
+          end function sin
+        end interface
+
+
+        intrinsic alog10
+        real x
+        x = 100.
+! The reference here would prevent the actual arg from being seen
+! as an intrinsic procedure in the call to foo.
+        x = -abs(x)
+        call foo(abs, x)
+! The intrinsic function can be locally over-ridden by an interface
+        call foo(sin, x)
+! or an external declaration.
+        call foo(cos, x)
+! Just make sure with another intrinsic but this time not referenced.
+        call foo(alog10, -x)
+      end
+
+      function sin (a)
+        real a, sin
+        sin = -a
+        return
+      end
+
+      function cos (a)
+        real a, cos
+        cos = -a
+        return
+      end
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_actual_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_actual_2.f90
new file mode 100644
index 000000000..d7a9c0d87
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_actual_2.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! Tests the fix for PR29387, in which array valued arguments of
+! LEN and ASSOCIATED would cause an ICE.
+!
+! Contributed by Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+!
+  integer  :: ans
+  TYPE T1 
+    INTEGER, POINTER :: I=>NULL() 
+  END TYPE T1
+  type(T1), pointer :: tar(:)
+ 
+  character(20) res
+
+  j = 10
+  PRINT *, LEN(SUB(8)), ans
+  PRINT *, LEN(SUB(j)), ans
+!  print *, len(SUB(j + 2)//"a"), ans   ! This still fails (no charlen).
+  print *, len(bar(2)), ans
+
+  IF(.NOT.ASSOCIATED(F1(10))) CALL ABORT()
+  deallocate (tar)
+
+CONTAINS
+
+  FUNCTION SUB(I)  
+    CHARACTER(LEN=I) :: SUB(1)
+    ans = LEN(SUB(1))
+    SUB = ""
+  END FUNCTION
+
+  FUNCTION BAR(I)  
+    CHARACTER(LEN=I*10) :: BAR(1)
+    ans = LEN(BAR)
+    BAR = ""
+  END FUNCTION
+
+  FUNCTION F1(I) RESULT(R) 
+   TYPE(T1), DIMENSION(:), POINTER :: R 
+   INTEGER :: I 
+   ALLOCATE(tar(I))
+   R => tar 
+  END FUNCTION F1
+END 
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_actual_3.f90 b/gcc/testsuite/gfortran.dg/intrinsic_actual_3.f90
new file mode 100644
index 000000000..c2dd07cda
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_actual_3.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! Tests the fix for PR30237 in which alternate returns in intrinsic
+! actual arglists were quietly ignored.
+!
+! Contributed by Brooks Moses <brooks@gcc.gnu.org>
+!
+program ar1
+    interface random_seed
+      subroutine x (a, *)
+        integer a
+      end subroutine x
+    end interface random_seed
+
+    real t1(2)
+    call cpu_time(*20)        ! { dg-error "not permitted" }
+    call cpu_time(*20, t1(1)) ! { dg-error "Too many arguments" }
+! This specific version is permitted by the generic interface.
+    call random_seed(i, *20)
+! The new error gets overwritten but the diagnostic is clear enough.
+    call random_seed(i, *20, *30) ! { dg-error "not consistent" }
+    stop
+20  write(*,*) t1
+30 stop
+end
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_actual_4.f90 b/gcc/testsuite/gfortran.dg/intrinsic_actual_4.f90
new file mode 100644
index 000000000..4ba4b79c7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_actual_4.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! Tests the fix for PR27900, in which an ICE would be caused because
+! the actual argument LEN had no type.
+!
+! Contributed by Klaus Ramstöck <klra67@freenet.de>
+!
+      subroutine sub (proc, chr)
+      external proc
+      integer proc
+      character*(*) chr
+      if (proc (chr) .ne. 6) call abort ()
+      end subroutine sub
+
+      implicit none
+      integer i
+      i = len ("123")
+      call sub (len, "abcdef")
+      end
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_argument_conformance_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_argument_conformance_1.f90
new file mode 100644
index 000000000..40f538242
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_argument_conformance_1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+program main
+  real :: av(2), bv(4)
+  real :: a(2,2)
+  logical :: lo(3,2)
+  print *,dot_product(av, bv) ! { dg-error "Different shape" }
+  print *,pack(a, lo) ! { dg-error "Different shape" }
+  print *,merge(av, bv, lo(1,:)) ! { dg-error "Different shape" }
+  print *,matmul(bv,a) ! { dg-error "Different shape" }
+end program main
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_argument_conformance_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_argument_conformance_2.f90
new file mode 100644
index 000000000..daff64f80
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_argument_conformance_2.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! Some CSHIFT, EOSHIFT and UNPACK conformance tests
+!
+program main
+  implicit none
+  real, dimension(1)   :: a1, b1, c1
+  real, dimension(1,1) :: a2, b2, c2
+  real, dimension(1,0) :: a, b, c
+  real :: tempn(1), tempv(5)
+  real,allocatable :: foo(:)
+  allocate(foo(0))
+  tempn = 2.0
+
+  a1 = 0
+  a2 = 0
+  c1 = 0
+  a2 = 0
+
+  b1 = cshift (a1,1)
+  b1 = cshift (a1,(/1/)) ! { dg-error "must be a scalar" }
+  b1 = eoshift (a1,1)
+  b2 = eoshift (a1,c1(1)) ! { dg-error "must be INTEGER" }
+  b1 = eoshift (a1,(/1/)) ! { dg-error "must be a scalar" }
+  b1 = eoshift (a1,1,boundary=c1) ! { dg-error "must be a scalar" }
+  b1 = eoshift (a1,(/1/), boundary=c2) ! { dg-error "must be a scalar" }
+
+  b2 = cshift (a2,1)
+  b2 = cshift (a2,(/1/))
+  b2 = cshift (a2,reshape([1],[1,1])) ! { dg-error "have rank 1 or be a scalar" }
+  b2 = eoshift (a2,1)
+  b2 = eoshift (a2,c1) ! { dg-error "must be INTEGER" }
+  b2 = eoshift (a2,(/1/))
+  b2 = eoshift (a2,reshape([1],[1,1]), boundary=c1) ! { dg-error "have rank 1 or be a scalar" }
+  b2 = eoshift (a2,1,boundary=c2(:,:)) ! { dg-error "have rank 1 or be a scalar" }
+  b2 = eoshift (a2,(/1/), boundary=c2(:,:)) ! { dg-error "have rank 1 or be a scalar" }
+
+  b = eoshift (a,(/1/), boundary=c(1,:)) ! { dg-error "invalid shape in dimension" }
+
+  if (any(eoshift(foo,dim=1,shift=1,boundary=(/42.0,-7.0/))/= 0)) call abort() ! { dg-error "must be a scalar" }
+  if (any(eoshift(tempn(2:1),dim=1,shift=1,boundary=(/42.0,-7.0/))/= 0)) call abort() ! { dg-error "must be a scalar" }
+
+  if (any(unpack(tempv,tempv(1:0)/=0,tempv) /= -47)) call abort() ! { dg-error "must have identical shape" }
+  if (any(unpack(tempv(5:4),tempv(1:0)/=0,tempv) /= -47)) call abort() ! { dg-error "must have identical shape" }
+end program main
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_char_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_char_1.f90
new file mode 100644
index 000000000..845493cb6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_char_1.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! Tests the fix for PR35932, in which the KIND argument of CHAR
+! was not converted and this screwed up the scalarizer.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+program FA0005
+
+  CHARACTER(1) CDA1(10)
+  character(10) CDA10
+  INTEGER :: IDA(10) = [(i, i = 97,106)]
+
+  CDA1 = CHAR (  IDA, KIND("A" ))     !failed
+  if (transfer (CDA1, CDA10) /= "abcdefghij") call abort ()
+  CDA1 = CHAR (  IDA  )               !worked
+  if (transfer (CDA1, CDA10) /= "abcdefghij") call abort ()
+END 
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_cmplx.f90 b/gcc/testsuite/gfortran.dg/intrinsic_cmplx.f90
new file mode 100644
index 000000000..744e77a85
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_cmplx.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR fortran/40727
+program test
+  integer, parameter :: sp = kind(1.e0), dp = kind(1.d0)
+  complex(sp) :: s
+  complex(dp) :: d
+  s =  cmplx(0.e0, cmplx(0.e0,0.e0)) ! { dg-error "either REAL or INTEGER" }
+  d = dcmplx(0.d0, cmplx(0.d0,0.d0)) ! { dg-error "either REAL or INTEGER" }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_external_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_external_1.f90
new file mode 100644
index 000000000..7d590126f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_external_1.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! PR fortran/20869
+! Note 12.11 "A name shall not appear in both an EXTERNAL and an
+! INTRINSIC statement in the same scoping unit.
+program u
+  intrinsic :: nint
+  external :: nint  ! { dg-error "EXTERNAL attribute conflicts with INTRINSIC attribute" }
+end program u
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_ifunction_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_ifunction_1.f90
new file mode 100644
index 000000000..a27c220ee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_ifunction_1.f90
@@ -0,0 +1,43 @@
+! { dg-do run }
+! PR 35995 - ifunction.m4 and ifunction_logical.m4 had a bug
+! where zero-sized arguments were not handled correctly.
+! Test case provided by Dick Hendrickson, amended by
+! Thomas Koenig.
+
+      program try_gf0026_etc
+
+      call       gf0026(  0,  1)
+      call       foo   (  0,  1)
+
+      end program
+
+      SUBROUTINE GF0026(nf0,nf1)
+      LOGICAL LDA(9)
+      INTEGER IDA(NF0,9), iii(9)
+
+      lda = (/ (i/2*2 .eq. I, i=1,9) /)
+      LDA = ALL ( IDA .NE. -1000,  1)
+      if (.not. all(lda)) call abort
+      if (.not. all(ida .ne. -1000)) call abort
+
+      lda = (/ (i/2*2 .eq. I, i=1,9) /)
+      LDA = any ( IDA .NE. -1000,  1)
+      print *, lda          !expect FALSE
+      if (any(lda)) call abort
+      print *, any(ida .ne. -1000)   !expect FALSE
+      if (any(ida .ne. -1000)) call abort
+
+      iii = 137
+      iii = count ( IDA .NE. -1000,  1)
+      if (any(iii /= 0)) call abort
+      if (count(ida .ne. -1000) /= 0) call abort
+
+      END SUBROUTINE
+
+      subroutine foo (nf0, nf1)
+      integer, dimension(9):: res, iii
+      integer, dimension(nf0,9) :: ida
+      res = (/ (-i, i=1,9) /)
+      res = product (ida, 1)
+      if (any(res /= 1)) call abort
+      end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_ifunction_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_ifunction_2.f90
new file mode 100644
index 000000000..1014cfff3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_ifunction_2.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+! PR 48066 - this used to segfault.
+program p
+  real(8) :: empty(0, 3), square(0)
+  logical :: lempty(0, 3), lsquare(0)
+  square = sum(empty * empty, 2)
+  lsquare = any(lempty .and. lempty, 2)
+end
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_intent_1.f03 b/gcc/testsuite/gfortran.dg/intrinsic_intent_1.f03
new file mode 100644
index 000000000..1f39f7551
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_intent_1.f03
@@ -0,0 +1,11 @@
+! { dg-do compile }
+
+! PR fortran/45474
+! Definability checks for INTENT([IN]OUT) and intrinsics.
+
+! Contributed by Tobias Burnus, burnus@gcc.gnu.org.
+
+call execute_command_line("date", .true.,(1),1,'aa') ! { dg-error "variable definition context" }
+call execute_command_line("date", .true.,1,(1),'aa') ! { dg-error "variable definition context" }
+call execute_command_line("date", .true.,1,1,('aa')) ! { dg-error "variable definition context" }
+end
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_intkinds_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_intkinds_1.f90
new file mode 100644
index 000000000..ea5057ac8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_intkinds_1.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! Test assorted intrinsics for integer kinds 1 and 2
+program main
+  integer(kind=1), dimension(2,2) :: a
+  integer(kind=2), dimension(2,2) :: b
+  integer(kind=1), dimension(2) :: r1
+  integer(kind=2), dimension(2) :: r2
+  logical, dimension(2,2) :: ma
+  ma = .false.
+  a = reshape((/ 1_1, 2_1, 3_1, 4_1/), shape(a))
+  b = reshape((/ 1_2, 2_2, 3_2, 4_2/), shape(b))
+  if (any(sum(a,dim=2) /= (/ 4, 6 /))) call abort
+  if (any(sum(b,dim=2) /= (/ 4, 6 /))) call abort
+  if (any(product(a,dim=2) /= (/ 3, 8 /))) call abort
+  if (any(product(b,dim=2) /= (/ 3, 8 /))) call abort
+  if (any(matmul(a,a) /= reshape ( (/ 7, 10, 15, 22 /), shape(a)))) call abort
+  if (any(matmul(b,b) /= reshape ( (/ 7, 10, 15, 22 /), shape(b)))) call abort
+  if (any(maxval(a,dim=2,mask=ma) /= -128)) call abort
+  if (any(maxval(b,dim=2,mask=ma) /= -32768)) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_modulo_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_modulo_1.f90
new file mode 100644
index 000000000..6d44f451a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_modulo_1.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+! testcase from PR 19032 adapted for testsuite
+! Our implementation of modulo was wrong for P = 1 and P = -1,
+! both in the real and the integer case
+program main
+  integer, parameter :: n=16
+  real, dimension(n) :: ar, br, modulo_result, floor_result
+  integer, dimension(n) :: ai, bi , imodulo_result, ifloor_result
+
+  ai(1:4) = 5
+  ai(5:8) = -5
+  ai(9:12) = 1
+  ai(13:16) = -1
+  bi(1:4) = (/ 3,-3, 1, -1/)
+  bi(5:8) = bi(1:4)
+  bi(9:12) = bi(1:4)
+  bi(13:16) = bi(1:4)
+  ar = ai
+  br = bi
+  modulo_result = modulo(ar,br)
+  imodulo_result = modulo(ai,bi)
+  floor_result = ar-floor(ar/br)*br
+  ifloor_result = nint(real(ai-floor(real(ai)/real(bi))*bi))
+
+  do i=1,n
+     if (modulo_result(i) /= floor_result(i) ) then
+!        print "(A,4F5.0)" ,"real case failed: ", &
+!             ar(i),br(i), modulo_result(i), floor_result(i)
+        call abort()
+    end if
+    if (imodulo_result(i) /= ifloor_result(i)) then
+!       print "(A,4I5)", "int case failed: ", &
+!            ai(i), bi(i), imodulo_result(i), ifloor_result(i)
+       call abort ()
+     end if
+  end do
+end program main
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_numeric_arg.f b/gcc/testsuite/gfortran.dg/intrinsic_numeric_arg.f
new file mode 100644
index 000000000..3257d456f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_numeric_arg.f
@@ -0,0 +1,9 @@
+! this test checks for a non-numeric argument to an
+! intrinsic function (of which ABS() is one of many).
+!      { dg-do compile }
+       LOGICAL Z
+       CHARACTER A
+       REAL R
+       R = ABS(Z) !  { dg-error " must be a numeric type" }
+       R = ABS(A) !  { dg-error " must be a numeric type" }
+       END
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_optional_char_arg_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_optional_char_arg_1.f90
new file mode 100644
index 000000000..3215f43fa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_optional_char_arg_1.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+
+! PR fortran/36403
+! Check that string lengths of optional arguments are added to the library-call
+! even if those arguments are missing.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  CHARACTER(len=1) :: vect(4)
+  CHARACTER(len=1) :: matrix(2, 2)
+
+  matrix(1, 1) = ""
+  matrix(2, 1) = "a"
+  matrix(1, 2) = "b"
+  matrix(2, 2) = ""
+  vect = (/ "w", "x", "y", "z" /)
+
+  ! Call the affected intrinsics
+  vect = EOSHIFT (vect, 2)
+  vect = PACK (matrix, matrix /= "")
+  matrix = RESHAPE (vect, (/ 2, 2 /))
+
+END PROGRAM main
+
+! All library function should be called with *two* trailing arguments "1" for
+! the string lengths of both the main array and the optional argument:
+! { dg-final { scan-tree-dump "_eoshift\[0-9_\]+char \\(\[&a-zA-Z0-9._, \]+, 1, 0\\)" "original" } }
+! { dg-final { scan-tree-dump "_reshape\[0-9_\]+char \\(\[&a-zA-Z0-9._, \]+, 1, 0\\)" "original" } }
+! { dg-final { scan-tree-dump "_pack\[0-9_\]+char \\(\[&a-zA-Z0-9._, \]+, 1, 0\\)" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_pack_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_pack_1.f90
new file mode 100644
index 000000000..22d110ba7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_pack_1.f90
@@ -0,0 +1,115 @@
+! { dg-do run }
+! Take the pack intrinsic through its paces, with all types that are
+! normally accessible.
+program main
+  implicit none
+  integer :: i
+  real(kind=4), dimension(3,3) :: r4
+  real(kind=4), dimension(9) :: vr4
+  real(kind=4), dimension(9) :: rr4
+  real(kind=8), dimension(3,3) :: r8
+  real(kind=8), dimension(9) :: vr8
+  real(kind=8), dimension(9) :: rr8
+  complex(kind=4), dimension(3,3) :: c4
+  complex(kind=4), dimension(9) :: vc4
+  complex(kind=4), dimension(9) :: rc4
+  complex(kind=8), dimension(3,3) :: c8
+  complex(kind=8), dimension(9) :: vc8
+  complex(kind=8), dimension(9) :: rc8
+  integer(kind=1), dimension(3,3) :: i1
+  integer(kind=1), dimension(9) :: vi1
+  integer(kind=1), dimension(9) :: ri1
+  integer(kind=2), dimension(3,3) :: i2
+  integer(kind=2), dimension(9) :: vi2
+  integer(kind=2), dimension(9) :: ri2
+  integer(kind=4), dimension(3,3) :: i4
+  integer(kind=4), dimension(9) :: vi4
+  integer(kind=4), dimension(9) :: ri4
+  integer(kind=8), dimension(3,3) :: i8
+  integer(kind=8), dimension(9) :: vi8
+  integer(kind=8), dimension(9) :: ri8
+
+  type i1_t
+    integer(kind=1) :: v
+  end type i1_t
+  type(i1_t), dimension(3,3) :: d_i1
+  type(i1_t), dimension(9) :: d_vi1
+  type(i1_t), dimension(9) :: d_ri1
+
+  type i4_t
+    integer(kind=4) :: v
+  end type i4_t
+  type(i4_t), dimension(3,3) :: d_i4
+  type(i4_t), dimension(9) :: d_vi4
+  type(i4_t), dimension(9) :: d_ri4
+
+  d_vi1%v = (/(i+10,i=1,9)/)
+  d_i1%v = reshape((/1_1, -1_1, 2_1, -2_1, 3_1, -3_1, 4_1, &
+                    & -4_1, 5_1/), shape(i1))
+  d_ri1 = pack(d_i1,d_i1%v>0,d_vi1)
+  if (any(d_ri1%v /= (/1_1, 2_1, 3_1, 4_1, 5_1, 16_1, 17_1, 18_1, 19_1/))) &
+       & call abort
+
+  d_vi4%v = (/(i+10,i=1,9)/)
+  d_i4%v = reshape((/1_4, -1_4, 2_4, -2_4, 3_4, -3_4, 4_4, &
+                    & -4_4, 5_4/), shape(d_i4))
+  d_ri4 = pack(d_i4,d_i4%v>0,d_vi4)
+  if (any(d_ri4%v /= (/1_4, 2_4, 3_4, 4_4, 5_4, 16_4, 17_4, 18_4, 19_4/))) &
+       & call abort
+
+  vr4 = (/(i+10,i=1,9)/)
+  r4 = reshape((/1.0_4, -3.0_4, 2.1_4, -4.21_4, 1.2_4, 0.98_4, -1.2_4, &
+  &              -7.1_4, -9.9_4, 0.3_4 /), shape(r4))
+  rr4 = pack(r4,r4>0,vr4)
+  if (any(rr4 /= (/ 1.0_4, 2.1_4, 1.2_4, 0.98_4,  15._4, 16._4, 17._4, &
+  &                  18._4, 19._4 /))) call abort
+
+  vr8 = (/(i+10,i=1,9)/)
+  r8 = reshape((/1.0_8, -3.0_8, 2.1_8, -4.21_8, 1.2_8, 0.98_8, -1.2_8, &
+  &              -7.1_8, -9.9_8, 0.3_8 /), shape(r8))
+  rr8 = pack(r8,r8>0,vr8)
+  if (any(rr8 /= (/ 1.0_8, 2.1_8, 1.2_8, 0.98_8,  15._8, 16._8, 17._8, &
+  &                  18._8, 19._8 /))) call abort
+
+  vc4 = (/(i+10,i=1,9)/)
+  c4 = reshape((/1.0_4, -3.0_4, 2.1_4, -4.21_4, 1.2_4, 0.98_4, -1.2_4, &
+  &              -7.1_4, -9.9_4, 0.3_4 /), shape(c4))
+  rc4 = pack(c4,real(c4)>0,vc4)
+  if (any(real(rc4) /= (/ 1.0_4, 2.1_4, 1.2_4, 0.98_4,  15._4, 16._4, 17._4, &
+  &                  18._4, 19._4 /))) call abort
+  if (any(aimag(rc4) /= 0)) call abort
+
+  vc8 = (/(i+10,i=1,9)/)
+  c8 = reshape((/1.0_4, -3.0_4, 2.1_4, -4.21_4, 1.2_4, 0.98_4, -1.2_4, &
+  &              -7.1_4, -9.9_4, 0.3_4 /), shape(c8))
+  rc8 = pack(c8,real(c8)>0,vc8)
+  if (any(real(rc8) /= (/ 1.0_4, 2.1_4, 1.2_4, 0.98_4,  15._4, 16._4, 17._4, &
+  &                  18._4, 19._4 /))) call abort
+  if (any(aimag(rc8) /= 0)) call abort
+
+  vi1 = (/(i+10,i=1,9)/)
+  i1 = reshape((/1_1, -1_1, 2_1, -2_1, 3_1, -3_1, 4_1, -4_1, 5_1/), shape(i1))
+  ri1 = pack(i1,i1>0,vi1)
+  if (any(ri1 /= (/1_1, 2_1, 3_1, 4_1, 5_1, 16_1, 17_1, 18_1, 19_1/))) &
+       & call abort
+
+  vi2 = (/(i+10,i=1,9)/)
+  i2 = reshape((/1_2, -1_2, 2_2, -2_2, 3_2, -3_2, 4_2, -4_2, 5_2/), shape(i2))
+  ri2 = pack(i2,i2>0,vi2)
+  if (any(ri2 /= (/1_2, 2_2, 3_2, 4_2, 5_2, 16_2, 17_2, 18_2, 19_2/))) &
+       & call abort
+
+  vi4 = (/(i+10,i=1,9)/)
+  i4 = reshape((/1_4, -1_4, 2_4, -2_4, 3_4, -3_4, 4_4, -4_4, 5_4/), shape(i4))
+  ri4 = pack(i4,i4>0,vi4)
+  if (any(ri4 /= (/1_4, 2_4, 3_4, 4_4, 5_4, 16_4, 17_4, 18_4, 19_4/))) &
+       & call abort
+
+  vi8 = (/(i+10,i=1,9)/)
+  i8 = reshape((/1_8, -1_8, 2_8, -2_8, 3_8, -3_8, 4_8, -4_8, 5_8/), shape(i8))
+  ri8 = pack(i8,i8>0,vi8)
+  if (any(ri8 /= (/1_8, 2_8, 3_8, 4_8, 5_8, 16_8, 17_8, 18_8, 19_8/))) &
+       & call abort
+
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_pack_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_pack_2.f90
new file mode 100644
index 000000000..642cd5c1f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_pack_2.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+! Take the pack intrinsic through its paces, with all types that are
+! normally accessible.
+program main
+  implicit none
+  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+  integer :: i
+  real(kind=k), dimension(3,3) :: rk
+  real(kind=k), dimension(9) :: vrk
+  real(kind=k), dimension(9) :: rrk
+  complex(kind=k), dimension(3,3) :: ck
+  complex(kind=k), dimension(9) :: vck
+  complex(kind=k), dimension(9) :: rck
+
+  vrk = (/(i+10,i=1,9)/)
+  rk = reshape((/1.0_k, -3.0_k, 2.1_k, -4.21_k, 1.2_k, 0.98_k, -1.2_k, &
+  &              -7.1_k, -9.9_k, 0.3_k /), shape(rk))
+  rrk = pack(rk,rk>0,vrk)
+  if (any(rrk /= (/ 1.0_k, 2.1_k, 1.2_k, 0.98_k,  15._k, 16._k, 17._k, &
+  &                  18._k, 19._k /))) call abort
+
+  vck = (/(i+10,i=1,9)/)
+  ck = reshape((/1.0_k, -3.0_k, 2.1_k, -4.21_k, 1.2_k, 0.98_k, -1.2_k, &
+  &              -7.1_k, -9.9_k, 0.3_k /), shape(ck))
+  rck = pack(ck,real(ck)>0,vck)
+  if (any(real(rck) /= (/ 1.0_k, 2.1_k, 1.2_k, 0.98_k,  15._k, 16._k, 17._k, &
+  &                  18._k, 19._k /))) call abort
+  if (any(aimag(rck) /= 0)) call abort
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_pack_3.f90 b/gcc/testsuite/gfortran.dg/intrinsic_pack_3.f90
new file mode 100644
index 000000000..d559e9112
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_pack_3.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_int }
+! Take the pack intrinsic through its paces, with all types that are
+! normally accessible.
+program main
+  implicit none
+  integer,parameter :: k = selected_int_kind (range (0_8) + 1)
+  integer :: i
+  integer(kind=k), dimension(3,3) :: ik
+  integer(kind=k), dimension(9) :: vik
+  integer(kind=k), dimension(9) :: rik
+
+  vik = (/(i+10,i=1,9)/)
+  ik = reshape((/1_k, -1_k, 2_k, -2_k, 3_k, -3_k, 4_k, -4_k, 5_k/), shape(ik))
+  rik = pack(ik,ik>0,vik)
+  if (any(rik /= (/1_k, 2_k, 3_k, 4_k, 5_k, 16_k, 17_k, 18_k, 19_k/))) &
+       & call abort
+
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_pack_4.f90 b/gcc/testsuite/gfortran.dg/intrinsic_pack_4.f90
new file mode 100644
index 000000000..691036817
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_pack_4.f90
@@ -0,0 +1,72 @@
+! { dg-do run }
+! PR 35990 - some empty array sections caused pack to crash.
+! Test case contributed by Dick Hendrickson, adjusted and
+! extended by Thomas Koenig.
+      program try_gf1048
+
+      call       gf1048a(  10,  8,  7,  1,  0,  .true.) 
+      call       gf1048b(  10,  8,  7,  1,  0,  .true.) 
+      call       gf1048c(  10,  8,  7,  1,  0,  .true.) 
+      call       gf1048d(  10,  8,  7,  1,  0,  .true.) 
+      call       P_inta (  10,  8,  7,  1,  0,  .true.)    
+      call       P_intb (  10,  8,  7,  1,  0,  .true.)    
+      call       P_intc (  10,  8,  7,  1,  0,  .true.)    
+      call       P_intd (  10,  8,  7,  1,  0,  .true.)    
+      end program
+
+      SUBROUTINE GF1048a(nf10,nf8,nf7,nf1,nf0,nf_true)
+      logical nf_true
+      CHARACTER(9) BDA(10)
+      CHARACTER(9) BDA1(10)
+      BDA(  8:7) = PACK(BDA1( 10:  1), NF_TRUE)
+      END SUBROUTINE
+
+      SUBROUTINE GF1048b(nf10,nf8,nf7,nf1,nf0,nf_true)
+      logical nf_true
+      CHARACTER(9) BDA(10)
+      CHARACTER(9) BDA1(nf10)
+      BDA(NF8:NF7) = PACK(BDA1(NF8:NF7), NF_TRUE)
+      END SUBROUTINE
+
+      SUBROUTINE GF1048c(nf10,nf8,nf7,nf1,nf0,nf_true)
+      logical nf_true
+      CHARACTER(9) BDA(10)
+      CHARACTER(9) BDA1(10)
+      BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE)
+      END SUBROUTINE
+
+      SUBROUTINE GF1048d(nf10,nf8,nf7,nf1,nf0,nf_true)
+      logical nf_true
+      CHARACTER(9) BDA(10)
+      CHARACTER(9) BDA1(nf10)
+      BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE)
+      END SUBROUTINE
+
+      SUBROUTINE P_INTa(nf10,nf8,nf7,nf1,nf0,nf_true)
+      logical nf_true
+      INTEGER BDA(10)
+      INTEGER BDA1(10)
+      BDA(  8:7) = PACK(BDA1( 10:  1), NF_TRUE)
+      END SUBROUTINE
+
+      SUBROUTINE P_INTb(nf10,nf8,nf7,nf1,nf0,nf_true)
+      logical nf_true
+      INTEGER BDA(10)
+      INTEGER BDA1(nf10)
+      BDA(NF8:NF7) = PACK(BDA1(NF8:NF7), NF_TRUE)
+      END SUBROUTINE
+
+      SUBROUTINE P_INTc(nf10,nf8,nf7,nf1,nf0,nf_true)
+      logical nf_true
+      INTEGER BDA(10)
+      INTEGER BDA1(10)
+      BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE)
+      END SUBROUTINE
+
+      SUBROUTINE P_INTd(nf10,nf8,nf7,nf1,nf0,nf_true)
+      logical nf_true
+      INTEGER BDA(10)
+      INTEGER BDA1(nf10)
+      BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE)
+      END SUBROUTINE
+
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_pack_5.f90 b/gcc/testsuite/gfortran.dg/intrinsic_pack_5.f90
new file mode 100644
index 000000000..c0540b63d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_pack_5.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+!
+! PR 41478: Corrupted memory using PACK for derived-types with allocated components
+! PR 42268: [4.4/4.5 Regression] derived type segfault with pack
+!
+! Original test case by Juergen Reuter <reuter@physik.uni-freiburg.de>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+type :: container_t
+  integer:: entry = -1
+end type container_t
+type(container_t), dimension(1) :: a1, a2
+a2(1)%entry = 1
+a1 = pack (a2, mask = [.true.])
+if (a1(1)%entry/=1) call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_product_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_product_1.f90
new file mode 100644
index 000000000..34d34fe81
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_product_1.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! PR 35993 - some intrinsics with mask = .false. didn't set
+! the whole return array for multi-dimensional arrays.
+! Test case adapted from Dick Hendrickson.
+
+      program try
+
+      call       ga3019(  1,  2,  3,  4)
+      end program
+
+      SUBROUTINE GA3019(nf1,nf2,nf3,nf4)
+      INTEGER IDA(NF2,NF3)
+      INTEGER IDA1(NF2,NF4,NF3)
+
+      ida1 = 3
+
+      ida = -3
+      IDA(NF1:NF2,NF1:NF3) = PRODUCT(IDA1,NF2, NF1 .LT. 0)  !fails
+      if (any(ida /= 1)) call abort
+
+      ida = -3
+      IDA(NF1:NF2,NF1:NF3) = PRODUCT(IDA1,NF2, .false. )    !fails
+      if (any(ida /= 1)) call abort
+
+      ida = -3
+      IDA(NF1:NF2,NF1:NF3) = PRODUCT(IDA1,NF2, ida1 .eq. 137 )    !works
+      if (any(ida /= 1)) call abort
+
+      END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_shadow_1.f03 b/gcc/testsuite/gfortran.dg/intrinsic_shadow_1.f03
new file mode 100644
index 000000000..776d0f692
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_shadow_1.f03
@@ -0,0 +1,57 @@
+! { dg-do compile }
+! { dg-options "-std=f2003 -Wintrinsic-shadow" }
+
+! PR fortran/33141
+! Check that the expected warnings are emitted if a user-procedure has the same
+! name as an intrinsic, but only if it is matched by the current -std=*.
+
+MODULE testmod
+  IMPLICIT NONE
+
+CONTAINS
+
+  ! ASIN is an intrinsic
+  REAL FUNCTION asin (arg) ! { dg-warning "shadow the intrinsic" }
+    IMPLICIT NONE
+    REAL :: arg
+  END FUNCTION asin
+
+  ! ASINH is one but not in F2003
+  REAL FUNCTION asinh (arg) ! { dg-bogus "shadow the intrinsic" }
+    IMPLICIT NONE
+    REAL :: arg
+  END FUNCTION asinh
+
+END MODULE testmod
+
+! ACOS is an intrinsic
+REAL FUNCTION acos (arg) ! { dg-warning "of an intrinsic" }
+  IMPLICIT NONE
+  REAL :: arg
+END FUNCTION acos
+
+! ACOSH not for F2003
+REAL FUNCTION acosh (arg) ! { dg-bogus "of an intrinsic" }
+  IMPLICIT NONE
+  REAL :: arg
+END FUNCTION acosh
+
+! A subroutine with the same name as an intrinsic subroutine
+SUBROUTINE random_number (arg) ! { dg-warning "of an intrinsic" }
+  IMPLICIT NONE
+  REAL, INTENT(OUT) :: arg
+END SUBROUTINE random_number
+
+! But a subroutine with the name of an intrinsic function is ok.
+SUBROUTINE atan (arg) ! { dg-bogus "of an intrinsic" }
+  IMPLICIT NONE
+  REAL :: arg
+END SUBROUTINE atan
+
+! As should be a function with the name of an intrinsic subroutine.
+REAL FUNCTION random_seed () ! { dg-bogus "of an intrinsic" }
+END FUNCTION random_seed
+
+! We do only compile, so no main program needed.
+
+! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_shadow_2.f03 b/gcc/testsuite/gfortran.dg/intrinsic_shadow_2.f03
new file mode 100644
index 000000000..5c046166d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_shadow_2.f03
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! { dg-options "-std=f2003 -Wintrinsic-shadow -fall-intrinsics" }
+
+! PR fortran/33141
+! Check that the expected warnings are emitted if a user-procedure has the same
+! name as an intrinsic, with -fall-intrinsics even regardless of std=*.
+
+MODULE testmod
+  IMPLICIT NONE
+
+CONTAINS
+
+  ! ASINH is one but not in F2003
+  REAL FUNCTION asinh (arg) ! { dg-warning "shadow the intrinsic" }
+    IMPLICIT NONE
+    REAL :: arg
+  END FUNCTION asinh
+
+END MODULE testmod
+
+! ACOSH not for F2003
+REAL FUNCTION acosh (arg) ! { dg-warning "of an intrinsic" }
+  IMPLICIT NONE
+  REAL :: arg
+END FUNCTION acosh
+
+! We do only compile, so no main program needed.
+
+! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_shadow_3.f03 b/gcc/testsuite/gfortran.dg/intrinsic_shadow_3.f03
new file mode 100644
index 000000000..069a99b34
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_shadow_3.f03
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-Wno-intrinsic-shadow -fall-intrinsics" }
+
+! PR fortran/33141
+! Check that the "intrinsic shadow" warnings are not emitted if the warning
+! is negated.
+
+MODULE testmod
+  IMPLICIT NONE
+
+CONTAINS
+
+  REAL FUNCTION asin (arg) ! { dg-bogus "shadow the intrinsic" }
+    IMPLICIT NONE
+    REAL :: arg
+  END FUNCTION asin
+
+END MODULE testmod
+
+REAL FUNCTION acos (arg) ! { dg-bogus "of an intrinsic" }
+  IMPLICIT NONE
+  REAL :: arg
+END FUNCTION acos
+
+! We do only compile, so no main program needed.
+
+! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_sign_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_sign_1.f90
new file mode 100644
index 000000000..03addde78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_sign_1.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! At one point, SIGN() evaluated its first argument twice.
+! Contributed by Brooks Moses <brooks.moses@codesourcery.com>
+program sign1
+  integer :: i
+  i = 1
+  if (sign(foo(i), 1) /= 1) call abort
+  i = 1
+  if (sign(foo(i), -1) /= -1) call abort
+contains
+  integer function foo(i)
+    integer :: i
+    foo = i
+    i = i + 1
+  end function
+end
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_sign_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_sign_2.f90
new file mode 100644
index 000000000..0bc9b07b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_sign_2.f90
@@ -0,0 +1,69 @@
+! { dg-do run }
+! Testcase for SIGN() with integer arguments
+! Check that:
+!   + SIGN() evaluates its arguments only once
+!   + SIGN() works on large values
+!   + SIGN() works with parameter arguments
+! Contributed by FX Coudert <fxcoudert@gmail.com>
+program sign1
+  implicit none
+  integer(kind=1), parameter :: one1 = 1_1, mone1 = -1_1
+  integer(kind=2), parameter :: one2 = 1_2, mone2 = -1_2
+  integer(kind=4), parameter :: one4 = 1_4, mone4 = -1_4
+  integer(kind=8), parameter :: one8 = 1_8, mone8 = -1_8
+  integer(kind=1) :: i1, j1
+  integer(kind=2) :: i2, j2
+  integer(kind=4) :: i4, j4
+  integer(kind=8) :: i8, j8
+  integer :: i = 1
+
+  i1 = huge(0_1) ; j1 = -huge(0_1)
+  if (sign(i1, j1) /= j1) call abort()
+  if (sign(j1, i1) /= i1) call abort()
+  if (sign(i1,one1) /= i1 .or. sign(j1,one1) /= i1) call abort()
+  if (sign(i1,mone1) /= j1 .or. sign(j1,mone1) /= j1) call abort()
+
+  i2 = huge(0_2) ; j2 = -huge(0_2)
+  if (sign(i2, j2) /= j2) call abort()
+  if (sign(j2, i2) /= i2) call abort()
+  if (sign(i2,one2) /= i2 .or. sign(j2,one2) /= i2) call abort()
+  if (sign(i2,mone2) /= j2 .or. sign(j2,mone2) /= j2) call abort()
+
+  i4 = huge(0_4) ; j4 = -huge(0_4)
+  if (sign(i4, j4) /= j4) call abort()
+  if (sign(j4, i4) /= i4) call abort()
+  if (sign(i4,one4) /= i4 .or. sign(j4,one4) /= i4) call abort()
+  if (sign(i4,mone4) /= j4 .or. sign(j4,mone4) /= j4) call abort()
+
+  i8 = huge(0_8) ; j8 = -huge(0_8)
+  if (sign(i8, j8) /= j8) call abort()
+  if (sign(j8, i8) /= i8) call abort()
+  if (sign(i8,one8) /= i8 .or. sign(j8,one8) /= i8) call abort()
+  if (sign(i8,mone8) /= j8 .or. sign(j8,mone8) /= j8) call abort()
+
+  if (sign(foo(i), 1) /= 1) call abort
+  if (sign(foo(i), -1) /= -2) call abort
+  if (sign(42, foo(i)) /= 42) call abort
+  if (sign(42, -foo(i)) /= -42) call abort
+  if (i /= 5) call abort
+
+  if (sign(bar(), 1) /= 1) call abort
+  if (sign(bar(), -1) /= -2) call abort
+  if (sign(17, bar()) /= 17) call abort
+  if (sign(17, -bar()) /= -17) call abort
+  if (bar() /= 5) call abort
+
+contains
+
+  integer function foo(i)
+    integer :: i
+    foo = i
+    i = i + 1
+  end function
+
+  integer function bar()
+    integer, save :: i = 0
+    i = i + 1
+    bar = i
+  end function
+end
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_signal.f90 b/gcc/testsuite/gfortran.dg/intrinsic_signal.f90
new file mode 100644
index 000000000..cb57c952a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_signal.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+!
+! PR fortran/49690
+!
+! Reduced test case, based on the one of Debian bug #631204
+!
+
+subroutine ctrlc_ast
+   common /xinterrupt/ interrupted
+   logical interrupted
+   interrupted = .true.
+end subroutine ctrlc_ast  
+
+subroutine set_ctrl_c(ctrlc_ast)
+   external ctrlc_ast
+   intrinsic signal
+   integer old_handle
+   common /xinterrupt/ interrupted
+   logical interrupted
+   old_handler = signal(2, ctrlc_ast)    
+end subroutine set_ctrl_c
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_size.f90 b/gcc/testsuite/gfortran.dg/intrinsic_size.f90
new file mode 100644
index 000000000..284c649bd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_size.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+!
+! Argument checking; dim and kind have to be scalar
+!
+! PR fortran/33297
+!
+  integer array(5), i1, i2
+  print *, size(array,(/i1,i2/))  ! { dg-error "must be a scalar" }
+  print *, size(array,i1,(/i1,i2/))  ! { dg-error "must be a scalar" }
+  end
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_size_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_size_2.f90
new file mode 100644
index 000000000..6070bc21b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_size_2.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+!
+! PR fortran/51904
+!
+! Contributed by David Sagan.
+!
+
+call qp_draw_polyline_basic([1.0,2.0])
+contains
+subroutine qp_draw_polyline_basic (x)
+  implicit none
+  real :: x(:), f
+  integer :: i
+  f = 0
+  print *, size(f*x)
+end subroutine
+end
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_size_3.f90 b/gcc/testsuite/gfortran.dg/intrinsic_size_3.f90
new file mode 100644
index 000000000..5856509bf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_size_3.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/55852
+!
+! Contributed by A. Kasahara
+!
+program bug
+  implicit none
+
+  Real, allocatable:: a(:)
+  integer(2) :: iszs
+
+  allocate(a(1:3))
+
+  iszs = ubound((a), 1)! Was ICEing
+!  print*, ubound((a), 1) ! Was ICEing
+! print*, ubound(a, 1)   ! OK
+! print*, lbound((a), 1) ! OK
+! print*, lbound(a, 1)   ! OK
+
+  stop
+end program bug
+
+! { dg-final { scan-tree-dump-times "iszs = \\(integer\\(kind=2\\)\\) MAX_EXPR <\\(D.\[0-9\]+->dim.0..ubound - D.\[0-9\]+->dim.0..lbound\\) \\+ 1, 0>;" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_size_4.f90 b/gcc/testsuite/gfortran.dg/intrinsic_size_4.f90
new file mode 100644
index 000000000..6d8e1c0b5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_size_4.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! Test the fix for PR55362; the error below was missed and an ICE ensued.
+!
+! ! Contributed by Dominique d'Humieres  <dominiq@lps.ens.fr>
+!
+program ice_test
+  implicit none
+  write(*,*) 'message: ', &
+             size(Error_Msg),Error_Msg()     ! { dg-error "must be an array" }
+  write(*,*) 'message: ', &
+             size(Error_Msg ()),Error_Msg()  ! OK of course
+contains
+  function Error_Msg() result(ErrorMsg)
+    character, dimension(:), pointer :: ErrorMsg
+    character, dimension(1), target :: str = '!'
+    ErrorMsg => str
+  end function Error_Msg
+end program ice_test
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_spread_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_spread_1.f90
new file mode 100644
index 000000000..04e4c577a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_spread_1.f90
@@ -0,0 +1,185 @@
+! { dg-do run }
+program foo
+   implicit none
+   integer(kind=1), dimension (10) :: i_1
+   integer(kind=1), dimension (2, 3) :: a_1
+   integer(kind=1), dimension (2, 2, 3) :: b_1
+   integer(kind=2), dimension (10) :: i_2
+   integer(kind=2), dimension (2, 3) :: a_2
+   integer(kind=2), dimension (2, 2, 3) :: b_2
+   integer(kind=4), dimension (10) :: i_4
+   integer(kind=4), dimension (2, 3) :: a_4
+   integer(kind=4), dimension (2, 2, 3) :: b_4
+   integer(kind=8), dimension (10) :: i_8
+   integer(kind=8), dimension (2, 3) :: a_8
+   integer(kind=8), dimension (2, 2, 3) :: b_8
+   real(kind=4), dimension (10) :: r_4
+   real(kind=4), dimension (2, 3) :: ar_4
+   real(kind=4), dimension (2, 2, 3) :: br_4
+   real(kind=8), dimension (10) :: r_8
+   real(kind=8), dimension (2, 3) :: ar_8
+   real(kind=8), dimension (2, 2, 3) :: br_8
+   complex(kind=4), dimension (10) :: c_4
+   complex(kind=4), dimension (2, 3) :: ac_4
+   complex(kind=4), dimension (2, 2, 3) :: bc_4
+   complex(kind=8), dimension (10) :: c_8
+   complex(kind=8), dimension (2, 3) :: ac_8
+   complex(kind=8), dimension (2, 2, 3) :: bc_8
+   type i4_t
+      integer(kind=4) :: v
+   end type i4_t
+   type(i4_t), dimension (10) :: it_4
+   type(i4_t), dimension (2, 3) :: at_4
+   type(i4_t), dimension (2, 2, 3) :: bt_4
+   type(i4_t) :: iv_4
+
+   character (len=200) line1, line2, line3
+
+   a_1 = reshape ((/1_1, 2_1, 3_1, 4_1, 5_1, 6_1/), (/2, 3/))
+   b_1 = spread (a_1, 1, 2)
+   if (any (b_1 .ne. reshape ((/1_1, 1_1, 2_1, 2_1, 3_1, 3_1, 4_1, 4_1, 5_1, 5_1, 6_1, 6_1/), &
+                            (/2, 2, 3/)))) &
+      call abort
+   line1 = ' '
+   write(line1, 9000) b_1
+   line2 = ' '
+   write(line2, 9000) spread (a_1, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9000) spread (a_1, 1, 2) + 0_1
+   if (line1 /= line3) call abort
+   i_1 = spread(1_1,1,10)
+   if (any(i_1 /= 1_1)) call abort
+
+   a_2 = reshape ((/1_2, 2_2, 3_2, 4_2, 5_2, 6_2/), (/2, 3/))
+   b_2 = spread (a_2, 1, 2)
+   if (any (b_2 .ne. reshape ((/1_2, 1_2, 2_2, 2_2, 3_2, 3_2, 4_2, 4_2, 5_2, 5_2, 6_2, 6_2/), &
+                            (/2, 2, 3/)))) &
+      call abort
+   line1 = ' '
+   write(line1, 9000) b_2
+   line2 = ' '
+   write(line2, 9000) spread (a_2, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9000) spread (a_2, 1, 2) + 0_2
+   if (line1 /= line3) call abort
+   i_2 = spread(1_2,1,10)
+   if (any(i_2 /= 1_2)) call abort
+
+   a_4 = reshape ((/1_4, 2_4, 3_4, 4_4, 5_4, 6_4/), (/2, 3/))
+   b_4 = spread (a_4, 1, 2)
+   if (any (b_4 .ne. reshape ((/1_4, 1_4, 2_4, 2_4, 3_4, 3_4, 4_4, 4_4, 5_4, 5_4, 6_4, 6_4/), &
+                            (/2, 2, 3/)))) &
+      call abort
+   line1 = ' '
+   write(line1, 9000) b_4
+   line2 = ' '
+   write(line2, 9000) spread (a_4, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9000) spread (a_4, 1, 2) + 0_4
+   if (line1 /= line3) call abort
+   i_4 = spread(1_4,1,10)
+   if (any(i_4 /= 1_4)) call abort
+
+   a_8 = reshape ((/1_8, 2_8, 3_8, 4_8, 5_8, 6_8/), (/2, 3/))
+   b_8 = spread (a_8, 1, 2)
+   if (any (b_8 .ne. reshape ((/1_8, 1_8, 2_8, 2_8, 3_8, 3_8, 4_8, 4_8, 5_8, 5_8, 6_8, 6_8/), &
+                            (/2, 2, 3/)))) &
+      call abort
+   line1 = ' '
+   write(line1, 9000) b_8
+   line2 = ' '
+   write(line2, 9000) spread (a_8, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9000) spread (a_8, 1, 2) + 0_8
+   if (line1 /= line3) call abort
+   i_8 = spread(1_8,1,10)
+   if (any(i_8 /= 1_8)) call abort
+
+
+   ar_4 = reshape ((/1._4, 2._4, 3._4, 4._4, 5._4, 6._4/), (/2, 3/))
+   br_4 = spread (ar_4, 1, 2)
+   if (any (br_4 .ne. reshape ((/1._4, 1._4, 2._4, 2._4, 3._4, 3._4, &
+   & 4._4, 4._4, 5._4, 5._4, 6._4, 6._4/), (/2, 2, 3/)))) call abort
+   line1 = ' '
+   write(line1, 9010) br_4
+   line2 = ' '
+   write(line2, 9010) spread (ar_4, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9010) spread (ar_4, 1, 2) + 0._4
+   if (line1 /= line3) call abort
+   r_4 = spread(1._4,1,10)
+   if (any(r_4 /= 1._4)) call abort
+
+
+   ar_8 = reshape ((/1._8, 2._8, 3._8, 4._8, 5._8, 6._8/), (/2, 3/))
+   br_8 = spread (ar_8, 1, 2)
+   if (any (br_8 .ne. reshape ((/1._8, 1._8, 2._8, 2._8, 3._8, 3._8, &
+   & 4._8, 4._8, 5._8, 5._8, 6._8, 6._8/), (/2, 2, 3/)))) call abort
+   line1 = ' '
+   write(line1, 9010) br_8
+   line2 = ' '
+   write(line2, 9010) spread (ar_8, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9010) spread (ar_8, 1, 2) + 0._8
+   if (line1 /= line3) call abort
+   r_8 = spread(1._8,1,10)
+   if (any(r_8 /= 1._8)) call abort
+
+   ac_4 = reshape ((/(1._4,-1._4), (2._4,-2._4), (3._4, -3._4), (4._4, -4._4), &
+                   & (5._4,-5._4), (6._4,-6._4)/), (/2, 3/))
+   bc_4 = spread (ac_4, 1, 2)
+   if (any (real(bc_4) .ne. reshape ((/1._4, 1._4, 2._4, 2._4, 3._4, 3._4, &
+   & 4._4, 4._4, 5._4, 5._4, 6._4, 6._4/), (/2, 2, 3/)))) call abort
+   if (any (-aimag(bc_4) .ne. reshape ((/1._4, 1._4, 2._4, 2._4, 3._4, 3._4, &
+   & 4._4, 4._4, 5._4, 5._4, 6._4, 6._4/), (/2, 2, 3/)))) call abort
+   line1 = ' '
+   write(line1, 9020) bc_4
+   line2 = ' '
+   write(line2, 9020) spread (ac_4, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9020) spread (ac_4, 1, 2) + 0._4
+   if (line1 /= line3) call abort
+   c_4 = spread((1._4,-1._4),1,10)
+   if (any(c_4 /= (1._4,-1._4))) call abort
+
+   ac_8 = reshape ((/(1._8,-1._8), (2._8,-2._8), (3._8, -3._8), (4._8, -4._8), &
+                   & (5._8,-5._8), (6._8,-6._8)/), (/2, 3/))
+   bc_8 = spread (ac_8, 1, 2)
+   if (any (real(bc_8) .ne. reshape ((/1._8, 1._8, 2._8, 2._8, 3._8, 3._8, &
+   & 4._8, 4._8, 5._8, 5._8, 6._8, 6._8/), (/2, 2, 3/)))) call abort
+   if (any (-aimag(bc_8) .ne. reshape ((/1._8, 1._8, 2._8, 2._8, 3._8, 3._8, &
+   & 4._8, 4._8, 5._8, 5._8, 6._8, 6._8/), (/2, 2, 3/)))) call abort
+   line1 = ' '
+   write(line1, 9020) bc_8
+   line2 = ' '
+   write(line2, 9020) spread (ac_8, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9020) spread (ac_8, 1, 2) + 0._8
+   if (line1 /= line3) call abort
+   c_8 = spread((1._8,-1._8),1,10)
+   if (any(c_8 /= (1._8,-1._8))) call abort
+
+
+   at_4%v = reshape ((/1_4, 2_4, 3_4, 4_4, 5_4, 6_4/), (/2, 3/))
+   bt_4 = spread (at_4, 1, 2)
+   if (any (bt_4%v .ne. reshape ((/1_4, 1_4, 2_4, 2_4, 3_4, 3_4, 4_4, &
+        & 4_4, 5_4, 5_4, 6_4, 6_4/), (/2, 2, 3/)))) &
+      call abort
+   iv_4%v = 123_4
+   it_4 = spread(iv_4,1,10)
+   if (any(it_4%v /= 123_4)) call abort
+
+
+9000 format(12I3)
+9010 format(12F7.3)
+9020 format(25F7.3)
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_spread_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_spread_2.f90
new file mode 100644
index 000000000..0a91be7b5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_spread_2.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+program foo
+   implicit none
+   integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+
+   real(kind=k), dimension(10) :: r_k
+   real(kind=k), dimension (2, 3) :: ar_k
+   real(kind=k), dimension (2, 2, 3) :: br_k
+   complex(kind=k), dimension(10) :: c_k
+   complex(kind=k), dimension (2, 3) :: ac_k
+   complex(kind=k), dimension (2, 2, 3) :: bc_k
+   character (len=200) line1, line2, line3
+
+   ar_k = reshape ((/1._k, 2._k, 3._k, 4._k, 5._k, 6._k/), (/2, 3/))
+   br_k = spread (ar_k, 1, 2)
+   if (any (br_k .ne. reshape ((/1._k, 1._k, 2._k, 2._k, 3._k, 3._k, &
+   & 4._k, 4._k, 5._k, 5._k, 6._k, 6._k/), (/2, 2, 3/)))) call abort
+   line1 = ' '
+   write(line1, 9010) br_k
+   line2 = ' '
+   write(line2, 9010) spread (ar_k, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9010) spread (ar_k, 1, 2) + 0._k
+   if (line1 /= line3) call abort
+   r_k = spread(1._k,1,10)
+   if (any(r_k /= 1._k)) call abort
+
+   ac_k = reshape ((/(1._k,-1._k), (2._k,-2._k), (3._k, -3._k), (4._k, -4._k), &
+                   & (5._k,-5._k), (6._k,-6._k)/), (/2, 3/))
+   bc_k = spread (ac_k, 1, 2)
+   if (any (real(bc_k) .ne. reshape ((/1._k, 1._k, 2._k, 2._k, 3._k, 3._k, &
+   & 4._k, 4._k, 5._k, 5._k, 6._k, 6._k/), (/2, 2, 3/)))) call abort
+   if (any (-aimag(bc_k) .ne. reshape ((/1._k, 1._k, 2._k, 2._k, 3._k, 3._k, &
+   & 4._k, 4._k, 5._k, 5._k, 6._k, 6._k/), (/2, 2, 3/)))) call abort
+   line1 = ' '
+   write(line1, 9020) bc_k
+   line2 = ' '
+   write(line2, 9020) spread (ac_k, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9020) spread (ac_k, 1, 2) + 0._k
+   if (line1 /= line3) call abort
+   c_k = spread((1._k,-1._k),1,10)
+   if (any(c_k /= (1._k,-1._k))) call abort
+
+9010 format(12F7.3)
+9020 format(25F7.3)
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_spread_3.f90 b/gcc/testsuite/gfortran.dg/intrinsic_spread_3.f90
new file mode 100644
index 000000000..1dd2feb1d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_spread_3.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_int }
+
+program foo
+   implicit none
+   integer,parameter :: k = selected_int_kind (range (0_8) + 1)
+
+   integer(kind=k), dimension(10) :: i_k
+   integer(kind=k), dimension (2, 3) :: a_k
+   integer(kind=k), dimension (2, 2, 3) :: b_k
+   character (len=200) line1, line2, line3
+
+   a_k = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k/), (/2, 3/))
+   b_k = spread (a_k, 1, 2)
+   if (any (b_k .ne. reshape ((/1_k, 1_k, 2_k, 2_k, 3_k, 3_k, 4_k, 4_k, 5_k, 5_k, 6_k, 6_k/), &
+                            (/2, 2, 3/)))) &
+      call abort
+   line1 = ' '
+   write(line1, 9000) b_k
+   line2 = ' '
+   write(line2, 9000) spread (a_k, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9000) spread (a_k, 1, 2) + 0_k
+   if (line1 /= line3) call abort
+   i_k = spread(1_k,1,10)
+   if (any(i_k /= 1_k)) call abort
+
+9000 format(12I3)
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_std_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_std_1.f90
new file mode 100644
index 000000000..ac8649bbc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_std_1.f90
@@ -0,0 +1,47 @@
+! { dg-do compile }
+! { dg-options "-std=f95 -Wintrinsics-std" }
+
+!
+! See intrinsic_std_6.f90 for the dump check.
+!
+
+! PR fortran/33141
+! Check for the expected behaviour when an intrinsic function/subroutine is
+! called that is not available in the defined standard or that is a GNU
+! extension:
+! There should be a warning emitted on the call, and the reference should be
+! treated like an external call.
+! For declaring a non-standard intrinsic INTRINSIC, a hard error should be
+! generated, of course.
+
+SUBROUTINE no_implicit
+  IMPLICIT NONE
+  REAL :: asinh ! { dg-warning "Fortran 2008" }
+
+  ! abort is a GNU extension
+  CALL abort () ! { dg-warning "extension" }
+
+  ! ASINH is an intrinsic of F2008
+  ! The warning should be issued in the declaration above where it is declared
+  ! EXTERNAL.
+  WRITE (*,*) ASINH (1.) ! { dg-warning "Fortran 2008" }
+END SUBROUTINE no_implicit
+
+SUBROUTINE implicit_type
+  ! acosh has implicit type
+
+  WRITE (*,*) ACOSH (1.) ! { dg-warning "Fortran 2008" }
+  WRITE (*,*) ACOSH (1.) ! { dg-bogus "Fortran 2008" }
+END SUBROUTINE implicit_type
+
+SUBROUTINE specification_expression
+  CHARACTER(KIND=selected_char_kind("ascii")) :: x
+! { dg-error "must be an intrinsic function" "" { target "*-*-*" } 38 }
+! { dg-warning "Fortran 2003" "" { target "*-*-*" } 38 }
+END SUBROUTINE specification_expression
+
+SUBROUTINE intrinsic_decl
+  IMPLICIT NONE
+  INTRINSIC :: atanh ! { dg-error "Fortran 2008" }
+  INTRINSIC :: abort ! { dg-error "extension" }
+END SUBROUTINE intrinsic_decl
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_std_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_std_2.f90
new file mode 100644
index 000000000..6112d906d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_std_2.f90
@@ -0,0 +1,15 @@
+! { dg-do link }
+! { dg-options "-std=f95 -Wintrinsics-std -fall-intrinsics" }
+
+! PR fortran/33141
+! Check that -fall-intrinsics makes all intrinsics available.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  ! abort is a GNU extension
+  CALL abort () ! { dg-bogus "extension" }
+
+  ! ASINH is an intrinsic of F2008
+  WRITE (*,*) ASINH (1.) ! { dg-bogus "Fortran 2008" }
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_std_3.f90 b/gcc/testsuite/gfortran.dg/intrinsic_std_3.f90
new file mode 100644
index 000000000..15a424b1c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_std_3.f90
@@ -0,0 +1,15 @@
+! { dg-do link }
+! { dg-options "-std=gnu -Wintrinsics-std" }
+
+! PR fortran/33141
+! -std=gnu should allow every intrinsic.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  ! abort is a GNU extension
+  CALL abort () ! { dg-bogus "extension" }
+
+  ! ASINH is an intrinsic of F2008
+  WRITE (*,*) ASINH (1.) ! { dg-bogus "Fortran 2008" }
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_std_4.f90 b/gcc/testsuite/gfortran.dg/intrinsic_std_4.f90
new file mode 100644
index 000000000..e83ed4c88
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_std_4.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+! { dg-options "-std=f95 -Wno-intrinsics-std" }
+
+! PR fortran/33141
+! Check that calls to intrinsics not in the current standard are "allowed" and
+! linked to external procedures with that name.
+! Addionally, this checks that -Wno-intrinsics-std turns off the warning.
+
+SUBROUTINE abort ()
+  IMPLICIT NONE
+  WRITE (*,*) "Correct"
+END SUBROUTINE abort
+
+REAL FUNCTION asinh (arg)
+  IMPLICIT NONE
+  REAL :: arg
+
+  WRITE (*,*) "Correct"
+  asinh = arg
+END FUNCTION asinh
+
+SUBROUTINE implicit_none
+  IMPLICIT NONE
+  REAL :: asinh ! { dg-bogus "Fortran 2008" }
+  REAL :: x
+
+  ! Both times our version above should be called
+  CALL abort () ! { dg-bogus "extension" }
+  x = ASINH (1.) ! { dg-bogus "Fortran 2008" }
+END SUBROUTINE implicit_none
+
+SUBROUTINE implicit_type
+  ! ASINH has implicit type here
+  REAL :: x
+
+  ! Our version should be called
+  x = ASINH (1.) ! { dg-bogus "Fortran 2008" }
+END SUBROUTINE implicit_type
+
+PROGRAM main
+  ! This should give a total of three "Correct"s
+  CALL implicit_none ()
+  CALL implicit_type ()
+END PROGRAM main
+
+! { dg-output "Correct\.*Correct\.*Correct" }
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_std_5.f03 b/gcc/testsuite/gfortran.dg/intrinsic_std_5.f03
new file mode 100644
index 000000000..f5c0f2d9d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_std_5.f03
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/40728
+!
+
+! bogus error
+SUBROUTINE s1
+  IMPLICIT NONE
+  real(4), volatile :: r4
+
+  r4 = 0.0_4
+  r4 = asinh(r4)         ! { dg-error "has no IMPLICIT type" }
+END SUBROUTINE
+
+
+
+! ICE on invalid (ATANH is defined by F2008 only)
+SUBROUTINE s2
+  IMPLICIT NONE
+  real :: r
+  r = 0.4
+  print *, atanh(r)      ! { dg-error "has no IMPLICIT type" }
+END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_std_6.f90 b/gcc/testsuite/gfortran.dg/intrinsic_std_6.f90
new file mode 100644
index 000000000..6b2eee459
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_std_6.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+! { dg-options "-std=f95 -Wintrinsics-std -fdump-tree-original" }
+
+!
+! See intrinsic_std_1.f90 for more compile-time checks
+!
+
+! PR fortran/33141
+! Check for the expected behaviour when an intrinsic function/subroutine is
+! called that is not available in the defined standard or that is a GNU
+! extension:
+! There should be a warning emitted on the call, and the reference should be
+! treated like an external call.
+! For declaring a non-standard intrinsic INTRINSIC, a hard error should be
+! generated, of course.
+
+SUBROUTINE no_implicit
+  IMPLICIT NONE
+  REAL :: asinh ! { dg-warning "Fortran 2008" }
+
+  ! abort is a GNU extension
+  CALL abort () ! { dg-warning "extension" }
+
+  ! ASINH is an intrinsic of F2008
+  ! The warning should be issued in the declaration above where it is declared
+  ! EXTERNAL.
+  WRITE (*,*) ASINH (1.) ! { dg-warning "Fortran 2008" }
+END SUBROUTINE no_implicit
+
+SUBROUTINE implicit_type
+  ! acosh has implicit type
+
+  WRITE (*,*) ACOSH (1.) ! { dg-warning "Fortran 2008" }
+  WRITE (*,*) ACOSH (1.) ! { dg-bogus "Fortran 2008" }
+END SUBROUTINE implicit_type
+
+! Scan that really external functions are called.
+! { dg-final { scan-tree-dump " abort " "original" } }
+! { dg-final { scan-tree-dump " asinh " "original" } }
+! { dg-final { scan-tree-dump " acosh " "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_subroutine.f90 b/gcc/testsuite/gfortran.dg/intrinsic_subroutine.f90
new file mode 100644
index 000000000..d3f84cdf1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_subroutine.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! PR 33229
+implicit none
+intrinsic cpu_time  ! { dg-error "attribute conflicts with" }
+real :: time
+print *, CPU_TIME(TIME)  ! { dg-error "is not a function" }
+end
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_unpack_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_unpack_1.f90
new file mode 100644
index 000000000..47b9aef2e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_unpack_1.f90
@@ -0,0 +1,135 @@
+! { dg-do run }
+! Program to test the UNPACK intrinsic for the types usually present.
+program intrinsic_unpack
+   implicit none
+   integer(kind=1), dimension(3, 3) :: a1, b1
+   integer(kind=2), dimension(3, 3) :: a2, b2
+   integer(kind=4), dimension(3, 3) :: a4, b4
+   integer(kind=8), dimension(3, 3) :: a8, b8
+   real(kind=4), dimension(3,3) :: ar4, br4
+   real(kind=8), dimension(3,3) :: ar8, br8
+   complex(kind=4), dimension(3,3) :: ac4, bc4
+   complex(kind=8), dimension(3,3) :: ac8, bc8
+   type i4_t
+      integer(kind=4) :: v
+   end type i4_t
+   type(i4_t), dimension(3,3) :: at4, bt4
+   type(i4_t), dimension(3) :: vt4
+
+   logical, dimension(3, 3) :: mask
+   character(len=500) line1, line2
+   integer i
+
+   mask = reshape ((/.false.,.true.,.false.,.true.,.false.,.false.,&
+                    &.false.,.false.,.true./), (/3, 3/));
+   a1 = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/));
+   b1 = unpack ((/2_1, 3_1, 4_1/), mask, a1)
+   if (any (b1 .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+   write (line1,'(10I4)') b1
+   write (line2,'(10I4)') unpack((/2_1, 3_1, 4_1/), mask, a1)
+   if (line1 .ne. line2) call abort
+   b1 = -1
+   b1 = unpack ((/2_1, 3_1, 4_1/), mask, 0_1)
+   if (any (b1 .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+
+   a2 = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/));
+   b2 = unpack ((/2_2, 3_2, 4_2/), mask, a2)
+   if (any (b2 .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+   write (line1,'(10I4)') b2
+   write (line2,'(10I4)') unpack((/2_2, 3_2, 4_2/), mask, a2)
+   if (line1 .ne. line2) call abort
+   b2 = -1
+   b2 = unpack ((/2_2, 3_2, 4_2/), mask, 0_2)
+   if (any (b2 .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+
+   a4 = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/));
+   b4 = unpack ((/2_4, 3_4, 4_4/), mask, a4)
+   if (any (b4 .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+   write (line1,'(10I4)') b4
+   write (line2,'(10I4)') unpack((/2_4, 3_4, 4_4/), mask, a4)
+   if (line1 .ne. line2) call abort
+   b4 = -1
+   b4 = unpack ((/2_4, 3_4, 4_4/), mask, 0_4)
+   if (any (b4 .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+
+   a8 = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/));
+   b8 = unpack ((/2_8, 3_8, 4_8/), mask, a8)
+   if (any (b8 .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+   write (line1,'(10I4)') b8
+   write (line2,'(10I4)') unpack((/2_8, 3_8, 4_8/), mask, a8)
+   if (line1 .ne. line2) call abort
+   b8 = -1
+   b8 = unpack ((/2_8, 3_8, 4_8/), mask, 0_8)
+   if (any (b8 .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+
+   ar4 = reshape ((/1._4, 0._4, 0._4, 0._4, 1._4, 0._4, 0._4, 0._4, 1._4/), &
+         (/3, 3/));
+   br4 = unpack ((/2._4, 3._4, 4._4/), mask, ar4)
+   if (any (br4 .ne. reshape ((/1._4, 2._4, 0._4, 3._4, 1._4, 0._4, &
+                               0._4, 0._4, 4._4/), (/3, 3/)))) &
+      call abort
+   write (line1,'(9F9.5)') br4
+   write (line2,'(9F9.5)') unpack((/2._4, 3._4, 4._4/), mask, ar4)
+   if (line1 .ne. line2) call abort
+   br4 = -1._4
+   br4 = unpack ((/2._4, 3._4, 4._4/), mask, 0._4)
+   if (any (br4 .ne. reshape ((/0._4, 2._4, 0._4, 3._4, 0._4, 0._4, &
+      0._4, 0._4, 4._4/), (/3, 3/)))) &
+      call abort
+
+   ar8 = reshape ((/1._8, 0._8, 0._8, 0._8, 1._8, 0._8, 0._8, 0._8, 1._8/), &
+         (/3, 3/));
+   br8 = unpack ((/2._8, 3._8, 4._8/), mask, ar8)
+   if (any (br8 .ne. reshape ((/1._8, 2._8, 0._8, 3._8, 1._8, 0._8, &
+                               0._8, 0._8, 4._8/), (/3, 3/)))) &
+      call abort
+   write (line1,'(9F9.5)') br8
+   write (line2,'(9F9.5)') unpack((/2._8, 3._8, 4._8/), mask, ar8)
+   if (line1 .ne. line2) call abort
+   br8 = -1._8
+   br8 = unpack ((/2._8, 3._8, 4._8/), mask, 0._8)
+   if (any (br8 .ne. reshape ((/0._8, 2._8, 0._8, 3._8, 0._8, 0._8, &
+      0._8, 0._8, 4._8/), (/3, 3/)))) &
+      call abort
+
+   ac4 = reshape ((/1._4, 0._4, 0._4, 0._4, 1._4, 0._4, 0._4, 0._4, 1._4/), &
+        (/3, 3/));
+   bc4 = unpack ((/(2._4, 0._4), (3._4, 0._4), (4._4,   0._4)/), mask, ac4)
+   if (any (real(bc4) .ne. reshape ((/1._4, 2._4, 0._4, 3._4, 1._4, 0._4, &
+        0._4, 0._4, 4._4/), (/3, 3/)))) &
+        call abort
+   write (line1,'(18F9.5)') bc4
+   write (line2,'(18F9.5)') unpack((/(2._4, 0._4), (3._4, 0._4), (4._4,0._4)/), &
+        mask, ac4)
+   if (line1 .ne. line2) call abort
+
+   ac8 = reshape ((/1._8, 0._8, 0._8, 0._8, 1._8, 0._8, 0._8, 0._8, 1._8/), &
+        (/3, 3/));
+   bc8 = unpack ((/(2._8, 0._8), (3._8, 0._8), (4._8,   0._8)/), mask, ac8)
+   if (any (real(bc8) .ne. reshape ((/1._8, 2._8, 0._8, 3._8, 1._8, 0._8, &
+        0._8, 0._8, 4._8/), (/3, 3/)))) &
+        call abort
+   write (line1,'(18F9.5)') bc8
+   write (line2,'(18F9.5)') unpack((/(2._8, 0._8), (3._8, 0._8), (4._8,0._8)/), &
+        mask, ac8)
+   if (line1 .ne. line2) call abort
+
+   at4%v = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/));
+   vt4%v = (/2_4, 3_4, 4_4/)
+   bt4 = unpack (vt4, mask, at4)
+   if (any (bt4%v .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+   bt4%v = -1
+   bt4 = unpack (vt4, mask, i4_t(0_4))
+   if (any (bt4%v .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) &
+        call abort
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_unpack_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_unpack_2.f90
new file mode 100644
index 000000000..d993f2340
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_unpack_2.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+! Program to test the UNPACK intrinsic for large real type
+program intrinsic_unpack
+   implicit none
+   integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+
+   real(kind=k), dimension(3,3) :: ark, brk
+   complex(kind=k), dimension(3,3) :: ack, bck
+
+   logical, dimension(3, 3) :: mask
+   character(len=500) line1, line2
+   integer i
+
+   mask = reshape ((/.false.,.true.,.false.,.true.,.false.,.false.,&
+                    &.false.,.false.,.true./), (/3, 3/));
+
+   ark = reshape ((/1._k, 0._k, 0._k, 0._k, 1._k, 0._k, 0._k, 0._k, 1._k/), &
+         (/3, 3/));
+   brk = unpack ((/2._k, 3._k, 4._k/), mask, ark)
+   if (any (brk .ne. reshape ((/1._k, 2._k, 0._k, 3._k, 1._k, 0._k, &
+                               0._k, 0._k, 4._k/), (/3, 3/)))) &
+      call abort
+   write (line1,'(9F9.5)') brk
+   write (line2,'(9F9.5)') unpack((/2._k, 3._k, 4._k/), mask, ark)
+   if (line1 .ne. line2) call abort
+   brk = -1._k
+   brk = unpack ((/2._k, 3._k, 4._k/), mask, 0._k)
+   if (any (brk .ne. reshape ((/0._k, 2._k, 0._k, 3._k, 0._k, 0._k, &
+      0._k, 0._k, 4._k/), (/3, 3/)))) &
+      call abort
+
+   ack = reshape ((/1._k, 0._k, 0._k, 0._k, 1._k, 0._k, 0._k, 0._k, 1._k/), &
+        (/3, 3/));
+   bck = unpack ((/(2._k, 0._k), (3._k, 0._k), (4._k,   0._k)/), mask, ack)
+   if (any (real(bck) .ne. reshape ((/1._k, 2._k, 0._k, 3._k, 1._k, 0._k, &
+        0._k, 0._k, 4._k/), (/3, 3/)))) &
+        call abort
+   write (line1,'(18F9.5)') bck
+   write (line2,'(18F9.5)') unpack((/(2._k, 0._k), (3._k, 0._k), (4._k,0._k)/), &
+        mask, ack)
+   if (line1 .ne. line2) call abort
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_unpack_3.f90 b/gcc/testsuite/gfortran.dg/intrinsic_unpack_3.f90
new file mode 100644
index 000000000..4a4443fac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_unpack_3.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_int }
+! Program to test the UNPACK intrinsic for a long integer type
+program intrinsic_unpack
+   implicit none
+   integer,parameter :: k = selected_int_kind (range (0_8) + 1)
+   integer(kind=k), dimension(3, 3) :: ak, bk
+   logical, dimension(3, 3) :: mask
+   character(len=100) line1, line2
+   integer i
+
+   mask = reshape ((/.false.,.true.,.false.,.true.,.false.,.false.,&
+                    &.false.,.false.,.true./), (/3, 3/));
+
+   ak = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/));
+   bk = unpack ((/2_k, 3_k, 4_k/), mask, ak)
+   if (any (bk .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+   write (line1,'(10I4)') bk
+   write (line2,'(10I4)') unpack((/2_k, 3_k, 4_k/), mask, ak)
+   if (line1 .ne. line2) call abort
+   bk = -1
+   bk = unpack ((/2_k, 3_k, 4_k/), mask, 0_k)
+   if (any (bk .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_verify_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_verify_1.f90
new file mode 100644
index 000000000..c894043de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_verify_1.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! Test the verify intrinsic.  We were ignoring the last character.
+program prog
+  character(len=1) :: c1
+  character(len=4) :: c4
+  c1 = "E"
+  if (verify(c1, "1") .ne. 1) call abort
+  c4 = "ABBA"
+  if (verify(c4, "A") .ne. 2) call abort
+  if (verify(c4, "A", back = .true.) .ne. 3) call abort
+  if (verify(c4, "AB") .ne. 0) call abort
+end program
diff --git a/gcc/testsuite/gfortran.dg/intrinsics_kind_argument_1.f90 b/gcc/testsuite/gfortran.dg/intrinsics_kind_argument_1.f90
new file mode 100644
index 000000000..0a3ca0791
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsics_kind_argument_1.f90
@@ -0,0 +1,56 @@
+! Test various intrinsics who take a kind argument since Fortran 2003
+!
+! { dg-do compile }
+!
+program test
+  integer, parameter :: k = kind(0)
+  logical :: l_array(4,5)
+  character(len=1) :: s
+  character(len=20) :: t
+
+  l_array = .true.
+  s = "u"
+  t = "bartutugee"
+
+  call check (count(l_array, kind=k), 20)
+  if (any (count(l_array, 2, kind=k) /= 5)) call abort
+  if (any (count(l_array, kind=k, dim=2) /= 5)) call abort
+
+  call check (iachar (s, k), 117)
+  call check (iachar (s, kind=k), 117)
+  call check (ichar (s, k), 117)
+  call check (ichar (s, kind=k), 117)
+
+  if (achar(107) /= achar(107,1)) call abort
+
+  call check (index (t, s, .true., k), 7)
+  call check (index (t, s, kind=k, back=.false.), 5)
+
+  if (any (lbound (l_array, kind=k) /= 1)) call abort
+  call check (lbound (l_array, 1), 1)
+  call check (lbound (l_array, 1, kind=k), 1)
+
+  if (any (ubound (l_array, kind=k) /= (/4, 5/))) call abort
+  call check (ubound (l_array, 1), 4)
+  call check (ubound (l_array, 1, kind=k), 4)
+
+  call check (len(t, k), 20)
+  call check (len_trim(t, k), 10)
+
+  call check (scan (t, s, .true., k), 7)
+  call check (scan (t, s, kind=k, back=.false.), 5)
+
+  call check (size (l_array, 1, kind=k), 4)
+  call check (size (l_array, kind=k), 20)
+
+  call check (verify (t, s, .true., k), 20)
+  call check (verify (t, s, kind=k, back=.false.), 1)
+
+contains
+
+  subroutine check(x,y)
+    integer, intent(in) :: x, y
+    if (x /= y) call abort
+  end subroutine check
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/invalid_contains_1.f90 b/gcc/testsuite/gfortran.dg/invalid_contains_1.f90
new file mode 100644
index 000000000..df4bb3fef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/invalid_contains_1.f90
@@ -0,0 +1,8 @@
+! { dg-do compile } 
+! PR18923 segfault after subroutine name confusion.
+module FOO
+contains
+  subroutine FOO ! { dg-error "conflicts with PROCEDURE" }
+    character(len=selected_int_kind(0)) :: C ! { dg-error "data declaration statement" }
+  end subroutine ! { dg-error "Expecting END MODULE statement" }
+end
diff --git a/gcc/testsuite/gfortran.dg/invalid_contains_2.f90 b/gcc/testsuite/gfortran.dg/invalid_contains_2.f90
new file mode 100644
index 000000000..72c1e216f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/invalid_contains_2.f90
@@ -0,0 +1,9 @@
+! { dg-do compile } 
+! PR18923 segfault after subroutine name confusion.
+program foo
+contains
+  subroutine foo(i) ! { dg-error "conflicts with PROCEDURE" }
+    integer :: i ! { dg-error "data declaration statement" }
+    character(len=selected_int_kind(i)) :: c ! { dg-error "data declaration statement" }
+  end subroutine ! { dg-error "Expecting END PROGRAM statement" }
+end program foo
diff --git a/gcc/testsuite/gfortran.dg/invalid_interface_assignment.f90 b/gcc/testsuite/gfortran.dg/invalid_interface_assignment.f90
new file mode 100644
index 000000000..f3c6e1269
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/invalid_interface_assignment.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! Tests the fix for PR25102, which did not diagnose the aberrant interface
+! assignement below.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+MODULE TT
+ TYPE data_type
+   INTEGER :: I
+ END TYPE data_type
+ INTERFACE ASSIGNMENT (=)
+   MODULE PROCEDURE set
+ END INTERFACE
+CONTAINS
+  PURE SUBROUTINE set(x1,*) ! { dg-error "Alternate return cannot appear" }
+    TYPE(data_type), INTENT(OUT) :: x1
+    x1%i=0
+  END SUBROUTINE set
+END MODULE
diff --git a/gcc/testsuite/gfortran.dg/invalid_name.f90 b/gcc/testsuite/gfortran.dg/invalid_name.f90
new file mode 100644
index 000000000..895664f84
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/invalid_name.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! Tests the fix for PR27698, where names not starting with a letter were
+! rejected but not diagnosed with a proper message.
+SUBROUTINE _foo ! { dg-error "Invalid character in name" }
+END
+
diff --git a/gcc/testsuite/gfortran.dg/invalid_procedure_name.f90 b/gcc/testsuite/gfortran.dg/invalid_procedure_name.f90
new file mode 100644
index 000000000..dd319382b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/invalid_procedure_name.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! PR25061 procedure name conflict
+! Test case from PR.
+INTERFACE I1 ! { dg-error "" }
+ SUBROUTINE S1(I)
+ END SUBROUTINE S1
+ SUBROUTINE S2(R)
+ END SUBROUTINE S2
+END INTERFACE I1
+CONTAINS
+ SUBROUTINE I1(I) ! { dg-error "already defined as a generic" }
+ END SUBROUTINE I1
+END
+
diff --git a/gcc/testsuite/gfortran.dg/io_constraints_1.f90 b/gcc/testsuite/gfortran.dg/io_constraints_1.f90
new file mode 100644
index 000000000..eb8ab8d53
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_constraints_1.f90
@@ -0,0 +1,80 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! Part I of the test  of the IO constraints patch, which fixes PRs:
+! PRs 25053, 25063, 25064, 25066, 25067, 25068, 25069, 25307 and 20862.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module fails
+
+ 2000 format (1h , 2i6)                        ! { dg-error "Format statement in module" }
+
+end module fails
+
+module global
+
+  integer :: modvar
+  namelist /NL/ modvar
+
+contains
+
+  subroutine foo (i)
+    integer :: i
+    write (*, 100) i
+ 100 format (1h , "i=", i6)                     ! { dg-warning "The H format specifier at ... is a Fortran 95 deleted feature" }
+  end subroutine foo
+
+end module global
+
+ use global
+ integer :: a,b, c(20)
+ integer(8) :: ierr
+ character(80) :: buffer(3)
+
+! Appending to a USE associated namelist is an extension.
+
+ NAMELIST /NL/ a,b                              ! { dg-error "already is USE associated" }
+
+ a=1 ; b=2
+
+!9.2.2.1:
+ write(c, *) a, b                               !  { dg-error "array" }
+!Was correctly picked up before patch.
+ write(buffer((/3,1,2/)), *) a, b               !  { dg-error "vector subscript" }
+
+!9.2.2.2 and one of 9.4.1
+!________________________
+
+ write(6, NML=NL, FMT = '(i6)')                 !  { dg-error "group name and format" }
+ write(6, NML=NL, FMT = 200)                    !  { dg-error "group name and format" }
+
+!9.4.1
+!_____
+!
+
+! R912
+!Was correctly picked up before patch.
+ write(6, NML=NL, iostat = ierr)                ! { dg-error "requires default INTEGER" }
+
+! Constraints
+!Was correctly picked up before patch.
+ write(1, fmt='(i6)', end = 100) a              ! { dg-error "END tag" }
+!Was correctly picked up before patch.
+ write(1, fmt='(i6)', eor = 100) a              ! { dg-error "EOR tag" }
+!Was correctly picked up before patch.
+ write(1, fmt='(i6)', size = b) a               ! { dg-error "SIZE= specifier not allowed" }
+
+
+ READ(1, fmt='(i6)', end = 900) a               ! { dg-error "not defined" }
+ READ(1, fmt='(i6)', eor = 900, advance='NO') a ! { dg-error "not defined" }
+ READ(1, fmt='(i6)', ERR = 900) a               ! { dg-error "not defined" }
+
+!Was correctly picked up before patch.
+ READ(1, fmt=800) a                             ! { dg-error "not defined" }
+
+
+100 continue
+200 format (2i6)
+ END
+
+! { dg-final { cleanup-modules "fails global" } }
diff --git a/gcc/testsuite/gfortran.dg/io_constraints_10.f90 b/gcc/testsuite/gfortran.dg/io_constraints_10.f90
new file mode 100644
index 000000000..bb756aa2b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_constraints_10.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/52335
+!
+
+integer :: lun
+character(len=20) :: str
+
+! VALID Fortran 95:
+open(unit=lun,file=str,delim='apostrophe',status='old')
+inquire(lun, delim=str)
+
+! Fortran 2003:
+write(*,*, delim='apostrophe') 'a' ! { dg-error "Fortran 2003: DELIM= at .1. not allowed in Fortran 95" }
+end
diff --git a/gcc/testsuite/gfortran.dg/io_constraints_2.f90 b/gcc/testsuite/gfortran.dg/io_constraints_2.f90
new file mode 100644
index 000000000..42aba66a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_constraints_2.f90
@@ -0,0 +1,77 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! Part II of the test  of the IO constraints patch, which fixes PRs:
+! PRs 25053, 25063, 25064, 25066, 25067, 25068, 25069, 25307 and 20862.
+! Modified2006-07-08 to check the patch for PR20844.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+
+module global
+
+  integer :: modvar
+  namelist /NL/ modvar
+
+contains
+
+  subroutine foo (i)
+    integer :: i
+    write (*, 100) i
+ 100 format (1h , "i=", i6) ! { dg-warning "H format specifier" }
+  end subroutine foo
+
+end module global
+
+ use global
+ integer :: a,b, c(20)
+ integer(8) :: ierr
+ character(80) :: buffer(3)
+
+
+! Appending to a USE associated namelist is an extension.
+
+ NAMELIST /NL/ a,b                              ! { dg-error "already is USE associated" }
+
+ a=1 ; b=2
+
+ write(*, NML=NL) z                             !  { dg-error "followed by IO-list" }
+!Was correctly picked up before patch.
+ print NL, z                                    !  { dg-error "PRINT namelist at \\(1\\) is an extension" }
+!
+! Not allowed with internal unit
+!Was correctly picked up before patch.
+ write(buffer, NML=NL)                          !  { dg-error "Internal file at \\(1\\) with namelist" }
+!Was correctly picked up before patch.
+ write(buffer, fmt='(i6)', REC=10) a            !  { dg-error "REC tag" }
+ write(buffer, fmt='(i6)', END=10) a            !  { dg-error "END tag" }
+
+! Not allowed with REC= specifier
+!Was correctly picked up before patch.
+ read(10, REC=10, END=100)                      !  { dg-error "END tag is not allowed" }
+ write(*, *, REC=10)                            !  { dg-error "FMT=" }
+
+! Not allowed with an ADVANCE=specifier
+ READ(buffer, fmt='(i6)', advance='YES') a      ! { dg-error "internal file" }
+ READ(1, NML=NL, advance='YES')                 ! { dg-error "NAMELIST IO is not allowed" }
+ 
+ READ(1, fmt='(i6)', advance='NO', size = ierr) ! { dg-error "requires default INTEGER" }
+
+ READ(1, advance='YES')                         ! { dg-error "must appear with an explicit format" }
+
+ write(1, fmt='(i6)', advance='YES', size = c(1)) a ! { dg-error "output" }
+ write(1, fmt='(i6)', advance='YES', eor = 100) a   ! { dg-error "output" }
+
+ read(1, fmt='(i6)', advance='YES', size = c(1)) a  ! { dg-error "ADVANCE = 'NO'" }
+ read(1, fmt='(i6)', advance='YES', eor = 100) a    ! { dg-error "ADVANCE = 'NO'" }
+
+ READ(1, fmt='(i6)', advance='NO', size = buffer) a ! { dg-error "INTEGER" }
+!Was correctly picked up before patch. -correct syntax error
+ READ(1, fmt='(i6)', advance='YES', size = 10) a    ! { dg-error "Invalid value for SIZE specification" }
+
+ READ(1, fmt='(i6)', advance='MAYBE')               !  { dg-error "YES or NO" }
+
+100 continue
+200 format (2i6)
+ END
+
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/io_constraints_3.f90 b/gcc/testsuite/gfortran.dg/io_constraints_3.f90
new file mode 100644
index 000000000..7622a2486
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_constraints_3.f90
@@ -0,0 +1,191 @@
+! Test some restrictions on the specifiers of OPEN and CLOSE statements.
+! Contributed by Francois-Xavier Coudert (coudert@clipper.ens.fr)
+!
+! { dg-do compile }
+! { dg-options "-ffree-line-length-none -pedantic -fmax-errors=50" }
+  integer,parameter :: mone = -1, zero = 0
+  character(len=*),parameter :: foo = "foo"
+  character(len=20) :: str
+  integer :: u
+
+! Test for warnings, when IOSTAT is used
+
+  open(10, iostat=u,access="sequential   ")
+  open(10, iostat=u,access="sequential   u") ! { dg-warning "ACCESS specifier in OPEN statement" }
+  open(10, iostat=u,access=foo) ! { dg-warning "ACCESS specifier in OPEN statement" }
+  open(10, iostat=u,access="direct")
+  open(10, iostat=u,access="stream")
+  open(10, iostat=u,access="append") ! { dg-warning "Extension: ACCESS specifier in OPEN statement" }
+
+  open(10, iostat=u,action="read")
+  open(10, iostat=u,action="write")
+  open(10, iostat=u,action="readwrite")
+  open(10, iostat=u,action=foo) ! { dg-warning "ACTION specifier in OPEN statement" }
+
+  open(10, iostat=u,blank="ZERO")
+  open(10, iostat=u,blank="nUlL")
+  open(10, iostat=u,blank="NULLL") ! { dg-warning "BLANK specifier in OPEN statement" }
+
+  open(10, iostat=u,delim="apostrophe")
+  open(10, iostat=u,delim="quote")
+  open(10, iostat=u,delim="none")
+  open(10, iostat=u,delim="") ! { dg-warning "DELIM specifier in OPEN statement" }
+
+  open(10, iostat=u,form="formatted")
+  open(10, iostat=u,form="unformatted")
+  open(10, iostat=u,form="default") ! { dg-warning "FORM specifier in OPEN statement" }
+
+  open(10, iostat=u,pad="yes")
+  open(10, iostat=u,pad="no")
+  open(10, iostat=u,pad=foo) ! { dg-warning "PAD specifier in OPEN statement" }
+
+  open(10, iostat=u,position="asis")
+  open(10, iostat=u,position="rewind")
+  open(10, iostat=u,position="append")
+  open(10, iostat=u,position=foo) ! { dg-warning "POSITION specifier in OPEN statement" }
+
+  open(10, iostat=u,recl="ee") ! { dg-error "must be of type INTEGER" }
+  open(10, iostat=u,recl=0.4) ! { dg-error "must be of type INTEGER" }
+  open(10, iostat=u,recl=zero) ! { dg-warning "must be positive" }
+  open(10, iostat=u,recl=mone) ! { dg-warning "must be positive" }
+
+  open(10, iostat=u,status="unknown")
+  open(10, iostat=u,status="old")
+  open(10, iostat=u,status=foo) ! { dg-warning "STATUS specifier in OPEN statement" }
+  
+  open(10, iostat=u,status="new") ! { dg-warning "no FILE specifier is present" }
+  open(10, iostat=u,status="replace   ") ! { dg-warning "no FILE specifier is present" }
+  open(10, iostat=u,status="scratch",file=str) ! { dg-warning "cannot have the value SCRATCH if a FILE specifier is present" }
+
+  open(10, iostat=u,form="unformatted",delim="none") ! { dg-warning "not allowed in OPEN statement for unformatted I/O" }
+  open(10, iostat=u,form="unformatted",pad="yes") ! { dg-warning "not allowed in OPEN statement for unformatted I/O" }
+  open(10, iostat=u,form="unformatted",blank="null") ! { dg-warning "not allowed in OPEN statement for unformatted I/O" }
+
+  open(10, iostat=u,access="direct",position="append") ! { dg-warning "only allowed for stream or sequential ACCESS" }
+
+  close(10, iostat=u,status="keep")
+  close(10, iostat=u,status="delete")
+  close(10, iostat=u,status=foo) ! { dg-warning "STATUS specifier in CLOSE statement" }
+
+
+
+! Test for warnings, when an ERR label is specified
+
+  open(10, err=99,access="sequential   ")
+  open(10, err=99,access="sequential   u") ! { dg-warning "ACCESS specifier in OPEN statement" }
+  open(10, err=99,access=foo) ! { dg-warning "ACCESS specifier in OPEN statement" }
+  open(10, err=99,access="direct")
+  open(10, err=99,access="stream")
+  open(10, err=99,access="append") ! { dg-warning "Extension: ACCESS specifier in OPEN statement" }
+
+  open(10, err=99,action="read")
+  open(10, err=99,action="write")
+  open(10, err=99,action="readwrite")
+  open(10, err=99,action=foo) ! { dg-warning "ACTION specifier in OPEN statement" }
+
+  open(10, err=99,blank="ZERO")
+  open(10, err=99,blank="nUlL")
+  open(10, err=99,blank="NULLL") ! { dg-warning "BLANK specifier in OPEN statement" }
+
+  open(10, err=99,delim="apostrophe")
+  open(10, err=99,delim="quote")
+  open(10, err=99,delim="none")
+  open(10, err=99,delim="") ! { dg-warning "DELIM specifier in OPEN statement" }
+
+  open(10, err=99,form="formatted")
+  open(10, err=99,form="unformatted")
+  open(10, err=99,form="default") ! { dg-warning "FORM specifier in OPEN statement" }
+
+  open(10, err=99,pad="yes")
+  open(10, err=99,pad="no")
+  open(10, err=99,pad=foo) ! { dg-warning "PAD specifier in OPEN statement" }
+
+  open(10, err=99,position="asis")
+  open(10, err=99,position="rewind")
+  open(10, err=99,position="append")
+  open(10, err=99,position=foo) ! { dg-warning "POSITION specifier in OPEN statement" }
+
+  open(10, err=99,recl="ee") ! { dg-error "must be of type INTEGER" }
+  open(10, err=99,recl=0.4) ! { dg-error "must be of type INTEGER" }
+  open(10, err=99,recl=zero) ! { dg-warning "must be positive" }
+  open(10, err=99,recl=mone) ! { dg-warning "must be positive" }
+
+  open(10, err=99,status="unknown")
+  open(10, err=99,status="old")
+  open(10, err=99,status=foo) ! { dg-warning "STATUS specifier in OPEN statement" }
+  
+  open(10, err=99,status="new") ! { dg-warning "no FILE specifier is present" }
+  open(10, err=99,status="replace   ") ! { dg-warning "no FILE specifier is present" }
+  open(10, err=99,status="scratch",file=str) ! { dg-warning "cannot have the value SCRATCH if a FILE specifier is present" }
+
+  open(10, err=99,form="unformatted",delim="none") ! { dg-warning "not allowed in OPEN statement for unformatted I/O" }
+  open(10, err=99,form="unformatted",pad="yes") ! { dg-warning "not allowed in OPEN statement for unformatted I/O" }
+  open(10, err=99,form="unformatted",blank="null") ! { dg-warning "not allowed in OPEN statement for unformatted I/O" }
+
+  open(10, err=99,access="direct",position="append") ! { dg-warning "only allowed for stream or sequential ACCESS" }
+
+  close(10, err=99,status="keep")
+  close(10, err=99,status="delete")
+  close(10, err=99,status=foo) ! { dg-warning "STATUS specifier in CLOSE statement" }
+
+ 99 continue
+
+! Test for errors
+
+  open(10,access="sequential   ")
+  open(10,access="sequential   u") ! { dg-error "ACCESS specifier in OPEN statement" }
+  open(10,access=foo) ! { dg-error "ACCESS specifier in OPEN statement" }
+  open(10,access="direct")
+  open(10,access="stream")
+  open(10,access="append") ! { dg-warning "Extension: ACCESS specifier in OPEN statement" }
+
+  open(10,action="read")
+  open(10,action="write")
+  open(10,action="readwrite")
+  open(10,action=foo) ! { dg-error "ACTION specifier in OPEN statement" }
+
+  open(10,blank="ZERO")
+  open(10,blank="nUlL")
+  open(10,blank="NULLL") ! { dg-error "BLANK specifier in OPEN statement" }
+
+  open(10,delim="apostrophe")
+  open(10,delim="quote")
+  open(10,delim="none")
+  open(10,delim="") ! { dg-error "DELIM specifier in OPEN statement" }
+
+  open(10,form="formatted")
+  open(10,form="unformatted")
+  open(10,form="default") ! { dg-error "FORM specifier in OPEN statement" }
+
+  open(10,pad="yes")
+  open(10,pad="no")
+  open(10,pad=foo) ! { dg-error "PAD specifier in OPEN statement" }
+
+  open(10,position="asis")
+  open(10,position="rewind")
+  open(10,position="append")
+  open(10,position=foo) ! { dg-error "POSITION specifier in OPEN statement" }
+
+  open(10,recl="ee") ! { dg-error "must be of type INTEGER" }
+  open(10,recl=0.4) ! { dg-error "must be of type INTEGER" }
+  open(10,recl=zero) ! { dg-error "must be positive" }
+  open(10,recl=mone) ! { dg-error "must be positive" }
+
+  open(10,status="unknown")
+  open(10,status="old")
+  open(10,status=foo) ! { dg-error "STATUS specifier in OPEN statement" }
+  
+  open(10,status="new") ! { dg-error "no FILE specifier is present" }
+  open(10,status="replace   ") ! { dg-error "no FILE specifier is present" }
+  open(10,status="scratch",file=str) ! { dg-error "cannot have the value SCRATCH if a FILE specifier is present" }
+
+  open(10,form="unformatted",delim="none") ! { dg-error "not allowed in OPEN statement for unformatted I/O" }
+  open(10,form="unformatted",pad="yes") ! { dg-error "not allowed in OPEN statement for unformatted I/O" }
+  open(10,form="unformatted",blank="null") ! { dg-error "not allowed in OPEN statement for unformatted I/O" }
+
+  open(10,access="direct",position="append") ! { dg-error "only allowed for stream or sequential ACCESS" }
+
+  close(10,status="keep")
+  close(10,status="delete")
+  close(10,status=foo) ! { dg-error "STATUS specifier in CLOSE statement" }
+end
diff --git a/gcc/testsuite/gfortran.dg/io_constraints_4.f90 b/gcc/testsuite/gfortran.dg/io_constraints_4.f90
new file mode 100644
index 000000000..149d31b16
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_constraints_4.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! PR33268 [patch,fortran] read ('(f3.3)'), a rejected due to the extra (...)
+
+write(*,('(a)')) 'Hello'
+write (*,'(f8.3)'), 3.14  ! { dg-warning "Comma before i/o item list" }
+print ('(a)'), "valid"
+read ('(f3.3)'), a 
+read (*, '(f3.3)'), a     ! { dg-warning "Comma before i/o item list" }
+write ('(a)'), "invalid"  ! { dg-error "Invalid form of WRITE statement" }
+end
diff --git a/gcc/testsuite/gfortran.dg/io_constraints_5.f90 b/gcc/testsuite/gfortran.dg/io_constraints_5.f90
new file mode 100644
index 000000000..8d62e25a3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_constraints_5.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! PR 38425 I/O: POS= compile-time diagnostics
+!----------------------------------------------------------
+character(len=30) :: str
+open(3,access='stream')
+
+! C919 (R913) If io-unit is not a file-unit-number, the
+! io-control-spec-list shall not contain a REC= specifier
+! or a POS= specifier.
+write(str,*, pos=4) 5 ! { dg-error "incompatible with internal" }
+
+! C927 (R913) If a POS= specifier appears, the
+! io-control-spec-list shall not contain a REC= specifier.
+write(3,pos=5,rec=4) 5 ! { dg-error "POS= is not allowed with REC=" }
+write(3,rec=4,pos=5) 5 ! { dg-error "POS= is not allowed with REC=" }
+
+!Fortran runtime error: REC=specifier not allowed with STREAM access
+write(3,rec=4) 5
+!Fortran runtime error: REC=specifier must be positive
+write(3,rec=-3) 44
+!Fortran runtime error: POS=specifier must be positive
+write(3,pos=-4) 44
+end
diff --git a/gcc/testsuite/gfortran.dg/io_constraints_6.f03 b/gcc/testsuite/gfortran.dg/io_constraints_6.f03
new file mode 100644
index 000000000..d0484f5f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_constraints_6.f03
@@ -0,0 +1,40 @@
+! { dg-do compile }
+
+! PR fortran/45776
+! Variable definition context checks related to IO.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+module m
+  implicit none
+
+  integer, protected :: a
+  character(len=128), protected :: str
+end module m
+
+program main
+  use :: m
+  integer, parameter :: b = 42
+  integer :: x
+  character(len=128) :: myStr
+
+  namelist /definable/ x, myStr
+  namelist /undefinable/ x, a
+
+  ! These are invalid.
+  read (myStr, *) a ! { dg-error "variable definition context" }
+  read (myStr, *) x, b ! { dg-error "variable definition context" }
+  write (str, *) 5 ! { dg-error "variable definition context" }
+  read (*, nml=undefinable) ! { dg-error "contains the symbol 'a' which may not" }
+
+  ! These are ok.
+  read (str, *) x
+  write (myStr, *) a
+  write (myStr, *) b
+  print *, a, b
+  write (*, nml=undefinable)
+  read (*, nml=definable)
+  write (*, nml=definable)
+end program main
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/io_constraints_7.f03 b/gcc/testsuite/gfortran.dg/io_constraints_7.f03
new file mode 100644
index 000000000..4d1849198
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_constraints_7.f03
@@ -0,0 +1,37 @@
+! { dg-do compile }
+
+! PR fortran/45776
+! Variable definition context checks related to IO.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+module m
+  implicit none
+  integer, protected :: a
+  character(len=128), protected :: msg
+end module m
+
+program main
+  use :: m
+  integer :: x
+  logical :: bool
+
+  write (*, iostat=a) 42 ! { dg-error "variable definition context" }
+  write (*, iomsg=msg) 42 ! { dg-error "variable definition context" }
+  read (*, '(I2)', advance='no', size=a) x ! { dg-error "variable definition context" }
+
+  ! These are ok.
+  inquire (unit=a)
+  inquire (file=msg, id=a, pending=bool)
+  inquire (file=msg)
+
+  ! These not, but list is not extensive.
+  inquire (unit=1, number=a) ! { dg-error "variable definition context" }
+  inquire (unit=1, encoding=msg) ! { dg-error "variable definition context" }
+  inquire (unit=1, formatted=msg) ! { dg-error "variable definition context" }
+
+  open (newunit=a, file="foo") ! { dg-error "variable definition context" }
+  close (unit=a)
+end program main
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/io_invalid_1.f90 b/gcc/testsuite/gfortran.dg/io_invalid_1.f90
new file mode 100644
index 000000000..0dbcf631e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_invalid_1.f90
@@ -0,0 +1,5 @@
+! { dg-do compile }
+! PR fortran/20842
+WRITE(UNIT=6,END=999) 0 ! { dg-error "END tag .* not allowed in output statement" }
+999 CONTINUE
+END
diff --git a/gcc/testsuite/gfortran.dg/io_real_boz.f90 b/gcc/testsuite/gfortran.dg/io_real_boz.f90
new file mode 100644
index 000000000..d5b0cb6b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_real_boz.f90
@@ -0,0 +1,66 @@
+! { dg-do run }
+! Test reading/writing of integer, real and character BOZ
+! non-integer BOZ are not valid in standard Fortran, however.
+! PR fortran/29625
+program real_boz
+  implicit none
+  integer(4)        :: i,i2
+  real(4)           :: r,r2
+  complex(4)        :: z,z2
+  character         :: c,c2
+  character(len=100) :: str,fmt
+
+  i = 43
+  r = 325.56
+  z = cmplx(14.456, 345342.456)
+  c ='g'
+
+  write(str,'(b0)') i
+  write(fmt,'(a,i0,a)') '(b',len_trim(str),')'
+  read(str,fmt) i2
+  if(i /= i2) call abort()
+
+  write(str,'(o0)') i
+  write(fmt,'(a,i0,a)') '(o',len_trim(str),')'
+  read(str,fmt) i2
+  if(i /= i2) call abort()
+
+  write(str,'(z0)') i
+  write(fmt,'(a,i0,a)') '(z',len_trim(str),')'
+  read(str,fmt) i2
+  if(i /= i2) call abort()
+
+
+  write(str,'(b0)') r
+  write(fmt,'(a,i0,a)') '(b',len_trim(str),')'
+  read(str,fmt) r2
+  if(r /= r2) call abort()
+  
+  write(str,'(o0)') r
+  write(fmt,'(a,i0,a)') '(o',len_trim(str),')'
+  read(str,fmt) r2
+  if(r /= r2) call abort()
+
+  write(str,'(z0)') r
+  write(fmt,'(a,i0,a)') '(z',len_trim(str),')'
+  read(str,fmt) r2
+  if(r /= r2) call abort()
+
+
+  write(str,'(b0)') c
+  write(fmt,'(a,i0,a)') '(b',len_trim(str),')'
+  read(str,fmt) c2
+  if(c /= c2) call abort()
+
+  write(str,'(o0)') c
+  write(fmt,'(a,i0,a)') '(o',len_trim(str),')'
+  read(str,fmt) c2
+  if(c /= c2) call abort()
+
+  write(str,'(z0)') c
+  write(fmt,'(a,i0,a)') '(z',len_trim(str),')'
+  read(str,fmt) c2
+  if(c /= c2) call abort()
+
+end program real_boz
+  
diff --git a/gcc/testsuite/gfortran.dg/io_real_boz2.f90 b/gcc/testsuite/gfortran.dg/io_real_boz2.f90
new file mode 100644
index 000000000..b62385f02
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_real_boz2.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-shouldfail "Real BOZ not allowed" }
+! { dg-options "-fall-intrinsics -std=f2003" }
+! Test for invalid (F95/F2003) writing of real with octal edit descriptor
+! PR fortran/29625
+program real_boz
+  implicit none
+  real(4)           :: r
+  character(len=100) :: str
+
+  r = 325.56
+  write(str,'(o0)') r
+end program real_boz
+! { dg-output "At line 12 .*" }
+! { dg-output "Expected INTEGER .* in formatted transfer, got REAL" }
diff --git a/gcc/testsuite/gfortran.dg/iomsg_1.f90 b/gcc/testsuite/gfortran.dg/iomsg_1.f90
new file mode 100644
index 000000000..0916fd861
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iomsg_1.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! Test implementation of the iomsg tag.
+program iomsg_test
+  character(len=70) ch
+
+  ! Test that iomsg is left unchanged with no error
+  ch = 'asdf'
+  open(10, status='scratch', iomsg=ch, iostat=i)
+  if (ch .ne. 'asdf') call abort
+
+  ! Test iomsg with data transfer statement
+  read(10,'(I2)', iomsg=ch, end=100) k
+  call abort
+100 continue
+  if (ch .ne. 'End of file') call abort
+
+  ! Test iomsg with open
+  open (-3, err=200, iomsg=ch)
+
+  call abort
+200 continue
+  if (ch .ne. 'Bad unit number in OPEN statement') call abort
+
+  ! Test iomsg with close
+  close(23,status="no_idea", err=500, iomsg=ch) ! { dg-warning "STATUS specifier in CLOSE statement.*has invalid value" }
+500 continue
+  if (ch .ne. "Bad STATUS parameter in CLOSE statement") call abort
+end program iomsg_test
diff --git a/gcc/testsuite/gfortran.dg/iostat_1.f90 b/gcc/testsuite/gfortran.dg/iostat_1.f90
new file mode 100644
index 000000000..79bc0018f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iostat_1.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! PR 23598 - The iostat variable wasn't reset if the previous
+! I/O library call had an error.
+program main
+  implicit none
+  integer :: ios, i
+  open (10, pad='no', status='scratch')
+  write (10, '(A)') '1','1'
+  rewind (10)
+  read (10,'(I2)',iostat=ios) i
+  ios = -4321
+  read (10, '(I1)', iostat=ios) i
+  if (ios /= 0) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/iostat_2.f90 b/gcc/testsuite/gfortran.dg/iostat_2.f90
new file mode 100644
index 000000000..afda93e80
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iostat_2.f90
@@ -0,0 +1,8 @@
+! PR libfortran/23784
+! { dg-do run }
+  integer i
+  close(10, status="whatever", iostat=i) ! { dg-warning "STATUS specifier in CLOSE statement.*has invalid value" }
+  if (i == 0) call abort()
+  write(17,*) 'foo'
+  close(17, status="delete")
+  end
diff --git a/gcc/testsuite/gfortran.dg/iostat_3.f90 b/gcc/testsuite/gfortran.dg/iostat_3.f90
new file mode 100644
index 000000000..23492f2af
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iostat_3.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! Testcase for PR libfortran/25068
+  real :: u
+  integer(kind=8) :: i
+  open (10,status="scratch")
+  read (10,*,iostat=i) u ! { dg-error "Fortran 95 requires default INTEGER in IOSTAT tag" }
+  close (10,iostat=i) ! { dg-error "Fortran 95 requires default INTEGER in IOSTAT tag" }
+  end
diff --git a/gcc/testsuite/gfortran.dg/iostat_4.f90 b/gcc/testsuite/gfortran.dg/iostat_4.f90
new file mode 100644
index 000000000..34c25f962
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iostat_4.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! PR31201 Too large unit number generates wrong code
+! This tests initialization of the IOSTAT variable
+  integer :: i
+  character(len=50) :: str
+  write (2_8*int(huge(0_4),kind=8)+9_8, iostat=i, iomsg=str) 555
+  if (i.ne.5005) call abort
+  if (str.ne."Unit number in I/O statement too large") call abort
+  end 
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/is_iostat_end_eor_1.f90 b/gcc/testsuite/gfortran.dg/is_iostat_end_eor_1.f90
new file mode 100644
index 000000000..dfa3a5c03
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/is_iostat_end_eor_1.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! Test for the Fortran 2003 intrinsics is_iostat_end & is_iostat_eor
+!
+program test
+  use iso_fortran_env
+  implicit none
+  if ((.not. is_iostat_end(IOSTAT_END)) .or. is_iostat_end(0)) call abort()
+  if ((.not. is_iostat_eor(IOSTAT_EOR)) .or. is_iostat_end(0)) call abort()
+end program test
diff --git a/gcc/testsuite/gfortran.dg/is_iostat_end_eor_2.f90 b/gcc/testsuite/gfortran.dg/is_iostat_end_eor_2.f90
new file mode 100644
index 000000000..eda9d31df
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/is_iostat_end_eor_2.f90
@@ -0,0 +1,39 @@
+! Check that we correctly simplify IS_IOSTAT_END and IS_IOSTAT_EOR.
+! Not very useful, but required by the standards
+!
+! This test relies on the error numbers for END and EOR being -1 and -2.
+! This is good to actual
+!
+! { dg-do compile }
+!
+
+  use iso_fortran_env, only : iostat_end, iostat_eor
+  implicit none
+
+  integer(kind=merge(4, 0, is_iostat_end(-1))) :: a
+  integer(kind=merge(4, 0, is_iostat_end(-1_1))) :: b
+  integer(kind=merge(4, 0, is_iostat_end(-1_2))) :: c
+  integer(kind=merge(4, 0, is_iostat_end(-1_4))) :: d
+  integer(kind=merge(4, 0, is_iostat_end(-1_8))) :: e
+
+  integer(kind=merge(4, 0, is_iostat_eor(-2))) :: f
+  integer(kind=merge(4, 0, is_iostat_eor(-2_1))) :: g
+  integer(kind=merge(4, 0, is_iostat_eor(-2_2))) :: h
+  integer(kind=merge(4, 0, is_iostat_eor(-2_4))) :: i
+  integer(kind=merge(4, 0, is_iostat_eor(-2_8))) :: j
+
+  integer(kind=merge(0, 4, is_iostat_eor(-1))) :: k
+  integer(kind=merge(0, 4, is_iostat_end(-2))) :: l
+
+  integer(kind=merge(0, 4, is_iostat_eor(0))) :: m
+  integer(kind=merge(0, 4, is_iostat_end(0))) :: n
+
+  integer(kind=merge(4, 0, is_iostat_end(0))) :: o ! { dg-error "not supported for type" }
+  integer(kind=merge(4, 0, is_iostat_eor(0))) :: p ! { dg-error "not supported for type" }
+
+  integer(kind=merge(4, 0, is_iostat_eor(iostat_eor))) :: q
+  integer(kind=merge(4, 0, is_iostat_end(iostat_end))) :: r
+  integer(kind=merge(0, 4, is_iostat_end(iostat_eor))) :: s
+  integer(kind=merge(0, 4, is_iostat_eor(iostat_end))) :: t
+
+  end
diff --git a/gcc/testsuite/gfortran.dg/ishft_1.f90 b/gcc/testsuite/gfortran.dg/ishft_1.f90
new file mode 100644
index 000000000..88edd30ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ishft_1.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+! verifies basic functioning of the ishft and ishftc intrinsics
+if (ishft (1_1, 0) /= 1) call abort
+if (ishft (1_1, 1) /= 2) call abort
+if (ishft (3_1, 1) /= 6) call abort
+if (ishft (-1_1, 1) /= -2) call abort
+if (ishft (-1_1, -1) /= 127) call abort
+if (ishft (96_1, 2) /= -128) call abort
+
+if (ishft (1_2, 0) /= 1) call abort
+if (ishft (1_2, 1) /= 2) call abort
+if (ishft (3_2, 1) /= 6) call abort
+if (ishft (-1_2, 1) /= -2) call abort
+if (ishft (-1_2, -1) /= 32767) call abort
+if (ishft (16384_2 + 8192_2, 2) /= -32768_4) call abort
+
+if (ishft (1_4, 0) /= 1) call abort
+if (ishft (1_4, 1) /= 2) call abort
+if (ishft (3_4, 1) /= 6) call abort
+if (ishft (-1_4, 1) /= -2) call abort
+if (ishft (-1_4, -1) /= 2147483647) call abort
+if (ishft (1073741824_4 + 536870912_4, 2) /= -2147483648_8) call abort
+
+if (ishft (1_8, 0) /= 1) call abort
+if (ishft (1_8, 1) /= 2) call abort
+if (ishft (3_8, 1) /= 6) call abort
+if (ishft (-1_8, 1) /= -2) call abort
+if (ishft (-1_8, -60) /= z'F') call abort
+
+if (ishftc (1_1, 0) /= 1) call abort
+if (ishftc (1_1, 1) /= 2) call abort
+if (ishftc (3_1, 1) /= 6) call abort
+if (ishftc (-1_1, 1) /= -1) call abort
+if (ishftc (-1_1, -1) /= -1) call abort
+if (ishftc (ishftc (96_1, 2), -2) /= 96) call abort
+
+if (ishftc (1_2, 0) /= 1) call abort
+if (ishftc (1_2, 1) /= 2) call abort
+if (ishftc (3_2, 1) /= 6) call abort
+if (ishftc (-1_2, 1) /= -1) call abort
+if (ishftc (-1_2, -1) /= -1) call abort
+if (ishftc (ishftc (25000_2, 2), -2) /= 25000) call abort
+
+if (ishftc (1_4, 0) /= 1) call abort
+if (ishftc (1_4, 1) /= 2) call abort
+if (ishftc (3_4, 1) /= 6) call abort
+if (ishftc (-1_4, 1) /= -1) call abort
+if (ishftc (-1_4, -1) /= -1) call abort
+if (ishftc (ishftc (1325876_4, 2), -2) /= 1325876) call abort
+
+if (ishftc (1_8, 0) /= 1) call abort
+if (ishftc (1_8, 1) /= 2) call abort
+if (ishftc (3_8, 1) /= 6) call abort
+if (ishftc (-1_8, 1) /= -1) call abort
+if (ishftc (-1_8, -1) /= -1) call abort
+if (ishftc (ishftc (1325876_8, 2), -2) /= 1325876) call abort
+end
+
+
diff --git a/gcc/testsuite/gfortran.dg/ishft_2.f90 b/gcc/testsuite/gfortran.dg/ishft_2.f90
new file mode 100644
index 000000000..96acf0e3b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ishft_2.f90
@@ -0,0 +1,6 @@
+! { dg-do run }
+program ishft_2
+  if ( ishftc(3, 2, 3) /= 5 ) call abort()
+  if ( ishftc(256+3, 2, 3) /= 256+5 ) call abort()
+  if ( ishftc(1_4, 31)+1 /= -huge(1_4) ) call abort()
+end program
diff --git a/gcc/testsuite/gfortran.dg/ishft_3.f90 b/gcc/testsuite/gfortran.dg/ishft_3.f90
new file mode 100644
index 000000000..fa3938ef9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ishft_3.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+program ishft_3
+  integer i, j
+  write(*,*) ishftc( 3, 2, 3 )
+  write(*,*) ishftc( 3, 2, i )
+  write(*,*) ishftc( 3, i, j )
+  write(*,*) ishftc( 3, 128 )     ! { dg-error "exceeds BIT_SIZE of first" }
+  write(*,*) ishftc( 3, 0, 128 )  ! { dg-error "exceeds BIT_SIZE of first" }
+  write(*,*) ishftc( 3, 0, 0 )    ! { dg-error "Invalid third argument" }
+  write(*,*) ishftc( 3, 3, 2 )    ! { dg-error "exceeds third argument" }
+end program
diff --git a/gcc/testsuite/gfortran.dg/ishft_4.f90 b/gcc/testsuite/gfortran.dg/ishft_4.f90
new file mode 100644
index 000000000..4e2ad2b13
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ishft_4.f90
@@ -0,0 +1,40 @@
+! We want to check that ISHFT evaluates its arguments only once
+!
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+
+program test
+
+  if (ishft (foo(), 2) /= 4) call abort
+  if (ishft (foo(), -1) /= 1) call abort
+  if (ishft (1, foo()) /= 8) call abort
+  if (ishft (16, -foo()) /= 1) call abort
+
+  if (ishftc (bar(), 2) /= 4) call abort
+  if (ishftc (bar(), -1) /= 1) call abort
+  if (ishftc (1, bar()) /= 8) call abort
+  if (ishftc (16, -bar()) /= 1) call abort
+
+contains
+  
+  integer function foo ()
+    integer, save :: i = 0
+    i = i + 1
+    foo = i
+  end function
+
+  integer function bar ()
+    integer, save :: i = 0
+    i = i + 1
+    bar = i
+  end function
+
+end program
+
+! The regexp "foo ()" should be seen once in the dump:
+!   -- once in the function definition itself
+!   -- plus as many times as the function is called
+!
+! { dg-final { scan-tree-dump-times "foo *\\\(\\\)" 5 "original" } }
+! { dg-final { scan-tree-dump-times "bar *\\\(\\\)" 5 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/isnan_1.f90 b/gcc/testsuite/gfortran.dg/isnan_1.f90
new file mode 100644
index 000000000..89e4cd35b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/isnan_1.f90
@@ -0,0 +1,21 @@
+! Test for the ISNAN intrinsic
+!
+! { dg-do run }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+!
+  implicit none
+  real :: x
+  x = -1.0
+  x = sqrt(x)
+  if (.not. isnan(x)) call abort
+  x = 0.0
+  x = x / x
+  if (.not. isnan(x)) call abort
+
+  x = 5.0
+  if (isnan(x)) call abort
+  x = huge(x)
+  x = 2*x
+  if (isnan(x)) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/isnan_2.f90 b/gcc/testsuite/gfortran.dg/isnan_2.f90
new file mode 100644
index 000000000..455ecef1f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/isnan_2.f90
@@ -0,0 +1,18 @@
+! Test for the ISNAN intrinsic on constants
+!
+! { dg-do run }
+! { dg-options "-fno-range-check" }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+!
+  implicit none
+  character(len=1) :: s
+  write(s,'(L1)') isnan(0.)
+  if (s /= 'F') call abort
+
+  write(s,'(L1)') isnan(exp(huge(0.)))
+  if (s /= 'F') call abort
+
+  write(s,'(L1)') isnan(0./0.)
+  if (s /= 'T') call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_c_loc_char_1.f03 b/gcc/testsuite/gfortran.dg/iso_c_binding_c_loc_char_1.f03
new file mode 100644
index 000000000..14bc4a075
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_c_binding_c_loc_char_1.f03
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! PR 38536 - don't reject substring of length one
+! Original test case by Scot Breitenfeld
+SUBROUTINE test(buf, buf2, buf3, n)
+  USE, INTRINSIC :: ISO_C_BINDING
+  IMPLICIT NONE
+  CHARACTER(LEN=*), INTENT(INOUT), TARGET :: buf
+  INTEGER, INTENT(in) :: n
+  CHARACTER(LEN=*), INTENT(INOUT), DIMENSION(1:2), TARGET :: buf2
+  CHARACTER(LEN=3), TARGET :: buf3
+  TYPE(C_PTR) :: f_ptr
+
+  f_ptr = C_LOC(buf(1:1))      ! Used to fail
+                               ! Error: CHARACTER argument 'buf' to 'c_loc'
+                               ! at (1) must have a length of 1
+  f_ptr = C_LOC(buf2(1)(1:1))  ! PASSES
+
+  f_ptr = C_LOC(buf(n:n))
+
+  f_ptr = C_LOC(buf3(3:))
+END SUBROUTINE test
diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_compiler_1.f90 b/gcc/testsuite/gfortran.dg/iso_c_binding_compiler_1.f90
new file mode 100644
index 000000000..8eccb6b9e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_c_binding_compiler_1.f90
@@ -0,0 +1,18 @@
+! { dg-do link }
+!
+! PR fortran/40569
+!
+! Check compiler_version/compiler_options intrinsics
+!
+subroutine test()
+  use iso_fortran_env, only: compiler_version
+  print '(3a)', '>>',compiler_version(),'<<'
+end
+
+use iso_fortran_env, foo => compiler_version, bar => compiler_version
+  implicit none
+  print *, foo()
+  print *, bar()
+  print '(3a)', '>',compiler_options(),'<'
+  call test()
+end
diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_compiler_2.f90 b/gcc/testsuite/gfortran.dg/iso_c_binding_compiler_2.f90
new file mode 100644
index 000000000..279cfe60e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_c_binding_compiler_2.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/40569
+!
+! Check compiler_version/compiler_options intrinsics
+!
+use iso_fortran_env, only:  compiler_options ! { dg-error "is not in the selected standard" }
+use iso_fortran_env, only:  compiler_version ! { dg-error "is not in the selected standard" }
+  implicit none
+end
diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_init_expr.f03 b/gcc/testsuite/gfortran.dg/iso_c_binding_init_expr.f03
new file mode 100644
index 000000000..0a0099628
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_c_binding_init_expr.f03
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! PR fortran/42354
+
+use iso_c_binding
+implicit none
+integer, target :: a
+type t
+  type(c_ptr) :: ptr = c_loc(a)    ! { dg-error "must be an intrinsic function" }
+end type t
+type(c_ptr) :: ptr2 = c_loc(a)     ! { dg-error "must be an intrinsic function" }
+end
diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_only.f03 b/gcc/testsuite/gfortran.dg/iso_c_binding_only.f03
new file mode 100644
index 000000000..dff4318e8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_c_binding_only.f03
@@ -0,0 +1,11 @@
+! { dg-do compile }
+module iso_c_binding_only
+  ! c_f_procpointer verifies that the c_funptr derived type for the cptr param
+  ! is auto-generated, and c_f_pointer tests c_ptr.
+  use, intrinsic :: iso_c_binding, only: c_null_ptr, c_f_procpointer
+  ! This should be allowed since the C_PTR that the C_NULL_PTR needs will use
+  ! a mangled name to prevent collisions.
+  integer :: c_ptr
+end module iso_c_binding_only
+! { dg-final { cleanup-modules "iso_c_binding_only" } }  
+
diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_rename_1.f03 b/gcc/testsuite/gfortran.dg/iso_c_binding_rename_1.f03
new file mode 100644
index 000000000..799ba35e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_c_binding_rename_1.f03
@@ -0,0 +1,84 @@
+! { dg-do run }
+! { dg-additional-sources iso_c_binding_rename_1_driver.c }
+module iso_c_binding_rename_0
+  use, intrinsic :: iso_c_binding, only: my_c_ptr_0 => c_ptr, &
+       c_associated
+end module iso_c_binding_rename_0
+
+
+module iso_c_binding_rename_1
+  ! rename a couple of the symbols from iso_c_binding.  the compiler 
+  ! needs to be able to recognize the derived types with names different
+  ! from the one in iso_c_binding because it will look up the derived types
+  ! to define the args and return values of some of the procedures in 
+  ! iso_c_binding.  this should verify that this functionality works.
+  use, intrinsic :: iso_c_binding, my_c_int => c_int, my_c_ptr => c_ptr, &
+       my_c_associated => c_associated, my_c_f_pointer => c_f_pointer
+
+contains
+  subroutine sub0(my_int) bind(c)
+    integer(my_c_int), value :: my_int
+    if(my_int .ne. 1) then
+       call abort()
+    end if
+  end subroutine sub0
+
+  subroutine sub1(my_ptr) bind(c)
+    type(my_c_ptr), value :: my_ptr
+
+    if(.not. my_c_associated(my_ptr)) then
+       call abort()
+    end if
+  end subroutine sub1
+
+  subroutine sub2(my_int, my_long) bind(c)
+    use, intrinsic :: iso_c_binding, my_c_int_2 => c_int, &
+         my_c_long_2 => c_long
+    integer(my_c_int_2), value :: my_int
+    integer(my_c_long_2), value :: my_long
+
+    if(my_int .ne. 1) then
+       call abort()
+    end if
+    if(my_long .ne. 1) then
+       call abort()
+    end if
+  end subroutine sub2
+
+  subroutine sub3(cptr1, cptr2) bind(c)
+    type(my_c_ptr), value :: cptr1
+    type(my_c_ptr), value :: cptr2
+    integer(my_c_int), pointer :: my_f90_c_ptr
+
+    if(.not. my_c_associated(cptr1)) then
+       call abort()
+    end if
+
+    if(.not. my_c_associated(cptr1, cptr2)) then
+       call abort()
+    end if
+
+    call my_c_f_pointer(cptr1, my_f90_c_ptr)
+  end subroutine sub3
+
+  subroutine sub4(cptr1, cptr2) bind(c)
+    ! rename the my_c_ptr_0 from iso_c_binding_rename_0 just to further test
+    ! both are actually aliases to c_ptr
+    use iso_c_binding_rename_0, my_c_ptr_local => my_c_ptr_0, &
+         my_c_associated_2 => c_associated
+
+    implicit none
+    type(my_c_ptr_local), value :: cptr1
+    type(my_c_ptr_local), value :: cptr2
+
+    if(.not. my_c_associated_2(cptr1)) then
+       call abort()
+    end if
+    
+    if(.not. my_c_associated_2(cptr2)) then
+       call abort()
+    end if
+  end subroutine sub4
+end module iso_c_binding_rename_1
+
+! { dg-final { cleanup-modules "iso_c_binding_rename_0 iso_c_binding_rename_1" } }
diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_rename_1_driver.c b/gcc/testsuite/gfortran.dg/iso_c_binding_rename_1_driver.c
new file mode 100644
index 000000000..26c21d912
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_c_binding_rename_1_driver.c
@@ -0,0 +1,19 @@
+void sub0(int);
+void sub1(int *);
+void sub2(int, long);
+void sub3(int *, int *);
+void sub4(int *, int *);
+
+int main(int argc, char **argv)
+{
+  int i = 1;
+  long j = 1;
+
+  sub0(i);
+  sub1(&i);
+  sub2(i, j);
+  sub3(&i, &i);
+  sub4(&i, &i);
+
+  return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_rename_2.f03 b/gcc/testsuite/gfortran.dg/iso_c_binding_rename_2.f03
new file mode 100644
index 000000000..e7c18db2f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_c_binding_rename_2.f03
@@ -0,0 +1,42 @@
+! { dg-do run }
+! { dg-additional-sources iso_c_binding_rename_2_driver.c }
+module mod0
+  use, intrinsic :: iso_c_binding, only: c_ptr, c_associated
+end module mod0
+
+module mod1
+  use mod0, my_c_ptr => c_ptr, my_c_associated => c_associated
+end module mod1
+
+module mod2
+contains
+  subroutine sub2(my_ptr1) bind(c)
+    use mod1, my_c_ptr_2 => my_c_ptr, my_c_associated_2 => my_c_associated
+    implicit none
+    type(my_c_ptr_2) :: my_ptr1
+    if( .not. my_c_associated_2(my_ptr1)) then
+       call abort()
+    end if
+  end subroutine sub2
+
+  subroutine sub3(my_ptr1) bind(c)
+    use mod1, my_c_ptr_2 => my_c_ptr
+    implicit none
+    type(my_c_ptr_2) :: my_ptr1
+    if( .not. my_c_associated(my_ptr1)) then
+       call abort()
+    end if
+  end subroutine sub3
+
+  subroutine sub4(my_ptr1) bind(c)
+    use mod1, my_c_associated_3 => my_c_associated
+    implicit none
+    type(my_c_ptr) :: my_ptr1
+    if( .not. my_c_associated_3(my_ptr1)) then
+       call abort()
+    end if
+  end subroutine sub4
+
+end module mod2
+
+! { dg-final { cleanup-modules "mod0 mod1 mod2" } }
diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_rename_2_driver.c b/gcc/testsuite/gfortran.dg/iso_c_binding_rename_2_driver.c
new file mode 100644
index 000000000..8be704c34
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_c_binding_rename_2_driver.c
@@ -0,0 +1,16 @@
+void sub2(int **);
+void sub3(int **);
+void sub4(int **);
+
+int main(int argc, char **argv)
+{
+  int i = 1; 
+  int *ptr;
+
+  ptr = &i;
+  sub2(&ptr);
+  sub3(&ptr);
+  sub4(&ptr);
+
+  return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/iso_fortran_env_1.f90 b/gcc/testsuite/gfortran.dg/iso_fortran_env_1.f90
new file mode 100644
index 000000000..dfcf49bf9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_fortran_env_1.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+module iso_fortran_env
+  real :: x
+end module iso_fortran_env
+
+subroutine bar
+  use , intrinsic :: iso_fortran_env
+  implicit none
+
+  if (file_storage_size /= 8) call abort
+  if (character_storage_size /= 8) call abort
+  if (all (numeric_storage_size /= [ 8, 16, 32, 64, 128])) call abort
+  if (input_unit /= 5) call abort
+  if (output_unit /= 6) call abort
+  if (error_unit /= 0) call abort
+  if (iostat_end /= -1) call abort
+  if (iostat_eor /= -2) call abort
+end
+
+subroutine bar2
+  use , intrinsic :: iso_fortran_env, only : file_storage_size, &
+    character_storage_size, numeric_storage_size, input_unit, output_unit, &
+    error_unit, iostat_end, iostat_eor
+  implicit none
+
+  if (file_storage_size /= 8) call abort
+  if (character_storage_size /= 8) call abort
+  if (all (numeric_storage_size /= [ 8, 16, 32, 64, 128])) call abort
+  if (input_unit /= 5) call abort
+  if (output_unit /= 6) call abort
+  if (error_unit /= 0) call abort
+  if (iostat_end /= -1) call abort
+  if (iostat_eor /= -2) call abort
+end
+
+program test
+  use , intrinsic :: iso_fortran_env, uu => output_unit
+  implicit none
+
+  if (input_unit /= 5 .or. uu /= 6) call abort
+  call bar
+  call bar2
+end
+! { dg-final { cleanup-modules "iso_fortran_env" } }
diff --git a/gcc/testsuite/gfortran.dg/iso_fortran_env_2.f90 b/gcc/testsuite/gfortran.dg/iso_fortran_env_2.f90
new file mode 100644
index 000000000..6f8d228d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_fortran_env_2.f90
@@ -0,0 +1,76 @@
+! { dg-do compile }
+module iso_fortran_env
+  logical :: x
+end module iso_fortran_env
+
+subroutine bar1
+  use , intrinsic :: iso_fortran_env
+  print *, character_storage_size
+end
+
+subroutine bar2
+  use, intrinsic :: iso_fortran_env
+  print *, character_storage_size
+end
+
+subroutine bar3
+  use,intrinsic :: iso_fortran_env
+  print *, character_storage_size
+end
+
+subroutine bar4
+  use,intrinsic::iso_fortran_env
+  print *, character_storage_size
+end
+
+subroutine bar5
+  use ,intrinsic :: iso_fortran_env
+  print *, character_storage_size
+end
+
+subroutine foo1
+  use :: iso_fortran_env
+  print *, x
+end
+
+subroutine foo2
+  use:: iso_fortran_env
+  print *, x
+end
+
+subroutine foo3
+  use::iso_fortran_env
+  print *, x
+end
+
+subroutine foo4
+  use  ::iso_fortran_env
+  print *, x
+end
+
+subroutine gee1
+  use , non_intrinsic :: iso_fortran_env
+  print *, x
+end
+
+subroutine gee2
+  use, non_intrinsic :: iso_fortran_env
+  print *, x
+end
+
+subroutine gee3
+  use,non_intrinsic :: iso_fortran_env
+  print *, x
+end
+
+subroutine gee4
+  use,non_intrinsic::iso_fortran_env
+  print *, x
+end
+
+subroutine gee5
+  use ,non_intrinsic :: iso_fortran_env
+  print *, x
+end
+
+! { dg-final { cleanup-modules "iso_fortran_env" } }
diff --git a/gcc/testsuite/gfortran.dg/iso_fortran_env_3.f90 b/gcc/testsuite/gfortran.dg/iso_fortran_env_3.f90
new file mode 100644
index 000000000..a90315958
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_fortran_env_3.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+subroutine foo1 (x,y)
+  use iso_fortran_env
+  integer, intent(out) :: x, y
+
+  x = numeric_storage_size
+  y = character_storage_size
+end
+
+subroutine foo2 (x,y)
+  use iso_fortran_env, foo => numeric_storage_size
+  integer, intent(in) :: x, y
+
+  if (foo /= x .or. character_storage_size /= y) call abort
+end
+
+subroutine foo3 (x,y)
+  use iso_fortran_env, only : numeric_storage_size, character_storage_size
+  integer, intent(in) :: x, y
+
+  if (numeric_storage_size /= x .or. character_storage_size /= y) call abort
+end
+
+program test
+  integer :: x, y
+  call foo1(x,y)
+  call foo2(x,y)
+  call foo3(x,y)
+end
diff --git a/gcc/testsuite/gfortran.dg/iso_fortran_env_4.f90 b/gcc/testsuite/gfortran.dg/iso_fortran_env_4.f90
new file mode 100644
index 000000000..515269bd7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_fortran_env_4.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+module iso_fortran_env
+end module iso_fortran_env
+
+program foo
+ use, intrinsic :: iso_fortran_env
+ use, non_intrinsic :: iso_fortran_env ! { dg-error "conflicts with intrinsic module" }
+end program foo
+
+subroutine truc
+ use, non_intrinsic :: iso_fortran_env
+ use, intrinsic :: iso_fortran_env ! { dg-error "conflicts with non-intrinsic module" }
+end subroutine truc
+! { dg-final { cleanup-modules "iso_fortran_env" } }
diff --git a/gcc/testsuite/gfortran.dg/iso_fortran_env_5.f90 b/gcc/testsuite/gfortran.dg/iso_fortran_env_5.f90
new file mode 100644
index 000000000..92c2e40de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_fortran_env_5.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+!
+! Check for new F2008 integer constants, needed for
+! coarray support (cf. PR fortran/18918)
+!
+
+USE iso_fortran_env
+implicit none
+integer :: i
+integer(kind=ATOMIC_INT_KIND) :: atomic_int
+logical(kind=ATOMIC_LOGICAL_KIND) :: atomic_bool
+
+i = 0
+if (IOSTAT_INQUIRE_INTERNAL_UNIT <= 0) call abort()
+if (IOSTAT_INQUIRE_INTERNAL_UNIT == STAT_STOPPED_IMAGE) call abort()
+if (STAT_STOPPED_IMAGE <= 0) call abort()
+
+if ((STAT_LOCKED_OTHER_IMAGE == STAT_LOCKED) &
+    .or.(STAT_LOCKED_OTHER_IMAGE == STAT_UNLOCKED)) call abort()
+if (STAT_LOCKED == STAT_UNLOCKED) call abort()
+
+end
+
+! { dg-final { scan-tree-dump-times "abort" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/iso_fortran_env_6.f90 b/gcc/testsuite/gfortran.dg/iso_fortran_env_6.f90
new file mode 100644
index 000000000..0f5aedf0b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_fortran_env_6.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! Check for new F2008 integer constants, needed for
+! coarray support (cf. PR fortran/18918)
+!
+
+USE iso_fortran_env
+implicit none
+integer(kind=ATOMIC_INT_KIND) :: atomic_int ! { dg-error "has no IMPLICIT type" }
+logical(kind=ATOMIC_LOGICAL_KIND) :: atomic_bool ! { dg-error "has no IMPLICIT type" }
+
+print *, OUTPUT_UNIT
+
+if (IOSTAT_INQUIRE_INTERNAL_UNIT <= 0) call abort() ! { dg-error "has no IMPLICIT type" }
+print *,STAT_STOPPED_IMAGE ! { dg-error "has no IMPLICIT type" }
+print *, STAT_LOCKED_OTHER_IMAGE ! { dg-error "has no IMPLICIT type" }
+print *, STAT_LOCKED ! { dg-error "has no IMPLICIT type" }
+print *, STAT_UNLOCKED ! { dg-error "has no IMPLICIT type" }
+end
+
+module m
+USE iso_fortran_env, only: INPUT_UNIT
+USE iso_fortran_env, only: ATOMIC_INT_KIND ! { dg-error "is not in the selected standard" }
+implicit none
+end module m
+
+module m2
+USE iso_fortran_env, only: foo => STAT_UNLOCKED ! { dg-error "is not in the selected standard" }
+implicit none
+end module m2
+
+module m3
+USE iso_fortran_env, foo => IOSTAT_INQUIRE_INTERNAL_UNIT ! { dg-error "not in the selected standard" }
+implicit none
+end module m3
diff --git a/gcc/testsuite/gfortran.dg/iso_fortran_env_7.f90 b/gcc/testsuite/gfortran.dg/iso_fortran_env_7.f90
new file mode 100644
index 000000000..c8617efb1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/iso_fortran_env_7.f90
@@ -0,0 +1,61 @@
+! { dg-do link }
+!
+! PR fortran/40571
+!
+! This test case adds check for the new Fortran 2008 array parameters
+! in ISO_FORTRAN_ENV: integer_kinds, logical_kinds, character_kinds,
+! and real_kinds.
+!
+! The test thus also checks that the values of the parameter are used
+! and no copy is made. (Cf. PR 44856.)
+
+program test
+  use iso_fortran_env, only: integer_kinds, character_kinds
+  implicit none
+  integer :: aaaa(2),i
+  i=1
+
+  print *, integer_kinds
+  print *, integer_kinds(1)
+  print *, (integer_kinds)
+  print *, (integer_kinds + 1)
+  print *, integer_kinds(1:2)
+  print *, integer_kinds(i)
+
+  aaaa = character_kinds
+  aaaa(1:2) = character_kinds(1:2)
+  aaaa(i) = character_kinds(i)
+  aaaa = character_kinds + 0
+  aaaa(1:2) = character_kinds(1:2) + 0
+  aaaa(i) = character_kinds(i) + 0
+end program test
+
+subroutine one()
+  use iso_fortran_env, only: ik => integer_kinds, ik2 => integer_kinds
+  implicit none
+
+  if (any (ik /= ik2)) call never_call_me()
+end subroutine one
+
+subroutine two()
+  use iso_fortran_env
+  implicit none
+
+  ! Should be 1, 2, 4, 8 and possibly 16
+  if (size (integer_kinds) < 4) call never_call_me()
+  if (any (integer_kinds(1:4) /= [1,2,4,8])) call never_call_me()
+  if (any (integer_kinds /= logical_kinds)) call never_call_me()
+
+  if (size (character_kinds) /= 2) call never_call_me()
+  if (any (character_kinds /= [1,4])) call never_call_me()
+
+  if (size (real_kinds) < 2) call never_call_me()
+  if (any (real_kinds(1:2) /= [4,8])) call never_call_me()
+end subroutine two
+
+subroutine three()
+  use iso_fortran_env
+  integer :: i, j(2)
+  i = real_kinds(1)
+  j = real_kinds(1:2)
+end subroutine three
diff --git a/gcc/testsuite/gfortran.dg/itime_idate_1.f b/gcc/testsuite/gfortran.dg/itime_idate_1.f
new file mode 100644
index 000000000..618a83f17
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/itime_idate_1.f
@@ -0,0 +1,12 @@
+! { dg-do run }
+! Test for ITIME and IDATE intrinsics
+      integer x(3)
+      call itime(x)
+      if (x(1) < 0 .or. x(1) > 23 .or.
+     &    x(2) < 0 .or. x(2) > 59 .or.
+     &    x(3) < 0 .or. x(3) > 61) call abort
+      call idate(x)
+      if (x(1) < 1 .or. x(1) > 31 .or.
+     &    x(2) < 1 .or. x(2) > 12 .or.
+     &    x(3) < 2001 .or. x(3) > 2100) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/itime_idate_2.f b/gcc/testsuite/gfortran.dg/itime_idate_2.f
new file mode 100644
index 000000000..11c582dd6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/itime_idate_2.f
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-options "-fdefault-integer-8" }
+! Test for ITIME and IDATE intrinsics
+      integer x(3)
+      call itime(x)
+      if (x(1) < 0 .or. x(1) > 23 .or.
+     &    x(2) < 0 .or. x(2) > 59 .or.
+     &    x(3) < 0 .or. x(3) > 61) call abort
+      call idate(x)
+      if (x(1) < 1 .or. x(1) > 31 .or.
+     &    x(2) < 1 .or. x(2) > 12 .or.
+     &    x(3) < 2001 .or. x(3) > 2100) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/keyword_symbol_1.f90 b/gcc/testsuite/gfortran.dg/keyword_symbol_1.f90
new file mode 100644
index 000000000..2661897ff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/keyword_symbol_1.f90
@@ -0,0 +1,57 @@
+! { dg-do compile }
+! This tests the fix for PR28526, in which a public interface named
+! 'end' would be treated as a variable because the matcher tried
+! 'END INTERFACE' as an assignment and left the symbol modified in
+! failing. The various pitfalls that were encountered in developing
+! the fix are checked here.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module blahblah
+  public function, end
+
+! The original PR from Yusuke IGUCHI <iguchi@coral.t.u-tokyo.ac.jp>
+  interface end
+    module procedure foo1
+  end interface
+
+! A contribution to the PR from Tobias Schlueter  <tobi@gcc.gnu.org>
+  interface function
+     module procedure foo2 ! { dg-error "is neither function nor" }
+  end interface
+
+  interface function
+     module procedure foo3
+  end interface
+
+  interface
+    function foo4 ()
+      real foo4
+      x = 1.0          ! { dg-error "in INTERFACE" }
+    end function foo4
+  end interface
+
+  interface
+    x = 2.0            ! { dg-error "in INTERFACE block" }
+    function foo5 ()
+      real foo5
+    end function foo5
+  end interface
+
+  x = 3.0              ! { dg-error "in MODULE" }
+
+contains
+
+  subroutine foo1
+  end subroutine foo1
+
+  function foo2        ! { dg-error "Expected formal argument list" }
+    foo2 = 0           ! { dg-error "already been host associated" }
+  end function foo2    ! { dg-error "Expecting END MODULE" }
+
+  function foo3 ()
+    real foo3
+  end function foo3
+
+  x = 4.0              ! { dg-error "in CONTAINS section" }
+end module blahblah
diff --git a/gcc/testsuite/gfortran.dg/kind_tests_2.f03 b/gcc/testsuite/gfortran.dg/kind_tests_2.f03
new file mode 100644
index 000000000..2a0d7c985
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/kind_tests_2.f03
@@ -0,0 +1,9 @@
+! { dg-do compile }
+module kind_tests_2
+  use, intrinsic :: iso_c_binding
+
+  integer, parameter :: myFKind = c_float
+  real(myFKind), bind(c) :: myF
+end module kind_tests_2
+
+! { dg-final { cleanup-modules "kind_tests_2" } }
diff --git a/gcc/testsuite/gfortran.dg/kind_tests_3.f03 b/gcc/testsuite/gfortran.dg/kind_tests_3.f03
new file mode 100644
index 000000000..af041b0f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/kind_tests_3.f03
@@ -0,0 +1,12 @@
+! { dg-do compile }
+module my_kinds
+  use, intrinsic :: iso_c_binding
+  integer, parameter :: myFKind = c_float
+end module my_kinds
+
+module my_module
+  use my_kinds
+  real(myFKind), bind(c) :: myF  
+end module my_module
+
+! { dg-final { cleanup-modules "my_kinds my_module" } }
diff --git a/gcc/testsuite/gfortran.dg/label_1.f90 b/gcc/testsuite/gfortran.dg/label_1.f90
new file mode 100644
index 000000000..b5959dad7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/label_1.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! Test the fix for PR 25106 and 25055.
+
+program a
+0056780 continue    ! { dg-error "Too many digits" }
+0 continue          ! { dg-error "Zero is not a valid statement label" }
+end program a
+
+
diff --git a/gcc/testsuite/gfortran.dg/label_2.f90 b/gcc/testsuite/gfortran.dg/label_2.f90
new file mode 100644
index 000000000..7b87f6c24
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/label_2.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! PR fortran/24640.  We needed to check that whitespace follows
+! a statement label in free form.
+!
+program pr24640
+
+10: a=10   ! { dg-error "character in statement" }
+
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/label_3.f90 b/gcc/testsuite/gfortran.dg/label_3.f90
new file mode 100644
index 000000000..5cebe935b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/label_3.f90
@@ -0,0 +1,5 @@
+! { dg-do compile }
+! PR fortran/25756.
+! This used to ICE due to the space after the label.
+1 ! { dg-warning "Ignoring statement label in empty statement" }
+end
diff --git a/gcc/testsuite/gfortran.dg/label_4.f90 b/gcc/testsuite/gfortran.dg/label_4.f90
new file mode 100644
index 000000000..2a32f31a0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/label_4.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-Wunused-label" }
+! PR 26277
+! We used to give an incorect warning about label 99 not being referenced
+  open(unit=12,err=99)
+99 print *,"could not open file ..."
+98 continue ! { dg-warning "Label 98 .* defined but not used" }
+  close(unit=12,status="delete")
+end
diff --git a/gcc/testsuite/gfortran.dg/label_5.f90 b/gcc/testsuite/gfortran.dg/label_5.f90
new file mode 100644
index 000000000..108246517
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/label_5.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! { dg-options "-Wall" }
+! PR fortran/27553
+program pr27553
+10: a=10   ! { dg-error "character in statement" }
+end program
diff --git a/gcc/testsuite/gfortran.dg/large_integer_kind_1.f90 b/gcc/testsuite/gfortran.dg/large_integer_kind_1.f90
new file mode 100644
index 000000000..2f272db92
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/large_integer_kind_1.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_int }
+
+module testmod
+  integer,parameter :: k = selected_int_kind (range (0_8) + 1)
+contains
+  subroutine testoutput (a,b,length,f)
+    integer(kind=k),intent(in) :: a
+    integer(kind=8),intent(in) ::  b
+    integer,intent(in) :: length
+    character(len=*),intent(in) :: f
+
+    character(len=length) :: ca
+    character(len=length) :: cb
+
+    write (ca,f) a
+    write (cb,f) b
+    if (ca /= cb) call abort
+  end subroutine testoutput
+end module testmod
+
+
+! Testing I/O of large integer kinds (larger than kind=8)
+program test
+  use testmod
+  implicit none
+
+  integer(kind=k) :: x
+  character(len=50) :: c1, c2
+
+  call testoutput (0_k,0_8,50,'(I50)')
+  call testoutput (1_k,1_8,50,'(I50)')
+  call testoutput (-1_k,-1_8,50,'(I50)')
+  x = huge(0_8)
+  call testoutput (x,huge(0_8),50,'(I50)')
+  x = -huge(0_8)
+  call testoutput (x,-huge(0_8),50,'(I50)')
+end program test
+
+! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/large_integer_kind_2.f90 b/gcc/testsuite/gfortran.dg/large_integer_kind_2.f90
new file mode 100644
index 000000000..68e64ab8e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/large_integer_kind_2.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_int }
+
+! Testing library calls on large integer kinds (larger than kind=8)
+  implicit none
+
+  integer,parameter :: k = selected_int_kind (range (0_8) + 1)
+
+  integer(kind=k) :: i, j
+  integer(8) :: a, b
+
+  i = 0; j = 1; a = i; b = j
+  if (i ** j /= a ** b) call abort
+
+end
diff --git a/gcc/testsuite/gfortran.dg/large_real_kind_1.f90 b/gcc/testsuite/gfortran.dg/large_real_kind_1.f90
new file mode 100644
index 000000000..28e406730
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/large_real_kind_1.f90
@@ -0,0 +1,79 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+
+module testmod
+  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+contains
+  subroutine testoutput (a,b,length,f)
+    real(kind=k),intent(in) :: a
+    real(kind=8),intent(in) ::  b
+    integer,intent(in) :: length
+    character(len=*),intent(in) :: f
+
+    character(len=length) :: ca
+    character(len=length) :: cb
+
+    write (ca,f) a
+    write (cb,f) b
+    if (ca /= cb) call abort
+  end subroutine testoutput
+
+  subroutine outputstring (a,f,s)
+    real(kind=k),intent(in) :: a
+    character(len=*),intent(in) :: f
+    character(len=*),intent(in) :: s
+
+    character(len=len(s)) :: c
+    
+    write (c,f) a
+    if (c /= s) call abort
+  end subroutine outputstring
+end module testmod
+
+
+! Testing I/O of large real kinds (larger than kind=8)
+program test
+  use testmod
+  implicit none
+
+  real(kind=k) :: x
+  character(len=20) :: c1, c2
+
+  call testoutput (0.0_k,0.0_8,40,'(F40.35)')
+
+  call testoutput (1.0_k,1.0_8,40,'(F40.35)')
+  call testoutput (0.1_k,0.1_8,15,'(F15.10)')
+  call testoutput (1e10_k,1e10_8,15,'(F15.10)')
+  call testoutput (7.51e100_k,7.51e100_8,15,'(F15.10)')
+  call testoutput (1e-10_k,1e-10_8,15,'(F15.10)')
+  call testoutput (7.51e-100_k,7.51e-100_8,15,'(F15.10)')
+
+  call testoutput (-1.0_k,-1.0_8,40,'(F40.35)')
+  call testoutput (-0.1_k,-0.1_8,15,'(F15.10)')
+  call testoutput (-1e10_k,-1e10_8,15,'(F15.10)')
+  call testoutput (-7.51e100_k,-7.51e100_8,15,'(F15.10)')
+  call testoutput (-1e-10_k,-1e-10_8,15,'(F15.10)')
+  call testoutput (-7.51e-100_k,-7.51e-100_8,15,'(F15.10)')
+
+  x = huge(x)
+  call outputstring (2*x,'(F20.15)','            Infinity')
+  call outputstring (-2*x,'(F20.15)','           -Infinity')
+
+  write (c1,'(G20.10E5)') x
+  write (c2,'(G20.10E5)') -x
+  if (c2(1:1) /= '-') call abort
+  c2(1:1) = ' '
+  if (c1 /= c2) call abort
+
+  x = tiny(x)
+  call outputstring (x,'(F20.15)','   0.000000000000000')
+  call outputstring (-x,'(F20.15)','  -0.000000000000000')
+
+  write (c1,'(G20.10E5)') x
+  write (c2,'(G20.10E5)') -x
+  if (c2(1:1) /= '-') call abort
+  c2(1:1) = ' '
+  if (c1 /= c2) call abort
+end program test
+
+! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/large_real_kind_2.F90 b/gcc/testsuite/gfortran.dg/large_real_kind_2.F90
new file mode 100644
index 000000000..2e3891b2f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/large_real_kind_2.F90
@@ -0,0 +1,105 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+! { dg-xfail-if "" { "*-*-freebsd*" } { "*" }  { "" } }
+
+! Testing library calls on large real kinds (larger than kind=8)
+  implicit none
+
+  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+  real(8),parameter :: eps = 1e-8
+
+  real(kind=k) :: x, x1
+  real(8) :: y, y1
+  complex(kind=k) :: z, z1
+  complex(8) :: w, w1
+
+#define TEST_FUNCTION(func,val) \
+ x = val ;\
+ y = x ;\
+ x = func (x) ;\
+ y = func (y) ;\
+ if (abs((y - x) / y) > eps) call abort
+  
+#define CTEST_FUNCTION(func,valc) \
+ z = valc ;\
+ w = z ;\
+ z = func (z) ;\
+ w = func (w) ;\
+ if (abs((z - w) / w) > eps) call abort
+
+ TEST_FUNCTION(cos,17.456)
+ TEST_FUNCTION(sin,17.456)
+ TEST_FUNCTION(tan,1.456)
+ TEST_FUNCTION(cosh,-2.45)
+ TEST_FUNCTION(sinh,7.1)
+ TEST_FUNCTION(tanh,12.7)
+ TEST_FUNCTION(acos,0.78)
+ TEST_FUNCTION(asin,-0.24)
+ TEST_FUNCTION(atan,-17.123)
+ TEST_FUNCTION(acosh,0.2)
+ TEST_FUNCTION(asinh,0.3)
+ TEST_FUNCTION(atanh,0.4)
+ TEST_FUNCTION(exp,1.74)
+ TEST_FUNCTION(log,0.00178914)
+ TEST_FUNCTION(log10,123789.123)
+ TEST_FUNCTION(sqrt,789.1356)
+
+ CTEST_FUNCTION(cos,(17.456,-1.123))
+ CTEST_FUNCTION(sin,(17.456,-7.6))
+ CTEST_FUNCTION(exp,(1.74,-1.01))
+ CTEST_FUNCTION(log,(0.00178914,-1.207))
+ CTEST_FUNCTION(sqrt,(789.1356,2.4))
+
+#define TEST_POWER(val1,val2) \
+ x = val1 ; \
+ y = x ; \
+ x1 = val2 ; \
+ y1 = x1; \
+ if (abs((x**x1 - y**y1)/(y**y1)) > eps) call abort
+ 
+#define CTEST_POWER(val1,val2) \
+ z = val1 ; \
+ w = z ; \
+ z1 = val2 ; \
+ w1 = z1; \
+ if (abs((z**z1 - w**w1)/(w**w1)) > eps) call abort
+
+ CTEST_POWER (1.0,1.0)
+ CTEST_POWER (1.0,5.4)
+ CTEST_POWER (1.0,-5.4)
+ CTEST_POWER (1.0,0.0)
+ CTEST_POWER (-1.0,1.0)
+ CTEST_POWER (-1.0,5.4)
+ CTEST_POWER (-1.0,-5.4)
+ CTEST_POWER (-1.0,0.0)
+ CTEST_POWER (0.0,1.0)
+ CTEST_POWER (0.0,5.4)
+ CTEST_POWER (0.0,-5.4)
+ CTEST_POWER (0.0,0.0)
+ CTEST_POWER (7.6,1.0)
+ CTEST_POWER (7.6,5.4)
+ CTEST_POWER (7.6,-5.4)
+ CTEST_POWER (7.6,0.0)
+ CTEST_POWER (-7.6,1.0)
+ CTEST_POWER (-7.6,5.4)
+ CTEST_POWER (-7.6,-5.4)
+ CTEST_POWER (-7.6,0.0)
+
+ CTEST_POWER ((10.78,123.213),(14.123,13279.5))
+ CTEST_POWER ((-10.78,123.213),(14.123,13279.5))
+ CTEST_POWER ((10.78,-123.213),(14.123,13279.5))
+ CTEST_POWER ((10.78,123.213),(-14.123,13279.5))
+ CTEST_POWER ((10.78,123.213),(14.123,-13279.5))
+ CTEST_POWER ((-10.78,-123.213),(14.123,13279.5))
+ CTEST_POWER ((-10.78,123.213),(-14.123,13279.5))
+ CTEST_POWER ((-10.78,123.213),(14.123,-13279.5))
+ CTEST_POWER ((10.78,-123.213),(-14.123,13279.5))
+ CTEST_POWER ((10.78,-123.213),(14.123,-13279.5))
+ CTEST_POWER ((10.78,123.213),(-14.123,-13279.5))
+ CTEST_POWER ((-10.78,-123.213),(-14.123,13279.5))
+ CTEST_POWER ((-10.78,-123.213),(14.123,-13279.5))
+ CTEST_POWER ((-10.78,123.213),(-14.123,-13279.5))
+ CTEST_POWER ((10.78,-123.213),(-14.123,-13279.5))
+ CTEST_POWER ((-10.78,-123.213),(-14.123,-13279.5))
+ 
+end
diff --git a/gcc/testsuite/gfortran.dg/large_real_kind_3.F90 b/gcc/testsuite/gfortran.dg/large_real_kind_3.F90
new file mode 100644
index 000000000..0660b497a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/large_real_kind_3.F90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+! { dg-xfail-if "" { "*-*-freebsd*" } { "*" }  { "" } }
+
+! Testing erf and erfc library calls on large real kinds (larger than kind=8)
+  implicit none
+
+  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+  real(8),parameter :: eps = 1e-8
+
+  real(kind=k) :: x
+  real(8) :: y
+
+#define TEST_FUNCTION(func,val) \
+ x = val ;\
+ y = x ;\
+ x = func (x) ;\
+ y = func (y) ;\
+ if (abs((y - x) / y) > eps) call abort
+  
+ TEST_FUNCTION(erf,1.45123231)
+ TEST_FUNCTION(erfc,-0.123789)
+ 
+end
diff --git a/gcc/testsuite/gfortran.dg/large_real_kind_form_io_1.f90 b/gcc/testsuite/gfortran.dg/large_real_kind_form_io_1.f90
new file mode 100644
index 000000000..3e49dc192
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/large_real_kind_form_io_1.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+! PR 24174 and PR 24305
+program large_real_kind_form_io_1
+  ! This should be 10 on systems that support kind=10
+  integer, parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+  real(kind=k) :: a,b(2), c, eps
+  complex(kind=k) :: d, e, f(2), g
+  character(len=200) :: tmp
+  ! Test real(k) scalar and array formatted IO
+  eps = 10 * spacing (2.0_k) ! 10 ulp precision is enough.
+  b(:) = 2.0_k
+  write (tmp, *) b
+  read (tmp, *) a, c
+  if (abs (a - b(1)) > eps) call abort ()
+  if (abs (c - b(2)) > eps) call abort ()
+  ! Complex(k) scalar and array formatted and list formatted IO
+  d = cmplx ( 1.0_k, 2.0_k, k)
+  f = d
+  write (tmp, *) f
+  read (tmp, *) e, g
+  if (abs (e - d) > eps) call abort ()
+  if (abs (g - d) > eps) call abort ()
+  write (tmp, '(2(e12.4e5, 2x))') d
+  read (tmp, '(2(e12.4e5, 2x))') e
+  if (abs (e - d) > eps) call abort()
+end program large_real_kind_form_io_1
diff --git a/gcc/testsuite/gfortran.dg/large_real_kind_form_io_2.f90 b/gcc/testsuite/gfortran.dg/large_real_kind_form_io_2.f90
new file mode 100644
index 000000000..a72c71837
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/large_real_kind_form_io_2.f90
@@ -0,0 +1,35 @@
+! { dg-do run { xfail powerpc*-apple-darwin* powerpc*-*-linux* } }
+! Test XFAILed on these platforms because the system's printf() lacks
+! proper support for denormalized long doubles. See PR24685
+! { dg-require-effective-target fortran_large_real }
+! PR libfortran/24685
+program large_real_kind_form_io_2
+  ! This should be 10 or 16 on systems that support kind=10 or kind=16
+  integer, parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+  real(kind=k) :: a,b(2), c
+  character(len=180) :: tmp
+
+  b(:) = huge(0.0_k)
+  write (tmp, *) b
+  read (tmp, *) a, c
+  if (a /= b(1)) call abort ()
+  if (c /= b(2)) call abort ()
+
+  b(:) = -huge(0.0_k)
+  write (tmp, *) b
+  read (tmp, *) a, c
+  if (a /= b(1)) call abort ()
+  if (c /= b(2)) call abort ()
+
+  b(:) = nearest(tiny(0.0_k),1.0_k)
+  write (tmp, *) b
+  read (tmp, *) a, c
+  if (a /= b(1)) call abort ()
+  if (c /= b(2)) call abort ()
+
+  b(:) = nearest(-tiny(0.0_k),-1.0_k)
+  write (tmp, *) b
+  read (tmp, *) a, c
+  if (a /= b(1)) call abort ()
+  if (c /= b(2)) call abort ()
+end program large_real_kind_form_io_2
diff --git a/gcc/testsuite/gfortran.dg/large_unit_1.f90 b/gcc/testsuite/gfortran.dg/large_unit_1.f90
new file mode 100644
index 000000000..60e2d1f17
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/large_unit_1.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! { dg-shouldfail "Unit number in I/O statement too large" }
+! PR31201  Unit number in I/O statement too large
+! Test case from PR
+      integer(kind=8)  :: k= 2_8**36 + 10
+      integer(kind=4)  :: j= 10
+      logical  ex,op
+      INQUIRE(unit=k, exist=ex,opened=op)
+      print *, ex, op
+      IF (ex) THEN
+         OPEN(unit=k)
+         INQUIRE(unit=j, opened=op)
+         IF (op) CALL ABORT()
+      ENDIF
+      print *, k
+      close(k)
+      end
diff --git a/gcc/testsuite/gfortran.dg/large_unit_2.f90 b/gcc/testsuite/gfortran.dg/large_unit_2.f90
new file mode 100644
index 000000000..5f3554cc5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/large_unit_2.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! PR31201 Too large unit number generates wrong code 
+! Test case by Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+      integer :: i
+      logical :: l
+      character(len=60) :: s
+      open(2_8*huge(0)+20_8,file="foo",iostat=i)
+      if (i == 0) call abort
+      open(2_8*huge(0)+20_8,file="foo",err=99)
+      call abort
+ 99   inquire(unit=18,opened=l)
+      if (l) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/largeequiv_1.f90 b/gcc/testsuite/gfortran.dg/largeequiv_1.f90
new file mode 100644
index 000000000..39b1f8159
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/largeequiv_1.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! PR 20361 : We didn't check if a large equivalence actually fit on
+! the stack, and therefore segfaulted at execution time
+subroutine test
+integer i(1000000), j
+equivalence (i(50), j)
+
+j = 1
+if (i(50) /= j) call abort()
+end subroutine test
+
+call test
+end
diff --git a/gcc/testsuite/gfortran.dg/ldist-1.f90 b/gcc/testsuite/gfortran.dg/ldist-1.f90
new file mode 100644
index 000000000..bbce2f355
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ldist-1.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }     
+! { dg-options "-O2 -ftree-loop-distribution -fdump-tree-ldist-all" }
+
+Subroutine PADEC(DKS,DKDS,HVAR,WM,WG,FN,NS,AN,BN,CN,IT)
+  IMPLICIT REAL*8 (A-H, O-Z)
+  DIMENSION DKS(*),DKDS(*),HVAR(*)
+  COMPLEX*16 WM(*),WG(*),FN(*),AN(*),BN(*),CN(*)
+  COMPLEX*16 H2,CONST
+  COMMON/STRCH/ALP,BET,DH,ZH,UG,VG,T1,T2,DT,TOL,ALPHA ,HAMP,BUMP
+  Parameter (F1 = .8333333333333333D0, F2 = .0833333333333333D0)
+
+  SS=DT/(2.0D0)
+
+  do J=2,NS
+     BS=SS*DKS(J)*HVAR(J)*HVAR(J)
+     AN(J)=F1+2.*BS
+     BN(J)=F2-BS
+     CN(J)=F2-BS
+     H2=WM(J+1)
+
+     if(J.EQ.NS) then
+        CONST=CN(J)*H2
+     else
+        CONST=(0.D0,0.D0)
+     endif
+     FN(J)=(BS+F2)*(H2)+(F1-2.D0*BS)-CONST
+  end do
+
+  return
+end Subroutine PADEC
+
+! There are 5 legal partitions in this code.  Based on the data
+! locality heuristic, this loop should not be split.
+
+! { dg-final { scan-tree-dump-not "distributed: split to" "ldist" } }
+! { dg-final { cleanup-tree-dump "ldist" } }
diff --git a/gcc/testsuite/gfortran.dg/ldist-pr43023.f90 b/gcc/testsuite/gfortran.dg/ldist-pr43023.f90
new file mode 100644
index 000000000..3e2d04c94
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ldist-pr43023.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-options "-O2 -ftree-loop-distribution" }
+
+MODULE NFT_mod
+
+implicit none
+integer :: Nangle
+real:: Z0
+real, dimension(:,:), allocatable :: Angle
+real, dimension(:), allocatable :: exth, ezth, hxth, hyth, hyphi
+
+CONTAINS
+
+SUBROUTINE NFT_Init()
+
+real :: th, fi
+integer :: n
+
+do n = 1,Nangle
+  th = Angle(n,1)
+  fi = Angle(n,2)
+
+  exth(n) =  cos(fi)*cos(th)
+  ezth(n) = -sin(th)
+  hxth(n) = -sin(fi)
+  hyth(n) =  cos(fi)
+  hyphi(n) = -sin(fi)
+end do
+END SUBROUTINE NFT_Init
+
+END MODULE NFT_mod
diff --git a/gcc/testsuite/gfortran.dg/ldist-pr45199.f b/gcc/testsuite/gfortran.dg/ldist-pr45199.f
new file mode 100644
index 000000000..6f65501a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ldist-pr45199.f
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-O3 -fdump-tree-ldist-details" }
+
+      parameter(numlev=3,numoblev=1000)
+      integer i_otyp(numoblev,numlev), i_styp(numoblev,numlev)
+      logical l_numob(numoblev,numlev)
+      do ixe=1,numoblev
+         do iye=1,numlev
+            i_otyp(ixe,iye)=0
+            i_styp(ixe,iye)=0
+            l_numob(ixe,iye)=.false.
+         enddo
+      enddo
+      do i=1,m
+         do j=1,n
+            if (l_numob(i,j)) then
+               write(20,'(7I4,F12.2,4F16.10)') i_otyp(i,j),i_styp(i,j)
+            endif
+         enddo
+      enddo
+      end
+
+! GCC should apply memset zero loop distribution and it should not ICE.
+
+! { dg-final { scan-tree-dump "distributed: split to 9 loops" "ldist" } }
+! { dg-final { scan-tree-dump-times "__builtin_memset" 18 "ldist" } }
+! { dg-final { cleanup-tree-dump "ldist" } }
diff --git a/gcc/testsuite/gfortran.dg/leadz_trailz_1.f90 b/gcc/testsuite/gfortran.dg/leadz_trailz_1.f90
new file mode 100644
index 000000000..a0cd19792
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/leadz_trailz_1.f90
@@ -0,0 +1,133 @@
+! { dg-do run }
+
+  integer(kind=1) :: i1
+  integer(kind=2) :: i2
+  integer(kind=4) :: i4
+  integer(kind=8) :: i8
+
+  i1 = -1
+  i2 = -1
+  i4 = -1
+  i8 = -1
+
+  if (leadz(i1) /= 0) call abort
+  if (leadz(i2) /= 0) call abort
+  if (leadz(i4) /= 0) call abort
+  if (leadz(i8) /= 0) call abort
+
+  if (trailz(i1) /= 0) call abort
+  if (trailz(i2) /= 0) call abort
+  if (trailz(i4) /= 0) call abort
+  if (trailz(i8) /= 0) call abort
+
+  if (leadz(-1_1) /= 0) call abort
+  if (leadz(-1_2) /= 0) call abort
+  if (leadz(-1_4) /= 0) call abort
+  if (leadz(-1_8) /= 0) call abort
+
+  if (trailz(-1_1) /= 0) call abort
+  if (trailz(-1_2) /= 0) call abort
+  if (trailz(-1_4) /= 0) call abort
+  if (trailz(-1_8) /= 0) call abort
+
+  i1 = -64
+  i2 = -64
+  i4 = -64
+  i8 = -64
+
+  if (leadz(i1) /= 0) call abort
+  if (leadz(i2) /= 0) call abort
+  if (leadz(i4) /= 0) call abort
+  if (leadz(i8) /= 0) call abort
+
+  if (trailz(i1) /= 6) call abort
+  if (trailz(i2) /= 6) call abort
+  if (trailz(i4) /= 6) call abort
+  if (trailz(i8) /= 6) call abort
+
+  if (leadz(-64_1) /= 0) call abort
+  if (leadz(-64_2) /= 0) call abort
+  if (leadz(-64_4) /= 0) call abort
+  if (leadz(-64_8) /= 0) call abort
+
+  if (trailz(-64_1) /= 6) call abort
+  if (trailz(-64_2) /= 6) call abort
+  if (trailz(-64_4) /= 6) call abort
+  if (trailz(-64_8) /= 6) call abort
+
+  i1 = -108
+  i2 = -108
+  i4 = -108
+  i8 = -108
+
+  if (leadz(i1) /= 0) call abort
+  if (leadz(i2) /= 0) call abort
+  if (leadz(i4) /= 0) call abort
+  if (leadz(i8) /= 0) call abort
+
+  if (trailz(i1) /= 2) call abort
+  if (trailz(i2) /= 2) call abort
+  if (trailz(i4) /= 2) call abort
+  if (trailz(i8) /= 2) call abort
+
+  if (leadz(-108_1) /= 0) call abort
+  if (leadz(-108_2) /= 0) call abort
+  if (leadz(-108_4) /= 0) call abort
+  if (leadz(-108_8) /= 0) call abort
+
+  if (trailz(-108_1) /= 2) call abort
+  if (trailz(-108_2) /= 2) call abort
+  if (trailz(-108_4) /= 2) call abort
+  if (trailz(-108_8) /= 2) call abort
+
+  i1 = 1
+  i2 = 1
+  i4 = 1
+  i8 = 1
+
+  if (leadz(i1) /= bit_size(i1) - 1) call abort
+  if (leadz(i2) /= bit_size(i2) - 1) call abort
+  if (leadz(i4) /= bit_size(i4) - 1) call abort
+  if (leadz(i8) /= bit_size(i8) - 1) call abort
+
+  if (trailz(i1) /= 0) call abort
+  if (trailz(i2) /= 0) call abort
+  if (trailz(i4) /= 0) call abort
+  if (trailz(i8) /= 0) call abort
+
+  if (leadz(1_1) /= bit_size(1_1) - 1) call abort
+  if (leadz(1_2) /= bit_size(1_2) - 1) call abort
+  if (leadz(1_4) /= bit_size(1_4) - 1) call abort
+  if (leadz(1_8) /= bit_size(1_8) - 1) call abort
+
+  if (trailz(1_1) /= 0) call abort
+  if (trailz(1_2) /= 0) call abort
+  if (trailz(1_4) /= 0) call abort
+  if (trailz(1_8) /= 0) call abort
+
+  i1 = 64
+  i2 = 64
+  i4 = 64
+  i8 = 64
+
+  if (leadz(i1) /= 1) call abort
+  if (leadz(i2) /= 9) call abort
+  if (leadz(i4) /= 25) call abort
+  if (leadz(i8) /= 57) call abort
+
+  if (trailz(i1) /= 6) call abort
+  if (trailz(i2) /= 6) call abort
+  if (trailz(i4) /= 6) call abort
+  if (trailz(i8) /= 6) call abort
+
+  if (leadz(64_1) /= 1) call abort
+  if (leadz(64_2) /= 9) call abort
+  if (leadz(64_4) /= 25) call abort
+  if (leadz(64_8) /= 57) call abort
+
+  if (trailz(64_1) /= 6) call abort
+  if (trailz(64_2) /= 6) call abort
+  if (trailz(64_4) /= 6) call abort
+  if (trailz(64_8) /= 6) call abort
+
+end
diff --git a/gcc/testsuite/gfortran.dg/leadz_trailz_2.f90 b/gcc/testsuite/gfortran.dg/leadz_trailz_2.f90
new file mode 100644
index 000000000..08701d8a5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/leadz_trailz_2.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_int }
+
+  integer(kind=16) :: i16
+
+  i16 = -1
+  if (leadz(i16) /= 0) call abort
+  if (trailz(i16) /= 0) call abort
+  if (leadz(-1_16) /= 0) call abort
+  if (trailz(-1_16) /= 0) call abort
+
+  i16 = -64
+  if (leadz(i16) /= 0) call abort
+  if (trailz(i16) /= 6) call abort
+  if (leadz(-64_16) /= 0) call abort
+  if (trailz(-64_16) /= 6) call abort
+
+  i16 = -108
+  if (leadz(i16) /= 0) call abort
+  if (trailz(i16) /= 2) call abort
+  if (leadz(-108_16) /= 0) call abort
+  if (trailz(-108_16) /= 2) call abort
+
+  i16 = 1
+  if (leadz(i16) /= bit_size(i16) - 1) call abort
+  if (trailz(i16) /= 0) call abort
+  if (leadz(1_16) /= bit_size(1_16) - 1) call abort
+  if (trailz(1_16) /= 0) call abort
+
+  i16 = 64
+  if (leadz(i16) /= 121) call abort
+  if (trailz(i16) /= 6) call abort
+  if (leadz(64_16) /= 121) call abort
+  if (trailz(64_16) /= 6) call abort
+
+end
diff --git a/gcc/testsuite/gfortran.dg/leadz_trailz_3.f90 b/gcc/testsuite/gfortran.dg/leadz_trailz_3.f90
new file mode 100644
index 000000000..b54a11f63
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/leadz_trailz_3.f90
@@ -0,0 +1,30 @@
+! We want to check that ISHFT evaluates its arguments only once
+!
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+
+program test
+
+  if (leadz (foo()) /= bit_size(0) - 1) call abort
+  if (leadz (foo()) /= bit_size(0) - 2) call abort
+  if (trailz (foo()) /= 0) call abort
+  if (trailz (foo()) /= 2) call abort
+  if (trailz (foo()) /= 0) call abort
+  if (trailz (foo()) /= 1) call abort
+
+contains
+  
+  integer function foo ()
+    integer, save :: i = 0
+    i = i + 1
+    foo = i
+  end function
+
+end program
+
+! The regexp "foo ()" should be seen once in the dump:
+!   -- once in the function definition itself
+!   -- plus as many times as the function is called
+!
+! { dg-final { scan-tree-dump-times "foo *\\\(\\\)" 7 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/line_length_1.f b/gcc/testsuite/gfortran.dg/line_length_1.f
new file mode 100644
index 000000000..1ac80338d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/line_length_1.f
@@ -0,0 +1,7 @@
+! Testcase for -ffixed-line-length-none
+! { dg-do compile }
+! { dg-options "-ffixed-line-length-none" }
+      program one
+       if (abs(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa).gt.999.d0.or.abs(bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb).gt.999.d0.or.abs(cccccccccccccccccccc).gt.999.d0) THEN
+       endif
+      end program one
diff --git a/gcc/testsuite/gfortran.dg/line_length_2.f90 b/gcc/testsuite/gfortran.dg/line_length_2.f90
new file mode 100644
index 000000000..e1ab7220d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/line_length_2.f90
@@ -0,0 +1,8 @@
+! Testcase for -ffree-line-length-none
+! See PR fortran/21302
+! { dg-do compile }
+! { dg-options "-ffree-line-length-none" }
+program two
+ if (abs(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa).gt.999.d0.or.abs(bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb).gt.999.d0.or.abs(cccccccccccccccccccc).gt.999.d0) THEN
+ endif
+end program two
diff --git a/gcc/testsuite/gfortran.dg/line_length_3.f b/gcc/testsuite/gfortran.dg/line_length_3.f
new file mode 100644
index 000000000..653246a1f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/line_length_3.f
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-std=gnu -ffixed-form -Wline-truncation" }
+! PR39229 No warning of truncated lines if a continuation line follows 
+      ! expected: no warning by default (as column 73+ is often used for )
+      ! comments in fixed-form source code.
+      ! however, with -wline-truncation there shall be a warning.
+      implicit none
+        call foo([11, 22, 33, 44, 55, 66, 770, 9900, 1100, 1100, 120], 12 warn
+     &          , 'hello')
+      print *, min(35 
+     1                                        ,                        25 warn
+     2  )
+      contains
+      subroutine foo(a,n,s)
+        integer :: a(*), n, i
+        character(len=*) :: s
+        do i = 1, n
+          print *, s, a(i)
+        end do
+      end subroutine foo
+      end
+! { dg-warning "Line truncated" " " { target *-*-* } 8 }
+! { dg-warning "Line truncated" " " { target *-*-* } 11 }
diff --git a/gcc/testsuite/gfortran.dg/line_length_4.f90 b/gcc/testsuite/gfortran.dg/line_length_4.f90
new file mode 100644
index 000000000..52bba1c87
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/line_length_4.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-Wline-truncation -ffree-line-length-80" }
+! PR39229 No warning of truncated lines if a continuation line follows 
+  implicit none
+  call foo([11, 22, 33, 44, 55, 66, 770, 9900, 1100, 1100, 120],11,'hello') !no warn
+
+  print *, min(35 &
+   &  ,                        25  ), " Explanation ! "                         warn
+  contains
+   subroutine foo(a,n,s)
+     integer :: a(*), n, i
+     character(len=*) :: s
+     do i = 1, n
+       print *, s, a(i)
+     end do
+   end subroutine foo
+  end
+! { dg-warning "Line truncated" " " { target *-*-* } 8 }
diff --git a/gcc/testsuite/gfortran.dg/linked_list_1.f90 b/gcc/testsuite/gfortran.dg/linked_list_1.f90
new file mode 100644
index 000000000..8066bcb39
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/linked_list_1.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! Regression. ICE on valid code.
+! The following worked with 4.1.3 and 4.2.2, but failed
+! (segmentation fault) with 4.3.0 because the type comparison
+! tried to comparethe types of the components of type(node), even
+! though the only component is of type(node).
+!
+! Found using the Fortran Company Fortran 90 Test Suite (Lite),
+! Version 1.4
+!
+! Reported by Tobias Burnus <burnus@gcc.gnu.org>
+!
+program error
+  implicit none
+  type node
+    sequence
+    type(node), pointer :: next
+  end type
+  type(node), pointer :: list
+
+  interface
+    subroutine insert(ptr)
+      implicit none
+      type node
+        sequence
+        type(node), pointer :: next
+      end type
+      type(node), pointer :: ptr
+    end subroutine insert
+  end interface
+  allocate (list);
+end program error
diff --git a/gcc/testsuite/gfortran.dg/list_read_1.f90 b/gcc/testsuite/gfortran.dg/list_read_1.f90
new file mode 100644
index 000000000..6fba90ae7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/list_read_1.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! Program to test terminators in list-directed input
+program list_read_1
+  character(len=5) :: s
+
+  open (unit=11, status="SCRATCH")
+  ! The / terminator was causing the next value to be skipped.
+  write (11, '(a)') " 42 /"
+  write (11, '(a)') " 43"
+  write (11, '(a)') " 44"
+
+  rewind(11)
+
+  read (11, *) i
+  if (i .ne. 42) call abort
+  read (11, *) i
+  if (i .ne. 43) call abort
+  read (11, *) i
+  if (i .ne. 44) call abort
+  close (11)
+end
+
diff --git a/gcc/testsuite/gfortran.dg/list_read_10.f90 b/gcc/testsuite/gfortran.dg/list_read_10.f90
new file mode 100644
index 000000000..1ad3304d5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/list_read_10.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! PR 42422 - read with a repeat specifyer following a separator
+program main
+  integer, dimension(10) :: i1, i2
+
+  i1 = 0
+  i2 = (/ 1, 2, 3, 5, 5, 5, 5, 0, 0, 0 /)
+  open (10,file="pr42422.dat")
+  write (10,'(A)') ' 1 2 3 4*5 /'
+  rewind 10
+  read (10,*) i1
+  if (any(i1 /= i2)) call abort
+  close (10,status="delete")
+end program main
diff --git a/gcc/testsuite/gfortran.dg/list_read_2.f90 b/gcc/testsuite/gfortran.dg/list_read_2.f90
new file mode 100644
index 000000000..3e6c233c0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/list_read_2.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR16805
+! Test list directed reads from character substrings
+! The IO library was reporting an error rather the end-of-record when it
+! got to the end of an internal file record.
+program list_read_2
+  implicit none
+  character*10 a
+  data a /'1234567890'/
+  integer i
+  logical debug
+  data debug /.TRUE./
+  read(a,*)i
+  if (i.ne.1234567890) call abort
+  read(a(1:1),*)i
+  if (i.ne.1) call abort
+  read(a(2:2),*)i
+  if (i.ne.2) call abort
+  read(a(1:5),*)i
+  if (i.ne.12345) call abort
+  read(a(5:10),*)i
+  if (i.ne.567890) call abort
+  read(a(10:10),*)i
+  if (i.ne.0) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/list_read_3.f90 b/gcc/testsuite/gfortran.dg/list_read_3.f90
new file mode 100644
index 000000000..908139a41
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/list_read_3.f90
@@ -0,0 +1,101 @@
+! { dg-do run }
+! Program to test reading in a list of integer values into REAL variables.
+! The comma separator was not handled correctly.
+!
+program fg
+
+  character(len=80) buff
+  logical debug
+
+  debug = .FALSE.
+  a = 0
+  b = 0
+  c = 0
+  d = 0
+  write (buff,'(a)') '10,20,30,40'
+  read(buff,*) a, b, c, d
+
+  if (debug) then
+    print*,buff
+    print*,a, b, c, d
+  end if
+
+  if (abs(10. - a) > 1e-5) call abort
+  if (abs(20. - b) > 1e-5) call abort
+  if (abs(30. - c) > 1e-5) call abort
+  if (abs(40. - d) > 1e-5) call abort
+
+  a = 0
+  b = 0
+  c = 0
+  d = 0
+  write (buff,'(a)') '10.,20.,30.,40.'
+  read(buff,*) a, b, c, d
+
+  if (abs(10. - a) > 1e-5) call abort
+  if (abs(20. - b) > 1e-5) call abort
+  if (abs(30. - c) > 1e-5) call abort
+  if (abs(40. - d) > 1e-5) call abort
+
+  if (debug) then
+    print*,buff
+    print*,a, b, c, d
+  end if 
+
+  a = 0
+  b = 0
+  c = 0
+  d = 0
+  write (buff,'(a)') '10.0,20.0,30.0,40.0'
+  read(buff,*) a, b, c, d
+                                                                                
+  if (abs(10. - a) > 1e-5) call abort
+  if (abs(20. - b) > 1e-5) call abort
+  if (abs(30. - c) > 1e-5) call abort
+  if (abs(40. - d) > 1e-5) call abort
+
+  if (debug) then 
+    print*,buff
+    print*,a, b, c, d
+  end if
+                                                                              
+
+  a = 0
+  b = -99 
+  c = 0
+  d = 0
+  write (buff,'(a)') '10.0,,30.0,40.0'
+  read(buff,*) a, b, c, d
+                                                                                
+  if (abs(10. - a) > 1e-5) call abort
+  if (abs(-99. - b) > 1e-5) call abort
+  if (abs(30. - c) > 1e-5) call abort
+  if (abs(40. - d) > 1e-5) call abort
+
+  if (debug) then
+    print*,buff
+    print*,a, b, c, d
+  end if
+                                                                                
+
+   call abc
+
+end program
+
+subroutine abc
+
+  character(len=80) buff
+
+  a = 0
+  b = 0
+  c = 0
+  d = 0
+  write (buff,'(a)') '10,-20,30,-40'
+  read(buff,*) a, b, c, d
+
+  if (abs(10. - a) > 1e-5) call abort
+  if (abs(-20. - b) > 1e-5) call abort
+  if (abs(30. - c) > 1e-5) call abort
+  if (abs(-40. - d) > 1e-5) call abort
+
+end subroutine abc
diff --git a/gcc/testsuite/gfortran.dg/list_read_4.f90 b/gcc/testsuite/gfortran.dg/list_read_4.f90
new file mode 100644
index 000000000..fb1770e23
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/list_read_4.f90
@@ -0,0 +1,54 @@
+! { dg-do run }
+! Test of gfortran list directed read> check delimiters are correctly
+! treated.  Written in f77 so that g77 will run for comparison.
+!
+! f , e and i edit reads are terminated separately by read_real.c
+!
+! PThomas                                                   Jan 2005
+! BDavis        
+      program list_read_4
+      integer i(10),l(10),k,j 
+      real x(10),y(10)
+! expected results
+      data y / 1.0,2.0,3.0,-1.0,-1.0,-1.0,4.0,4.0,99.0,99.0 /
+      data l /1,2,3,-1,-1,-1,4,4,99,99/
+! put them in a file
+      open (10,status="scratch")
+      write (10,*) " 1.0, 2.0 , 3.0,, 2* , 2*4.0 , 5*99.0"
+      write (10,*) " 1.0e0, 2.0e0 , 3.0e0,, 2* , 2*4.0e0 , 5*99.0e0"
+      write (10,*) " 1,   2 ,   3,,   2* , 2*4 ,   5*99"
+      write (10,*) " 1,   2 ,   3,,   2* , 2*4 ,   5*99"
+      rewind (10)
+!
+      do k = 1,10
+        x(k) = -1.0
+      enddo
+      read (10,*,iostat=ier) x
+      if (ier.ne.0) call abort
+      do k = 1,10
+         if (x(k).ne.y(k)) call abort
+         x(k) = -1
+      end do
+      READ(10,*,iostat=ier) x
+      if (ier.ne.0) call abort
+      do k = 1,10
+         if (x(k).ne.y(k)) call abort
+         x(k) = -1
+      end do
+      READ(10,*,iostat=ier) x
+      if (ier.ne.0) call abort
+      do k = 1,10
+         if (x(k).ne.y(k)) call abort
+         x(k) = -1
+      end do
+! integer
+      do k = 1,10
+        i(k) = -1
+      end do 
+      READ(10,*,iostat=ier) (i(j),j=1,10)
+      if (ier.ne.0) call abort
+      do k = 1,10
+         if (i(k).ne.y(k)) call abort
+         i(k) = -1
+      end do
+      end
diff --git a/gcc/testsuite/gfortran.dg/list_read_5.f90 b/gcc/testsuite/gfortran.dg/list_read_5.f90
new file mode 100644
index 000000000..14b0d1648
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/list_read_5.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! PR25307 Check handling of end-of-file conditions for list directed reads.
+! Prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program pr25307
+   character(len=10) :: str
+   character(len=10) :: a(5)
+   a=""
+   a(1)="123"
+   a(3)="234"
+   str = '123'
+! Check internal unit
+   i = 0
+   j = 0
+   read( str, *, end=10 ) i,j
+   call abort()
+10 continue
+   if (i.ne.123) call abort()
+   if (j.ne.0) call abort()
+! Check file unit
+   i = 0
+   open(10, status="scratch")
+   write(10,'(a)') "123"
+   rewind(10)
+   read(10, *, end=20) i,j
+   call abort()
+20 continue
+   if (i.ne.123) call abort()
+   if (j.ne.0) call abort()
+! Check internal array unit
+   i = 0
+   j = 0
+   k = 0
+   read(a(1:5:2),*, end=30)i,j,k
+   call abort()
+30 continue
+   if (i.ne.123) call abort()
+   if (j.ne.234) call abort()
+   if (k.ne.0) call abort()
+end program pr25307
diff --git a/gcc/testsuite/gfortran.dg/list_read_6.f90 b/gcc/testsuite/gfortran.dg/list_read_6.f90
new file mode 100644
index 000000000..296d94ca8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/list_read_6.f90
@@ -0,0 +1,42 @@
+! { dg-do run { target fd_truncate } }
+! PR30435 Slash at end of input not recognized according to standard.
+! Test case from PR by Steve Kargl.
+
+program t
+  integer a, b, c, d
+  ! This worked as expected
+  open(unit=10, file='tmp.dat')
+  write(10,*) '1 2 3 / 4'
+  rewind(10)
+  a = -1; b = -1; c = -1; d = -1;
+  read(10,*) a,b,c,d
+  if (d.ne.-1) call abort()
+  
+  ! This worked as expected
+  rewind(10)
+  write(10,*) '1 2 3 /'
+  rewind(10)
+  a = -2; b = -2; c = -2; d = -2;
+  read(10,*) a,b,c,d
+  if (d.ne.-2) call abort()
+
+  ! This worked as expected.
+  rewind(10)
+  write(10,*) '1 2'
+  write(10,*) '3 /'
+  rewind(10)
+  a = -3; b = -3; c = -3; d = -3;
+  read(10,*) a,b,c,d
+  if (d.ne.-3) call abort()
+
+  ! This failed before the patch.
+  rewind(10)
+  write(10,*) '1 2 3'
+  write(10,*) '/'
+  rewind(10)
+  a = -4; b = -4; c = -4; d = -4;
+  read(10,*) a,b,c,d
+  if (d.ne.-4) call abort()
+
+  close(unit=10, status='delete')
+end program t
diff --git a/gcc/testsuite/gfortran.dg/list_read_7.f90 b/gcc/testsuite/gfortran.dg/list_read_7.f90
new file mode 100644
index 000000000..4ee08354b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/list_read_7.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR33400 Formatted read fails if line ends without line break
+! Test case modified from that in PR by <jvdelisle@gcc.gnu.org>
+integer, parameter :: fgsl_strmax = 128
+character(len=fgsl_strmax) :: ieee_str1, ieee_str2
+open(unit=20, file='test.dat',form='FORMATTED', status="replace")
+write(20,'(a)',advance="no") ' 1.01010101010101010101010101010101&
+       &01010101010101010101*2^-2 1.01010101010101010101011*2^-2'
+rewind(20)
+read(20, fmt=*) ieee_str1, ieee_str2
+if (trim(ieee_str1) /= &
+    '1.0101010101010101010101010101010101010101010101010101*2^-2') &
+  call abort
+if (trim(ieee_str2) /= &
+     '1.01010101010101010101011*2^-2') &
+  call abort
+close(20, status="delete")
+end
diff --git a/gcc/testsuite/gfortran.dg/list_read_8.f90 b/gcc/testsuite/gfortran.dg/list_read_8.f90
new file mode 100644
index 000000000..4be75fdb4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/list_read_8.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! PR34676 IO error delayed
+! Test case from PR modified by <jvdelisle@gcc.gnu.org>
+implicit none
+integer::i,badness
+character::c
+open(unit=10,status="scratch")
+write(10,'(a)') '1'
+write(10,'(a)') '2'
+write(10,'(a)') '3'
+rewind(10)
+do i=1,10
+  read(10,*,iostat=badness)
+  if (badness/=0) exit
+enddo
+if (i /= 4) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/list_read_9.f90 b/gcc/testsuite/gfortran.dg/list_read_9.f90
new file mode 100644
index 000000000..dac0dc8cd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/list_read_9.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! pr37083 formatted read of line without trailing new-line fails
+real :: a, b, c
+open(unit=10,file="atest",access='stream',form='unformatted',&
+     & status="replace")
+write(10) '1.2'//achar(10)//'2.2'//achar(10)//'3.'
+call fputc(10,'3')
+close(10, status="keep")
+open(unit=10,file="atest",form='formatted',status="old")
+read(10,*) a, b, c
+if (a.ne.1.2 .or. b.ne.2.2 .or. c.ne.3.3) call abort
+close(10, status="delete")
+end
diff --git a/gcc/testsuite/gfortran.dg/literal_character_constant_1.inc b/gcc/testsuite/gfortran.dg/literal_character_constant_1.inc
new file mode 100644
index 000000000..ba24966b7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/literal_character_constant_1.inc
@@ -0,0 +1,20 @@
+C     fixed-form literal character constant with continuation line padding test
+C     PR fortran/25486
+      program a
+      character(len=90) c
+      character(90) :: fil
+c A tab is between 8 and 9.
+      c = '1234567
+     &8	9'
+      write(fil,'(a)') c
+#ifdef LL_NONE
+      if(fil.ne. "12345678	9")
+     &  call abort
+#else
+      if(fil.ne.
+     &"1234567                                                      8	9"
+     &)
+     &  call abort
+#endif
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/literal_character_constant_1_x.F b/gcc/testsuite/gfortran.dg/literal_character_constant_1_x.F
new file mode 100644
index 000000000..ceb2bd98d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/literal_character_constant_1_x.F
@@ -0,0 +1,5 @@
+! { dg-do run }
+C     fixed-form literal character constant with continuation line padding test
+C     PR fortran/25486
+! { dg-options "" }
+#include "literal_character_constant_1.inc"
diff --git a/gcc/testsuite/gfortran.dg/literal_character_constant_1_y.F b/gcc/testsuite/gfortran.dg/literal_character_constant_1_y.F
new file mode 100644
index 000000000..015d1d8d1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/literal_character_constant_1_y.F
@@ -0,0 +1,5 @@
+! { dg-do run }
+C     fixed-form literal character constant with continuation line padding test
+C     PR fortran/25486
+! { dg-options "-ffixed-line-length-72" }
+#include "literal_character_constant_1.inc"
diff --git a/gcc/testsuite/gfortran.dg/literal_character_constant_1_z.F b/gcc/testsuite/gfortran.dg/literal_character_constant_1_z.F
new file mode 100644
index 000000000..3f2ac2a42
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/literal_character_constant_1_z.F
@@ -0,0 +1,5 @@
+! { dg-do run }
+C     fixed-form literal character constant with continuation line padding test
+C     PR fortran/25486
+! { dg-options "-ffixed-line-length-none -DLL_NONE" }
+#include "literal_character_constant_1.inc"
diff --git a/gcc/testsuite/gfortran.dg/loc_1.f90 b/gcc/testsuite/gfortran.dg/loc_1.f90
new file mode 100644
index 000000000..2c070dfb1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/loc_1.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+
+! This test is here to prevent a regression in gfc_conv_intrinsic_loc.
+! Taking the loc of something in a common block was a special case
+! that caused in internal compiler error in gcc/expr.c, in
+! expand_expr_addr_expr_1().
+program test
+  common /targ/targ
+  integer targ(10)
+  call fn
+end program test
+
+subroutine fn
+  common /targ/targ
+  integer targ(10)
+  call foo (loc (targ)) ! Line that caused ICE
+end subroutine fn
+
+subroutine foo (ii)
+  use iso_c_binding, only: c_intptr_t
+  common /targ/targ
+  integer targ(10)
+  integer(c_intptr_t) ii
+  targ(2) = ii
+end subroutine foo
+
diff --git a/gcc/testsuite/gfortran.dg/loc_2.f90 b/gcc/testsuite/gfortran.dg/loc_2.f90
new file mode 100644
index 000000000..d905fc0f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/loc_2.f90
@@ -0,0 +1,115 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! Series of routines for testing a loc() implementation
+program test
+  common /errors/errors(12)
+  integer i
+  logical errors
+  errors = .false.
+  call testloc
+  do i=1,12
+     if (errors(i)) then
+        call abort()
+     endif
+  end do
+end program test
+
+! Test loc
+subroutine testloc
+  common /errors/errors(12)
+  logical errors
+  integer, parameter :: n = 9
+  integer, parameter :: m = 10
+  integer, parameter :: o = 11
+  integer :: offset
+  integer :: i,j,k,intsize,realsize,dblsize,chsize,ch8size
+  integer itarg1 (n)
+  integer itarg2 (m,n)
+  integer itarg3 (o,m,n)
+  real rtarg1(n)
+  real rtarg2(m,n)
+  real rtarg3(o,m,n)
+  character chtarg1(n)
+  character chtarg2(m,n)
+  character chtarg3(o,m,n)
+  character*8 ch8targ1(n)
+  character*8 ch8targ2(m,n)
+  character*8 ch8targ3(o,m,n)
+
+  intsize = kind(itarg1(1))
+  realsize = kind(rtarg1(1))
+  chsize = kind(chtarg1(1))*len(chtarg1(1))
+  ch8size = kind(ch8targ1(1))*len(ch8targ1(1))
+
+  do, i=1,n
+     offset = i-1
+     if (loc(itarg1).ne.loc(itarg1(i))-offset*intsize) then
+        ! Error #1
+        errors(1) = .true.
+     end if
+     if (loc(rtarg1).ne.loc(rtarg1(i))-offset*realsize) then
+        ! Error #2
+        errors(2) = .true.
+     end if
+     if (loc(chtarg1).ne.loc(chtarg1(i))-offset*chsize) then
+        ! Error #3
+        errors(3) = .true.
+     end if
+     if (loc(ch8targ1).ne.loc(ch8targ1(i))-offset*ch8size) then
+        ! Error #4
+        errors(4) = .true.
+     end if
+
+     do, j=1,m
+        offset = (j-1)+m*(i-1)
+        if (loc(itarg2).ne. &
+             loc(itarg2(j,i))-offset*intsize) then
+           ! Error #5
+           errors(5) = .true.
+        end if
+        if (loc(rtarg2).ne. &
+             loc(rtarg2(j,i))-offset*realsize) then
+           ! Error #6
+           errors(6) = .true.
+        end if
+        if (loc(chtarg2).ne. &
+             loc(chtarg2(j,i))-offset*chsize) then
+           ! Error #7
+           errors(7) = .true.
+        end if
+        if (loc(ch8targ2).ne. &
+             loc(ch8targ2(j,i))-offset*ch8size) then
+           ! Error #8
+           errors(8) = .true.
+        end if
+
+        do k=1,o
+           offset = (k-1)+o*(j-1)+o*m*(i-1)
+           if (loc(itarg3).ne. &
+                loc(itarg3(k,j,i))-offset*intsize) then
+              ! Error #9
+              errors(9) = .true.
+           end if
+           if (loc(rtarg3).ne. &
+                loc(rtarg3(k,j,i))-offset*realsize) then
+              ! Error #10
+              errors(10) = .true.
+           end if
+           if (loc(chtarg3).ne. &
+                loc(chtarg3(k,j,i))-offset*chsize) then
+              ! Error #11
+              errors(11) = .true.
+           end if
+           if (loc(ch8targ3).ne. &
+                loc(ch8targ3(k,j,i))-offset*ch8size) then
+              ! Error #12
+              errors(12) = .true.
+           end if
+
+        end do
+     end do
+  end do
+
+end subroutine testloc
+
diff --git a/gcc/testsuite/gfortran.dg/logical_1.f90 b/gcc/testsuite/gfortran.dg/logical_1.f90
new file mode 100644
index 000000000..69d9e6a43
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/logical_1.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR middle-end/19543
+program logical_1
+  implicit none
+  logical(1), parameter :: t1 = .TRUE., f1 = .FALSE.
+  logical(2), parameter :: t2 = .TRUE., f2 = .FALSE.
+  logical(4), parameter :: t4 = .TRUE., f4 = .FALSE.
+  logical(8), parameter :: t8 = .TRUE., f8 = .FALSE.
+  character*2 :: t(4), f(4)
+
+  write(t(1),*) t1
+  write(f(1),*) f1
+  write(t(2),*) t2
+  write(f(2),*) f2
+  write(t(3),*) t4
+  write(f(3),*) f4
+  write(t(4),*) t8
+  write(f(4),*) f8
+
+  if (any(t .ne. " T")) call abort
+  if (any(f .ne. " F")) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/logical_2.f90 b/gcc/testsuite/gfortran.dg/logical_2.f90
new file mode 100644
index 000000000..1a28fefd5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/logical_2.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! PR fortran/30799
+! Inconsistent handling of bad (invalid) LOGICAL kinds
+! Reporter: Harald Anlauf <anlauf@gmx.de>
+! Testcase altered by Steven G. Kargl
+program gfcbug57
+  implicit none
+  !
+  ! These are logical kinds known by gfortran and many other compilers:
+  !
+  print *, kind (.true._1) ! This prints "1"
+  print *, kind (.true._2) ! This prints "2"
+  print *, kind (.true._4) ! This prints "4"
+  print *, kind (.true._8) ! This prints "8"
+  !
+  ! These are very strange (read: bad (invalid?)) logical kinds,
+  ! handled inconsistently by gfortran (there's no logical(kind=0) etc.)
+  !
+  print *, kind (.true._0)   ! { dg-error "kind for logical constant" }
+  print *, kind (.true._3)   ! { dg-error "kind for logical constant" }
+  print *, kind (.true._123) ! { dg-error "kind for logical constant" }
+  !
+  ! Here gfortran bails out with a runtime error:
+  !
+  print *, .true._3   ! { dg-error "kind for logical constant" }
+end program gfcbug57
diff --git a/gcc/testsuite/gfortran.dg/logical_3.f90 b/gcc/testsuite/gfortran.dg/logical_3.f90
new file mode 100644
index 000000000..f4d069e9a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/logical_3.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! This checks the fix for PR30406.
+!
+! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!===============================================================
+
+function f()
+  logical(8) :: f
+  f = .false._8
+end function f
diff --git a/gcc/testsuite/gfortran.dg/logical_comp.f90 b/gcc/testsuite/gfortran.dg/logical_comp.f90
new file mode 100644
index 000000000..bbf81260b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/logical_comp.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR fortran/22503, PR fortran/32899
+! Suggest use of appropriate comparison operator
+
+program foo
+  logical :: b
+  b = b .eq. b  ! { dg-error "must be compared with" }
+  b = b .ne. b  ! { dg-error "must be compared with" }
+end program
diff --git a/gcc/testsuite/gfortran.dg/logical_data_1.f90 b/gcc/testsuite/gfortran.dg/logical_data_1.f90
new file mode 100644
index 000000000..b9190d214
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/logical_data_1.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR19589
+! Logical objects/values with differing type kinds were being rejected in
+! data statements.
+program logical_data_1
+  logical(kind=4) :: a
+  logical(kind=8) :: b
+  data a, b /.true., .false./
+end program
diff --git a/gcc/testsuite/gfortran.dg/logical_dot_product.f90 b/gcc/testsuite/gfortran.dg/logical_dot_product.f90
new file mode 100644
index 000000000..e35595c43
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/logical_dot_product.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! Checks the LOGICAL version of dot_product
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+   logical :: l1(4) = (/.TRUE.,.FALSE.,.TRUE.,.FALSE./)
+   logical :: l2(4) = (/.FALSE.,.TRUE.,.FALSE.,.TRUE./)
+   if (dot_product (l1, l2)) call abort ()
+   l2 = .TRUE.
+   if (.not.dot_product (l1, l2)) call abort ()
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/logint_1.f b/gcc/testsuite/gfortran.dg/logint_1.f
new file mode 100644
index 000000000..a31697858
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/logint_1.f
@@ -0,0 +1,43 @@
+c { dg-do compile }
+c { dg-options "-O2 -std=legacy" }
+       LOGICAL(kind=1) l1
+       LOGICAL(kind=2) l2
+       LOGICAL         l4
+       INTEGER(kind=1) i1
+       INTEGER(kind=2) i2
+       INTEGER         i4
+
+       i1 = .TRUE.
+       i2 = .TRUE.
+       i4 = .TRUE.
+
+       i1 = .FALSE.
+       i2 = .FALSE.
+       i4 = .FALSE.
+
+       i1 = l1
+       i2 = l1
+       i4 = l1
+
+       i1 = l2
+       i2 = l2
+       i4 = l2
+
+       i1 = l4
+       i2 = l4
+       i4 = l4
+
+       l1 = i1
+       l2 = i1
+       l4 = i1
+
+       l1 = i2
+       l2 = i2
+       l4 = i2
+
+       l1 = i4
+       l2 = i4
+       l4 = i4
+
+       END
+ 
diff --git a/gcc/testsuite/gfortran.dg/logint_2.f b/gcc/testsuite/gfortran.dg/logint_2.f
new file mode 100644
index 000000000..19d387315
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/logint_2.f
@@ -0,0 +1,43 @@
+c { dg-do compile }
+c { dg-options "-O2 -std=f95" }
+       LOGICAL(kind=1) l1
+       LOGICAL(kind=2) l2
+       LOGICAL         l4
+       INTEGER(kind=1) i1
+       INTEGER(kind=2) i2
+       INTEGER         i4
+
+       i1 = .TRUE.  ! { dg-error "convert" }
+       i2 = .TRUE.  ! { dg-error "convert" }
+       i4 = .TRUE.  ! { dg-error "convert" }
+
+       i1 = .FALSE. ! { dg-error "convert" }
+       i2 = .FALSE. ! { dg-error "convert" }
+       i4 = .FALSE. ! { dg-error "convert" }
+
+       i1 = l1      ! { dg-error "convert" }
+       i2 = l1      ! { dg-error "convert" }
+       i4 = l1      ! { dg-error "convert" }
+
+       i1 = l2      ! { dg-error "convert" }
+       i2 = l2      ! { dg-error "convert" }
+       i4 = l2      ! { dg-error "convert" }
+
+       i1 = l4      ! { dg-error "convert" }
+       i2 = l4      ! { dg-error "convert" }
+       i4 = l4      ! { dg-error "convert" }
+
+       l1 = i1      ! { dg-error "convert" }
+       l2 = i1      ! { dg-error "convert" }
+       l4 = i1      ! { dg-error "convert" }
+
+       l1 = i2      ! { dg-error "convert" }
+       l2 = i2      ! { dg-error "convert" }
+       l4 = i2      ! { dg-error "convert" }
+
+       l1 = i4      ! { dg-error "convert" }
+       l2 = i4      ! { dg-error "convert" }
+       l4 = i4      ! { dg-error "convert" }
+
+       END
+ 
diff --git a/gcc/testsuite/gfortran.dg/logint_3.f b/gcc/testsuite/gfortran.dg/logint_3.f
new file mode 100644
index 000000000..7f6780c84
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/logint_3.f
@@ -0,0 +1,43 @@
+c { dg-do compile }
+c { dg-options "-O2" }
+       LOGICAL(kind=1) l1
+       LOGICAL(kind=2) l2
+       LOGICAL         l4
+       INTEGER(kind=1) i1
+       INTEGER(kind=2) i2
+       INTEGER         i4
+
+       i1 = .TRUE.  ! { dg-warning "Extension: Conversion" }
+       i2 = .TRUE.  ! { dg-warning "Extension: Conversion" }
+       i4 = .TRUE.  ! { dg-warning "Extension: Conversion" }
+
+       i1 = .FALSE. ! { dg-warning "Extension: Conversion" }
+       i2 = .FALSE. ! { dg-warning "Extension: Conversion" }
+       i4 = .FALSE. ! { dg-warning "Extension: Conversion" }
+
+       i1 = l1      ! { dg-warning "Extension: Conversion" }
+       i2 = l1      ! { dg-warning "Extension: Conversion" }
+       i4 = l1      ! { dg-warning "Extension: Conversion" }
+
+       i1 = l2      ! { dg-warning "Extension: Conversion" }
+       i2 = l2      ! { dg-warning "Extension: Conversion" }
+       i4 = l2      ! { dg-warning "Extension: Conversion" }
+
+       i1 = l4      ! { dg-warning "Extension: Conversion" }
+       i2 = l4      ! { dg-warning "Extension: Conversion" }
+       i4 = l4      ! { dg-warning "Extension: Conversion" }
+
+       l1 = i1      ! { dg-warning "Extension: Conversion" }
+       l2 = i1      ! { dg-warning "Extension: Conversion" }
+       l4 = i1      ! { dg-warning "Extension: Conversion" }
+
+       l1 = i2      ! { dg-warning "Extension: Conversion" }
+       l2 = i2      ! { dg-warning "Extension: Conversion" }
+       l4 = i2      ! { dg-warning "Extension: Conversion" }
+
+       l1 = i4      ! { dg-warning "Extension: Conversion" }
+       l2 = i4      ! { dg-warning "Extension: Conversion" }
+       l4 = i4      ! { dg-warning "Extension: Conversion" }
+
+       END
+ 
diff --git a/gcc/testsuite/gfortran.dg/longline.f b/gcc/testsuite/gfortran.dg/longline.f
new file mode 100644
index 000000000..c2a5f5afd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/longline.f
@@ -0,0 +1,11 @@
+# 1 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.f"
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+
+      subroutine foo
+      character*10 cpnam
+      character*4 csig
+      write (34,808)  csig,ilax,cpnam
+  808 format (/9X,4HTHE ,A4,  29HTIVE MINOS ERROR OF PARAMETER,I3,   2H
+     +, ,A10)
+      end
diff --git a/gcc/testsuite/gfortran.dg/lrshift_1.c b/gcc/testsuite/gfortran.dg/lrshift_1.c
new file mode 100644
index 000000000..8b451107b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lrshift_1.c
@@ -0,0 +1,3 @@
+/* Left and right shift C routines, to compare to Fortran results.  */
+int c_lshift_ (int *x, int *y) { return (*x) << (*y); }
+int c_rshift_ (int *x, int *y) { return (*x) >> (*y); }
diff --git a/gcc/testsuite/gfortran.dg/lrshift_1.f90 b/gcc/testsuite/gfortran.dg/lrshift_1.f90
new file mode 100644
index 000000000..7feed2962
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lrshift_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-std=gnu -w" }
+! { dg-additional-sources lrshift_1.c }
+program test_rshift_lshift
+  implicit none
+  integer :: i(15), j, n
+  integer, external :: c_lshift, c_rshift
+
+  i = (/ -huge(i), -huge(i)/2, -129, -128, -127, -2, -1, 0, &
+         1, 2, 127, 128, 129, huge(i)/2, huge(i) /)
+
+  do n = 1, size(i)
+    do j = -30, 30
+      if (lshift(i(n),j) /= c_lshift(i(n),j)) call abort
+      if (rshift(i(n),j) /= c_rshift(i(n),j)) call abort
+    end do
+  end do
+end program test_rshift_lshift
diff --git a/gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90 b/gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90
new file mode 100644
index 000000000..cdbb97335
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+  integer :: x(9), y(9), t
+
+  t = time()
+  call ltime(t,x)
+  call gmtime(t,y)
+  if (x(1) /= y(1) .or. mod(x(2),30) /= mod(y(2),30)) call abort
+  end
diff --git a/gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90 b/gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90
new file mode 100644
index 000000000..c1480b723
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! { dg-options "-fdefault-integer-8 -std=gnu" }
+  integer :: x(9), y(9), t
+
+  t = time()
+  call ltime(t,x)
+  call gmtime(t,y)
+  if (x(1) /= y(1) .or. mod(x(2),30) /= mod(y(2),30)) call abort
+  end
diff --git a/gcc/testsuite/gfortran.dg/lto/20091015-1_0.f b/gcc/testsuite/gfortran.dg/lto/20091015-1_0.f
new file mode 100644
index 000000000..f47e1a4ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/20091015-1_0.f
@@ -0,0 +1,8 @@
+! { dg-lto-do link }
+! We expect some warnings about mismatched symbol types
+! { dg-extra-ld-options "-w" }
+
+      subroutine dalie6s(iqmod6,nz,wx,cor6d)
+      common/dascr/iscrda(100),rscrri(100),iscrri(100),idao
+      call daall(iscrda,100,'$$IS      ',no,nv)
+      end
diff --git a/gcc/testsuite/gfortran.dg/lto/20091015-1_1.f b/gcc/testsuite/gfortran.dg/lto/20091015-1_1.f
new file mode 100644
index 000000000..7a64ffa67
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/20091015-1_1.f
@@ -0,0 +1,4 @@
+      SUBROUTINE DAALL(IC,L,CCC,NO,NV)
+      COMMON /main1/ eps
+      END
+
diff --git a/gcc/testsuite/gfortran.dg/lto/20091015-1_2.f b/gcc/testsuite/gfortran.dg/lto/20091015-1_2.f
new file mode 100644
index 000000000..5bfd02227
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/20091015-1_2.f
@@ -0,0 +1,5 @@
+      program test
+      common/main1/ eps(2)
+      dimension cor6d(2,2)
+      call dalie6s(iqmod6,1,wx,cor6d)
+      end
diff --git a/gcc/testsuite/gfortran.dg/lto/20091016-1_0.f90 b/gcc/testsuite/gfortran.dg/lto/20091016-1_0.f90
new file mode 100644
index 000000000..a882da042
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/20091016-1_0.f90
@@ -0,0 +1,12 @@
+! { dg-lto-do link }
+! { dg-lto-options {{-flto -g -fPIC -r -nostdlib} {-O -flto -g -fPIC -r -nostdlib}} }
+
+      FUNCTION makenumberstring(x)
+      IMPLICIT NONE
+      REAL, INTENT(IN)     :: x
+      CHARACTER(len=20)      :: makenumberstring
+      INTEGER             :: xx
+      xx = x**2  ! << ICE
+      makenumberstring = ''
+      END FUNCTION
+
diff --git a/gcc/testsuite/gfortran.dg/lto/20091028-1_0.f90 b/gcc/testsuite/gfortran.dg/lto/20091028-1_0.f90
new file mode 100644
index 000000000..57c1b1f60
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/20091028-1_0.f90
@@ -0,0 +1,9 @@
+! { dg-lto-do link }
+! { dg-extra-ld-options "-r -nostdlib -finline-functions" }
+
+SUBROUTINE int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
+                              DataHandle, Element, VarName, Data, code )
+  CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, 1, &
+                             DataHandle, DummyData, DummyCount, code )
+END SUBROUTINE int_gen_ti_header_char
+
diff --git a/gcc/testsuite/gfortran.dg/lto/20091028-1_1.c b/gcc/testsuite/gfortran.dg/lto/20091028-1_1.c
new file mode 100644
index 000000000..b3afc23fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/20091028-1_1.c
@@ -0,0 +1,11 @@
+extern void bcopy(const void *, void *, __SIZE_TYPE__ n);
+char *p;
+int int_gen_ti_header_c_ (char * hdrbuf, int * hdrbufsize,
+                          int * itypesize, int * typesize,
+                          int * DataHandle, char * Data,
+                          int * Count, int * code)
+{
+  bcopy (typesize, p, sizeof(int)) ;
+  bcopy (Data, p, *Count * *typesize) ;
+}
+
diff --git a/gcc/testsuite/gfortran.dg/lto/20091028-2_0.f90 b/gcc/testsuite/gfortran.dg/lto/20091028-2_0.f90
new file mode 100644
index 000000000..57c1b1f60
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/20091028-2_0.f90
@@ -0,0 +1,9 @@
+! { dg-lto-do link }
+! { dg-extra-ld-options "-r -nostdlib -finline-functions" }
+
+SUBROUTINE int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
+                              DataHandle, Element, VarName, Data, code )
+  CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, 1, &
+                             DataHandle, DummyData, DummyCount, code )
+END SUBROUTINE int_gen_ti_header_char
+
diff --git a/gcc/testsuite/gfortran.dg/lto/20091028-2_1.c b/gcc/testsuite/gfortran.dg/lto/20091028-2_1.c
new file mode 100644
index 000000000..496aaf112
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/20091028-2_1.c
@@ -0,0 +1,11 @@
+extern void *memcpy(void *dest, const void *src, __SIZE_TYPE__ n);
+char *p;
+int int_gen_ti_header_c_ (char * hdrbuf, int * hdrbufsize,
+                          int * itypesize, int * typesize,
+                          int * DataHandle, char * Data,
+                          int * Count, int * code)
+{
+  memcpy (typesize, p, sizeof(int)) ;
+  memcpy (Data, p, *Count * *typesize) ;
+}
+
diff --git a/gcc/testsuite/gfortran.dg/lto/20100110-1_0.f90 b/gcc/testsuite/gfortran.dg/lto/20100110-1_0.f90
new file mode 100644
index 000000000..d3caa61da
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/20100110-1_0.f90
@@ -0,0 +1,19 @@
+! { dg-lto-do link }
+! { dg-lto-options {{ -O1 -flto }} }
+! { dg-suppress-ld-options "-O1" }
+
+      SUBROUTINE ylm4(ylm)
+      COMPLEX, INTENT (OUT):: ylm(1)
+      INTEGER l,m
+      COMPLEX ylms
+      REAL, ALLOCATABLE, SAVE  :: ynorm(:)
+      ylms = 0
+      DO m = 1, 1
+         DO l = m, 1
+            ylm(m) = conjg(ylms)*ynorm(m)
+         ENDDO
+      ENDDO
+      END SUBROUTINE ylm4
+
+      PROGRAM test
+      END
diff --git a/gcc/testsuite/gfortran.dg/lto/20100222-1_0.f03 b/gcc/testsuite/gfortran.dg/lto/20100222-1_0.f03
new file mode 100644
index 000000000..fece78154
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/20100222-1_0.f03
@@ -0,0 +1,35 @@
+! { dg-lto-do run }
+! This testcase tests c_funloc and c_funptr from iso_c_binding.  It uses 
+! functions defined in c_funloc_tests_3_funcs.c.
+module c_funloc_tests_3
+ implicit none
+contains
+  function ffunc(j) bind(c)
+    use iso_c_binding, only: c_funptr, c_int
+    integer(c_int)        :: ffunc
+    integer(c_int), value :: j
+    ffunc = -17*j
+  end function ffunc
+end module c_funloc_tests_3
+program main
+  use iso_c_binding, only: c_funptr, c_funloc
+  use c_funloc_tests_3, only: ffunc
+  implicit none
+  interface
+    function returnFunc() bind(c,name="returnFunc")
+       use iso_c_binding, only: c_funptr
+       type(c_funptr) :: returnFunc
+    end function returnFunc
+    subroutine callFunc(func,pass,compare) bind(c,name="callFunc")
+       use iso_c_binding, only: c_funptr, c_int
+       type(c_funptr), value :: func
+       integer(c_int), value :: pass,compare
+    end subroutine callFunc
+  end interface
+  type(c_funptr) :: p
+  p = returnFunc()
+  call callFunc(p, 13,3*13)
+  p = c_funloc(ffunc)
+  call callFunc(p, 21,-17*21)
+end program main
+! { dg-final { cleanup-modules "c_funloc_tests_3" } }
diff --git a/gcc/testsuite/gfortran.dg/lto/20100222-1_1.c b/gcc/testsuite/gfortran.dg/lto/20100222-1_1.c
new file mode 100644
index 000000000..994da0a50
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/20100222-1_1.c
@@ -0,0 +1,25 @@
+/* These functions support the test case c_funloc_tests_3.  */
+#include <stdlib.h>
+#include <stdio.h>
+
+int printIntC(int i)
+{
+  return 3*i;
+}
+
+int (*returnFunc(void))(int)
+{
+  return &printIntC;
+}
+
+void callFunc(int(*func)(int), int pass, int compare)
+{
+  int result = (*func)(pass);
+  if(result != compare)
+    {
+       printf("FAILED: Got %d, expected %d\n", result, compare);
+       abort();
+    }
+  else
+    printf("SUCCESS: Got %d, expected %d\n", result, compare);
+}
diff --git a/gcc/testsuite/gfortran.dg/lto/lto.exp b/gcc/testsuite/gfortran.dg/lto/lto.exp
new file mode 100644
index 000000000..e211426db
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/lto.exp
@@ -0,0 +1,58 @@
+# Copyright (C) 2009 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+#
+# Contributed by Diego Novillo <dnovillo@google.com>
+
+
+# Test link-time optimization across multiple files.
+#
+# Programs are broken into multiple files.  Each one is compiled
+# separately with LTO information.  The final executable is generated
+# by collecting all the generated object files using regular LTO or WHOPR.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+# Load procedures from common libraries. 
+load_lib standard.exp
+load_lib gfortran-dg.exp
+
+# Load the language-independent compabibility support procedures.
+load_lib lto.exp
+
+lto_init no-mathlib
+
+# Define an identifier for use with this suite to avoid name conflicts
+# with other lto tests running at the same time.
+set sid "f_lto"
+
+# If LTO has not been enabled, bail.
+if { ![check_effective_target_lto] } {
+    return
+}
+
+# Main loop.
+foreach src [lsort [glob -nocomplain $srcdir/$subdir/*_0.\[fF\]{,90,95,03,08} ]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $src] then {
+	continue
+    }
+
+    lto-execute $src $sid
+}
+
+lto_finish
diff --git a/gcc/testsuite/gfortran.dg/lto/pr40724_0.f b/gcc/testsuite/gfortran.dg/lto/pr40724_0.f
new file mode 100644
index 000000000..2d7a9864e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr40724_0.f
@@ -0,0 +1,3 @@
+      subroutine f
+        print *, "Hello World"
+      end
diff --git a/gcc/testsuite/gfortran.dg/lto/pr40724_1.f b/gcc/testsuite/gfortran.dg/lto/pr40724_1.f
new file mode 100644
index 000000000..ed8f31020
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr40724_1.f
@@ -0,0 +1,3 @@
+      program test
+      call f
+      end
diff --git a/gcc/testsuite/gfortran.dg/lto/pr40725_0.f03 b/gcc/testsuite/gfortran.dg/lto/pr40725_0.f03
new file mode 100644
index 000000000..db783159a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr40725_0.f03
@@ -0,0 +1,17 @@
+module bind_c_dts_2
+use, intrinsic :: iso_c_binding
+implicit none
+type, bind(c) :: my_c_type_1
+   integer(c_int) :: j
+end type my_c_type_1
+contains
+  subroutine sub0(my_type, expected_j) bind(c)
+    type(my_c_type_1) :: my_type
+    integer(c_int), value :: expected_j
+    if (my_type%j .ne. expected_j) then
+       call abort ()
+    end if
+  end subroutine sub0
+end module bind_c_dts_2
+
+! { dg-final { cleanup-modules "bind_c_dts_2" } }
diff --git a/gcc/testsuite/gfortran.dg/lto/pr40725_1.c b/gcc/testsuite/gfortran.dg/lto/pr40725_1.c
new file mode 100644
index 000000000..7de46b8a9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr40725_1.c
@@ -0,0 +1,12 @@
+typedef struct c_type_1
+{
+  int j;
+} c_type_1_t;
+void sub0(c_type_1_t *c_type, int expected_j);
+int main(int argc, char **argv)
+{
+  c_type_1_t c_type;
+  c_type.j = 11;
+  sub0(&c_type, c_type.j);
+  return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/lto/pr41069_0.f90 b/gcc/testsuite/gfortran.dg/lto/pr41069_0.f90
new file mode 100644
index 000000000..4e7d65939
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr41069_0.f90
@@ -0,0 +1,7 @@
+! { dg-lto-do link }
+SUBROUTINE mltfftsg ( a, ldax, lday )
+  INTEGER, PARAMETER :: dbl = SELECTED_REAL_KIND ( 14, 200 )
+  INTEGER, INTENT ( IN ) :: ldax, lday
+  COMPLEX ( dbl ), INTENT ( INOUT ) :: a ( ldax, lday )
+END SUBROUTINE mltfftsg
+
diff --git a/gcc/testsuite/gfortran.dg/lto/pr41069_1.f90 b/gcc/testsuite/gfortran.dg/lto/pr41069_1.f90
new file mode 100644
index 000000000..0c4e05d66
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr41069_1.f90
@@ -0,0 +1,10 @@
+SUBROUTINE S(zin)
+  COMPLEX(8), DIMENSION(3,3,3) :: zin
+  INTEGER :: m,n
+  CALL mltfftsg ( zin, m, n )
+END SUBROUTINE
+
+COMPLEX(8), DIMENSION(3,3,3) :: zin
+CALL s(zin)
+END
+
diff --git a/gcc/testsuite/gfortran.dg/lto/pr41069_2.f90 b/gcc/testsuite/gfortran.dg/lto/pr41069_2.f90
new file mode 100644
index 000000000..121603eaa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr41069_2.f90
@@ -0,0 +1,9 @@
+SUBROUTINE fftsg3d ( n, zout )
+  INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND ( 14, 200 )
+  INTEGER, DIMENSION(*), INTENT(IN)                    :: n
+  COMPLEX(KIND=dp), DIMENSION(*), INTENT(INOUT)        :: zout
+  INTEGER                                              :: nx
+  nx = n ( 1 )
+  CALL mltfftsg ( zout, nx, nx )
+END SUBROUTINE fftsg3d
+
diff --git a/gcc/testsuite/gfortran.dg/lto/pr41521_0.f90 b/gcc/testsuite/gfortran.dg/lto/pr41521_0.f90
new file mode 100644
index 000000000..d88277926
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr41521_0.f90
@@ -0,0 +1,9 @@
+! { dg-lto-do link }
+! { dg-lto-options {{-g -flto} {-g -O -flto}} }
+program species
+integer spk(2)
+real eval(2)
+spk = 2
+call atom(1.1,spk,eval)
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/lto/pr41521_1.f90 b/gcc/testsuite/gfortran.dg/lto/pr41521_1.f90
new file mode 100644
index 000000000..897e7aded
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr41521_1.f90
@@ -0,0 +1,9 @@
+subroutine atom(sol,k,eval)
+real, intent(in) :: sol
+integer, intent(in) :: k(2)
+real, intent(out) :: eval(2)
+real t1
+  t1=sqrt(dble(k(1)**2)-(sol)**2)
+  eval(1)=sol**2/sqrt(t1)-sol**2
+end subroutine
+
diff --git a/gcc/testsuite/gfortran.dg/lto/pr41764_0.f b/gcc/testsuite/gfortran.dg/lto/pr41764_0.f
new file mode 100644
index 000000000..fd2315083
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr41764_0.f
@@ -0,0 +1,13 @@
+! { dg-lto-do link }
+! FIXME: This test used to fail with gold and -fuse-linker-plugin. It is
+! here for people testing with RUNTESTFLAGS=-fuse-linker-plugin, but it would
+! be nice to create "dg-effective-target-supports linker-plugin" and use it.
+      PROGRAM INIRAN
+      INTEGER IX, IY, IZ
+      COMMON /XXXRAN/ IX, IY, IZ
+      END
+      BLOCKDATA RAEWIN
+      INTEGER IX, IY, IZ
+      COMMON /XXXRAN/ IX, IY, IZ
+      DATA IX, IY, IZ / 1974, 235, 337 /
+      END
diff --git a/gcc/testsuite/gfortran.dg/lto/pr45586-2_0.f90 b/gcc/testsuite/gfortran.dg/lto/pr45586-2_0.f90
new file mode 100644
index 000000000..52e2bb1e6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr45586-2_0.f90
@@ -0,0 +1,34 @@
+! { dg-lto-do link }
+!
+! PR fortran/45586 (comment 53)
+!
+
+MODULE M1
+  INTEGER, PARAMETER :: dp=8
+  TYPE realspace_grid_type
+     REAL(KIND=dp), DIMENSION ( :, :, : ), ALLOCATABLE :: r
+  END TYPE realspace_grid_type
+  TYPE realspace_grid_p_type
+     TYPE(realspace_grid_type), POINTER :: rs_grid
+  END TYPE realspace_grid_p_type
+  TYPE realspaces_grid_p_type
+     TYPE(realspace_grid_p_type), DIMENSION(:), POINTER :: rs
+  END TYPE realspaces_grid_p_type
+END MODULE
+
+MODULE M2
+ USE M1
+CONTAINS
+ SUBROUTINE S1()
+  INTEGER :: i,j
+  TYPE(realspaces_grid_p_type), DIMENSION(:), POINTER :: rs_gauge
+  REAL(dp), DIMENSION(:, :, :), POINTER    :: y
+  y=>rs_gauge(i)%rs(j)%rs_grid%r
+ END SUBROUTINE
+END MODULE
+
+USE M2
+  CALL S1()
+END
+
+! { dg-final { cleanup-modules "m1 m2" } }
diff --git a/gcc/testsuite/gfortran.dg/lto/pr45586_0.f90 b/gcc/testsuite/gfortran.dg/lto/pr45586_0.f90
new file mode 100644
index 000000000..84f3633df
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr45586_0.f90
@@ -0,0 +1,29 @@
+! { dg-lto-do link }
+      MODULE M1
+      INTEGER, PARAMETER :: dp=8
+      TYPE realspace_grid_type
+
+          REAL(KIND=dp), DIMENSION ( :, :, : ), ALLOCATABLE :: r
+
+      END TYPE realspace_grid_type
+      END MODULE
+
+      MODULE M2
+      USE m1
+      CONTAINS
+      SUBROUTINE S1(x)
+      TYPE(realspace_grid_type), POINTER :: x
+      REAL(dp), DIMENSION(:, :, :), POINTER    :: y
+      y=>x%r
+      y=0
+
+      END SUBROUTINE
+      END MODULE
+
+      USE M2
+      TYPE(realspace_grid_type), POINTER :: x
+      ALLOCATE(x)
+      ALLOCATE(x%r(10,10,10))
+      CALL S1(x)
+      write(6,*) x%r
+      END
diff --git a/gcc/testsuite/gfortran.dg/lto/pr46036_0.f90 b/gcc/testsuite/gfortran.dg/lto/pr46036_0.f90
new file mode 100644
index 000000000..558c7edc2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr46036_0.f90
@@ -0,0 +1,14 @@
+! { dg-lto-do link }
+! { dg-lto-options {{ -O -flto -ftree-vectorize }} }
+
+function no_of_edges(self) result(res)
+  integer(kind=kind(1)) :: edge_bit_string
+  integer(kind=kind(1)) :: res
+  integer(kind=kind(1)) :: e
+  do e = 0, 11
+     if (.not. btest(edge_bit_string,e)) cycle
+     res = res + 1
+  end do
+end function no_of_edges
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/lto/pr46629_0.f90 b/gcc/testsuite/gfortran.dg/lto/pr46629_0.f90
new file mode 100644
index 000000000..0b34418e7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr46629_0.f90
@@ -0,0 +1,15 @@
+! PR middle-end/46629
+! { dg-lto-do assemble }
+! { dg-lto-options {{ -O2 -flto -ftree-vectorize }} }
+! { dg-lto-options {{ -O2 -flto -ftree-vectorize -march=x86-64 }} { target i?86-*-* x86_64-*-* } }
+
+subroutine foo
+  character(len=6), save :: c
+  real, save :: d(0:100)
+  integer, save :: x, n, i
+  n = x
+  print *, c
+  do i = 2, n
+    d(i) = -d(i-1)
+  end do
+end
diff --git a/gcc/testsuite/gfortran.dg/lto/pr46911_0.f b/gcc/testsuite/gfortran.dg/lto/pr46911_0.f
new file mode 100644
index 000000000..fce959750
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr46911_0.f
@@ -0,0 +1,6 @@
+! { dg-lto-do link }
+! { dg-lto-options {{ -O2 -flto -g }} }
+! { dg-extra-ld-options "-r -nostdlib" }
+      common/main1/ eps(2)
+      call dalie6s(iqmod6,1,wx,cor6d)
+      end
diff --git a/gcc/testsuite/gfortran.dg/lto/pr47839_0.f90 b/gcc/testsuite/gfortran.dg/lto/pr47839_0.f90
new file mode 100644
index 000000000..9ea931528
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr47839_0.f90
@@ -0,0 +1,8 @@
+! { dg-lto-do link }
+! { dg-lto-options {{ -g -flto }} }
+! { dg-extra-ld-options "-r -nostdlib" }
+
+MODULE globalvar_mod
+integer        :: xstop
+CONTAINS
+END MODULE globalvar_mod
diff --git a/gcc/testsuite/gfortran.dg/lto/pr47839_1.f90 b/gcc/testsuite/gfortran.dg/lto/pr47839_1.f90
new file mode 100644
index 000000000..5c94ff17b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr47839_1.f90
@@ -0,0 +1,7 @@
+MODULE PEC_mod
+CONTAINS
+SUBROUTINE PECapply(Ex)
+USE globalvar_mod, ONLY : xstop
+real(kind=8), dimension(1:xstop), intent(inout) :: Ex
+END SUBROUTINE PECapply
+END MODULE PEC_mod
diff --git a/gcc/testsuite/gfortran.dg/malloc_free_1.f90 b/gcc/testsuite/gfortran.dg/malloc_free_1.f90
new file mode 100644
index 000000000..723236f8f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/malloc_free_1.f90
@@ -0,0 +1,11 @@
+! Test for the MALLOC and FREE intrinsics
+! If something is wrong with them, this test might segfault
+! { dg-do run }
+  integer j
+  integer(kind=8) i8
+
+  do j = 1, 10000
+    i8 = malloc (10 * j)
+    call free (i8)
+  end do
+  end
diff --git a/gcc/testsuite/gfortran.dg/mapping_1.f90 b/gcc/testsuite/gfortran.dg/mapping_1.f90
new file mode 100644
index 000000000..02042c026
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mapping_1.f90
@@ -0,0 +1,70 @@
+! { dg-do run }
+! Tests the fix for PR31213, which exposed rather a lot of
+! bugs - see the PR and the ChangeLog.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+module mykinds
+  implicit none
+  integer, parameter :: ik1 = selected_int_kind (2)
+  integer, parameter :: ik2 = selected_int_kind (4)
+  integer, parameter :: dp = selected_real_kind (15,300)
+end module mykinds
+
+module spec_xpr
+  use mykinds
+  implicit none
+  integer(ik2) c_size
+contains
+  pure function tricky (str,ugly)
+    character(*), intent(in) :: str
+    integer(ik1) :: ia_ik1(len(str))
+    interface yoagly
+      pure function ugly(n)
+        use mykinds
+        implicit none
+        integer, intent(in) :: n
+        complex(dp) :: ugly(3*n+2)
+      end function ugly
+    end interface yoagly
+    logical :: la(size (yoagly (size (ia_ik1))))
+    integer :: i
+    character(tricky_helper ((/(.TRUE., i=1, size (la))/)) + c_size) :: tricky
+
+    tricky = transfer (yoagly (1), tricky)
+  end function tricky
+
+  pure function tricky_helper (lb)
+    logical, intent(in) :: lb(:)
+    integer :: tricky_helper
+    tricky_helper = 2 * size (lb) + 3
+  end function tricky_helper
+end module spec_xpr
+
+module xtra_fun
+  implicit none
+contains
+  pure function butt_ugly(n)
+    use mykinds
+    implicit none
+    integer, intent(in) :: n
+    complex(dp) :: butt_ugly(3*n+2)
+    real(dp) pi, sq2
+
+    pi = 4 * atan (1.0_dp)
+    sq2 = sqrt (2.0_dp)
+    butt_ugly = cmplx (pi, sq2, dp)
+  end function butt_ugly
+end module xtra_fun
+
+program spec_test
+  use mykinds
+  use spec_xpr
+  use xtra_fun
+  implicit none
+  character(54) :: chr
+
+  c_size = 5
+  if (tricky ('Help me', butt_ugly) .ne. transfer (butt_ugly (1), chr)) call abort ()
+end program spec_test
+! { dg-final { cleanup-modules "mykinds spec_xpr xtra_fun" } }
diff --git a/gcc/testsuite/gfortran.dg/mapping_2.f90 b/gcc/testsuite/gfortran.dg/mapping_2.f90
new file mode 100644
index 000000000..9104184a5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mapping_2.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! Tests the fix for PR33998, in which the chain of expressions
+! determining the character length of my_string were not being
+! resolved by the formal to actual mapping.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module test
+   implicit none
+   contains
+      function my_string(x)
+         integer i
+         real, intent(in) :: x(:)
+         character(0) h4(1:minval([(i,i=30,32), 15]))
+         character(0) sv1(size(x,1):size(h4))
+         character(0) sv2(2*lbound(sv1,1):size(h4))
+         character(lbound(sv2,1)-3) my_string
+
+         do i = 1, len(my_string)
+            my_string(i:i) = achar(modulo(i-1,10)+iachar('0'))
+         end do
+      end function my_string
+end module test
+
+program len_test
+   use test
+   implicit none
+   real x(7)
+
+   if (my_string(x) .ne. "01234567890") call abort ()
+end program len_test
+! { dg-final { cleanup-modules "test" } }
diff --git a/gcc/testsuite/gfortran.dg/mapping_3.f90 b/gcc/testsuite/gfortran.dg/mapping_3.f90
new file mode 100644
index 000000000..318ec00c0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mapping_3.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! Tests the fix for PR33888, in which the character length of
+! the elemental function myfunc was not being calculated before
+! the temporary for the array result was allocated.
+!
+! Contributed by Walter Spector <w6ws@earthlink.net>
+!
+program ftn95bug
+  implicit none
+
+  character(8) :: indata(4) =  &
+              (/ '12344321', '98766789', 'abcdefgh', 'ABCDEFGH' /)
+
+  call process (myfunc (indata))  ! <- This caused a gfortran ICE !
+
+contains
+
+  elemental function myfunc (s)
+    character(*), intent(in) :: s
+    character(len (s)) :: myfunc
+
+    myfunc = s
+
+  end function
+
+  subroutine process (strings)
+    character(*), intent(in) :: strings(:)
+
+    if (any (strings .ne. indata)) call abort ()
+
+  end subroutine
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/masklr_1.F90 b/gcc/testsuite/gfortran.dg/masklr_1.F90
new file mode 100644
index 000000000..82472c571
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/masklr_1.F90
@@ -0,0 +1,82 @@
+! Test the MASKL and MASKR intrinsics.
+!
+! { dg-do run }
+! { dg-options "-ffree-line-length-none" }
+
+#define CHECK(I,KIND,FUNCL,FUNCR,RESL,RESR) \
+  if (maskl(I,KIND) /= RESL) call abort ; \
+  if (FUNCL(I) /= RESL) call abort ; \
+  if (maskr(I,KIND) /= RESR) call abort ; \
+  if (FUNCR(I) /= RESR) call abort
+
+  CHECK(0,1,run_maskl1,run_maskr1,0_1,0_1)
+  CHECK(1,1,run_maskl1,run_maskr1,-huge(0_1)-1_1,1_1)
+  CHECK(2,1,run_maskl1,run_maskr1,(-huge(0_1)-1_1)/2_1,3_1)
+  CHECK(3,1,run_maskl1,run_maskr1,(-huge(0_1)-1_1)/4_1,7_1)
+  CHECK(int(bit_size(0_1))-2,1,run_maskl1,run_maskr1,-4_1,huge(0_1)/2_1)
+  CHECK(int(bit_size(0_1))-1,1,run_maskl1,run_maskr1,-2_1,huge(0_1))
+  CHECK(int(bit_size(0_1)),1,run_maskl1,run_maskr1,-1_1,-1_1)
+
+  CHECK(0,2,run_maskl2,run_maskr2,0_2,0_2)
+  CHECK(1,2,run_maskl2,run_maskr2,-huge(0_2)-1_2,1_2)
+  CHECK(2,2,run_maskl2,run_maskr2,(-huge(0_2)-1_2)/2_2,3_2)
+  CHECK(3,2,run_maskl2,run_maskr2,(-huge(0_2)-1_2)/4_2,7_2)
+  CHECK(int(bit_size(0_2))-2,2,run_maskl2,run_maskr2,-4_2,huge(0_2)/2_2)
+  CHECK(int(bit_size(0_2))-1,2,run_maskl2,run_maskr2,-2_2,huge(0_2))
+  CHECK(int(bit_size(0_2)),2,run_maskl2,run_maskr2,-1_2,-1_2)
+
+  CHECK(0,4,run_maskl4,run_maskr4,0_4,0_4)
+  CHECK(1,4,run_maskl4,run_maskr4,-huge(0_4)-1_4,1_4)
+  CHECK(2,4,run_maskl4,run_maskr4,(-huge(0_4)-1_4)/2_4,3_4)
+  CHECK(3,4,run_maskl4,run_maskr4,(-huge(0_4)-1_4)/4_4,7_4)
+  CHECK(int(bit_size(0_4))-2,4,run_maskl4,run_maskr4,-4_4,huge(0_4)/2_4)
+  CHECK(int(bit_size(0_4))-1,4,run_maskl4,run_maskr4,-2_4,huge(0_4))
+  CHECK(int(bit_size(0_4)),4,run_maskl4,run_maskr4,-1_4,-1_4)
+
+  CHECK(0,8,run_maskl8,run_maskr8,0_8,0_8)
+  CHECK(1,8,run_maskl8,run_maskr8,-huge(0_8)-1_8,1_8)
+  CHECK(2,8,run_maskl8,run_maskr8,(-huge(0_8)-1_8)/2_8,3_8)
+  CHECK(3,8,run_maskl8,run_maskr8,(-huge(0_8)-1_8)/4_8,7_8)
+  CHECK(int(bit_size(0_8))-2,8,run_maskl8,run_maskr8,-4_8,huge(0_8)/2_8)
+  CHECK(int(bit_size(0_8))-1,8,run_maskl8,run_maskr8,-2_8,huge(0_8))
+  CHECK(int(bit_size(0_8)),8,run_maskl8,run_maskr8,-1_8,-1_8)
+
+contains
+
+  pure integer(kind=1) function run_maskl1(i) result(res)
+    integer, intent(in) :: i
+    res = maskl(i,kind=1)
+  end function
+  pure integer(kind=1) function run_maskr1(i) result(res)
+    integer, intent(in) :: i
+    res = maskr(i,kind=1)
+  end function
+
+  pure integer(kind=2) function run_maskl2(i) result(res)
+    integer, intent(in) :: i
+    res = maskl(i,kind=2)
+  end function
+  pure integer(kind=2) function run_maskr2(i) result(res)
+    integer, intent(in) :: i
+    res = maskr(i,kind=2)
+  end function
+
+  pure integer(kind=4) function run_maskl4(i) result(res)
+    integer, intent(in) :: i
+    res = maskl(i,kind=4)
+  end function
+  pure integer(kind=4) function run_maskr4(i) result(res)
+    integer, intent(in) :: i
+    res = maskr(i,kind=4)
+  end function
+
+  pure integer(kind=8) function run_maskl8(i) result(res)
+    integer, intent(in) :: i
+    res = maskl(i,kind=8)
+  end function
+  pure integer(kind=8) function run_maskr8(i) result(res)
+    integer, intent(in) :: i
+    res = maskr(i,kind=8)
+  end function
+
+end
diff --git a/gcc/testsuite/gfortran.dg/masklr_2.F90 b/gcc/testsuite/gfortran.dg/masklr_2.F90
new file mode 100644
index 000000000..a7545a188
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/masklr_2.F90
@@ -0,0 +1,32 @@
+! Test the MASKL and MASKR intrinsics.
+!
+! { dg-do run }
+! { dg-options "-ffree-line-length-none" }
+! { dg-require-effective-target fortran_integer_16 }
+
+#define CHECK(I,KIND,FUNCL,FUNCR,RESL,RESR) \
+  if (maskl(I,KIND) /= RESL) call abort ; \
+  if (FUNCL(I) /= RESL) call abort ; \
+  if (maskr(I,KIND) /= RESR) call abort ; \
+  if (FUNCR(I) /= RESR) call abort
+
+  CHECK(0,16,run_maskl16,run_maskr16,0_16,0_16)
+  CHECK(1,16,run_maskl16,run_maskr16,-huge(0_16)-1_16,1_16)
+  CHECK(2,16,run_maskl16,run_maskr16,(-huge(0_16)-1_16)/2_16,3_16)
+  CHECK(3,16,run_maskl16,run_maskr16,(-huge(0_16)-1_16)/4_16,7_16)
+  CHECK(int(bit_size(0_16))-2,16,run_maskl16,run_maskr16,-4_16,huge(0_16)/2_16)
+  CHECK(int(bit_size(0_16))-1,16,run_maskl16,run_maskr16,-2_16,huge(0_16))
+  CHECK(int(bit_size(0_16)),16,run_maskl16,run_maskr16,-1_16,-1_16)
+
+contains
+
+  pure integer(kind=16) function run_maskl16(i) result(res)
+    integer, intent(in) :: i
+    res = maskl(i,kind=16)
+  end function
+  pure integer(kind=16) function run_maskr16(i) result(res)
+    integer, intent(in) :: i
+    res = maskr(i,kind=16)
+  end function
+
+end
diff --git a/gcc/testsuite/gfortran.dg/matmul_1.f90 b/gcc/testsuite/gfortran.dg/matmul_1.f90
new file mode 100644
index 000000000..6496f88a2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/matmul_1.f90
@@ -0,0 +1,53 @@
+!{ dg-do run }
+! Test MATMUL for various arguments and results
+! (test values checked with GNU octave).
+! PR18857 was due to an incorrect assertion that component base==0
+! for both input arguments and the result.
+! provided by Paul Thomas - pault@gcc.gnu.org
+
+Program matmul_1
+  integer, parameter                                :: N = 5
+  integer, parameter                                :: T = 4
+  integer                                           :: i
+  real(kind=T), dimension(:,:), allocatable         :: a, b, c
+  real(kind=T), dimension(N,N)                      :: x, y, z
+
+  allocate (a(2*N, N), b(N, N), c(2*N, N))
+
+  do i = 1, 2*N
+    a(i, :) = real (i)
+  end do
+  b = 4.0_T
+
+  do i = 1, N
+    x(i, :) = real (i)
+  end do
+  y = 2.0_T
+
+!                           whole array
+
+  z = 0.0_T
+  z = matmul (x, y)
+  if (sum (z) /= 750.0_T) call abort ()
+
+!                           array sections
+
+  c = 0.0_T
+  c(1:3,1:2) = matmul (a(7:9,3:N), b(3:N,3:4))
+  if (sum (c) /= 576.0_T) call abort ()
+
+!                           uses a temp
+
+  c = 0.0_T
+  c = matmul (a, b + x)
+  if (sum (c) /= 9625.0_T) call abort ()
+
+!                           returns to a temp
+
+  c = 0.0_T
+  c = a + matmul (a, b)
+  if (sum (c) /= 5775.0_T) call abort ()
+
+  deallocate (a, b, c)
+
+end program matmul_1
diff --git a/gcc/testsuite/gfortran.dg/matmul_2.f90 b/gcc/testsuite/gfortran.dg/matmul_2.f90
new file mode 100644
index 000000000..fb678afb8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/matmul_2.f90
@@ -0,0 +1,21 @@
+!{ dg-do run }
+! PR libfortran/26985
+program matmul_2
+  implicit none
+  integer :: a(2,9), b(9,7), c(2,7)
+  integer :: i, j
+
+  a = 1
+  b = 2
+  c = 1789789
+  c(:,1:7:2) = matmul(a,b(:,1:7:2))
+
+  if (c(1,1) /= 18 .or. c(2,1) /= 18 .or. &
+      c(1,2) /= 1789789 .or. c(2,2) /= 1789789 .or. &
+      c(1,3) /= 18 .or. c(2,3) /= 18 .or. &
+      c(1,4) /= 1789789 .or. c(2,4) /= 1789789 .or. &
+      c(1,5) /= 18 .or. c(2,5) /= 18 .or. &
+      c(1,6) /= 1789789 .or. c(2,6) /= 1789789 .or. &
+      c(1,7) /= 18 .or. c(2,7) /= 18) call abort
+      
+end program matmul_2
diff --git a/gcc/testsuite/gfortran.dg/matmul_3.f90 b/gcc/testsuite/gfortran.dg/matmul_3.f90
new file mode 100644
index 000000000..65290fecc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/matmul_3.f90
@@ -0,0 +1,36 @@
+! { dg-do run }

+! Check the fix for PR28005, in which the mechanism for dealing

+! with matmul (transpose (a), b) would cause wrong results for

+! matmul (a(i, 1:n), b(1:n, 1:n)).

+!

+! Based on the original testcase contributed by

+! Tobias Burnus  <tobias.burnus@physik.fu-berlin.de>

+!   

+   implicit none

+   integer, parameter         ::  nmax = 3

+   integer                    ::  i, n = 2

+   integer, dimension(nmax,nmax) ::  iB=0 , iC=1

+   integer, dimension(nmax,nmax) ::  iX1=99, iX2=99, iChk

+   iChk = reshape((/30,66,102,36,81,126,42,96,150/),(/3,3/))

+

+! This would give 3, 3, 99

+   iB = reshape((/1 ,3 ,0 ,2 ,5 ,0 ,0 ,0 ,0 /),(/3,3/))

+   iX1(1:n,1) = matmul( iB(2,1:n),iC(1:n,1:n) )

+

+! This would give 4, 4, 99

+   ib(3,1) = 1

+   iX2(1:n,1) = matmul( iB(2,1:n),iC(1:n,1:n) )

+

+! Whereas, we should have 8, 8, 99

+   if (any (iX1(1:n,1) .ne. (/8, 8, 99/))) call abort ()

+   if (any (iX1 .ne. iX2)) call abort ()

+

+! Make sure that the fix does not break transpose temporaries.

+   iB = reshape((/(i, i = 1, 9)/),(/3,3/))

+   ic = transpose (iB)

+   iX1 = transpose (iB)

+   iX1 = matmul (iX1, iC)

+   iX2 = matmul (transpose (iB), iC)

+   if (any (iX1 .ne. iX2)) call abort ()

+   if (any (iX1 .ne. iChk)) call abort ()

+end

diff --git a/gcc/testsuite/gfortran.dg/matmul_4.f90 b/gcc/testsuite/gfortran.dg/matmul_4.f90
new file mode 100644
index 000000000..8bbaef934
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/matmul_4.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! Check the fix for PR28947, in which the mechanism for dealing
+! with matmul (a, transpose (b)) would cause wrong results for
+! a having a rank == 1.
+!
+! Contributed by Harald Anlauf  <anlauf@gmx.de>
+!   
+program gfcbug40
+  implicit none
+
+  real :: h(3,3), mat(2,3)
+
+  h(:,:) = - HUGE (1.0)/4       ! Preset unused elements suitably...
+
+  h(3,:) = 0
+  h(3,3) = 1
+  mat(:,:) = 1
+  h(3,:) = h(3,:) + matmul (matmul (h(3,:), transpose (mat)), mat)
+
+  if (any (h(3,:) .ne. (/2.0, 2.0, 3.0/))) call abort ()
+
+end program gfcbug40
diff --git a/gcc/testsuite/gfortran.dg/matmul_5.f90 b/gcc/testsuite/gfortran.dg/matmul_5.f90
new file mode 100644
index 000000000..b67601f40
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/matmul_5.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! { dg-shouldfail "dimension of array B incorrect in MATMUL intrinsic" }
+program main
+  real, dimension(:,:), allocatable :: a
+  real, dimension(:), allocatable :: b
+  allocate (a(2,2), b(3))
+  call random_number(a)
+  call random_number(b)
+  print *,matmul(a,b)
+end program main
+! { dg-output "Fortran runtime error: dimension of array B incorrect in MATMUL intrinsic.*" }
diff --git a/gcc/testsuite/gfortran.dg/matmul_6.f90 b/gcc/testsuite/gfortran.dg/matmul_6.f90
new file mode 100644
index 000000000..737c5c437
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/matmul_6.f90
@@ -0,0 +1,66 @@
+! { dg-do run }
+! PR 34566 - logical matmul used to give the wrong result.
+! We check this by running through every permutation in
+! multiplying two 3*3 matrices, and all permutations of multiplying
+! a 3-vector and a 3*3 matrices  and checking against equivalence
+! with integer matrix multiply.
+program main
+  implicit none
+  integer, parameter :: ki=4
+  integer, parameter :: dimen=3
+  integer :: i, j, k
+  real, dimension(dimen,dimen) :: r1, r2
+  integer, dimension(dimen,dimen) :: m1, m2
+  logical(kind=ki), dimension(dimen,dimen) :: l1, l2
+  logical(kind=ki), dimension(dimen*dimen) :: laux
+  logical(kind=ki), dimension(dimen) :: lv
+  integer, dimension(dimen) :: iv
+
+  do i=0,2**(dimen*dimen)-1
+     forall (k=1:dimen*dimen)
+        laux(k) = btest(i, k-1)
+     end forall
+     l1 = reshape(laux,shape(l1))
+     m1 = ltoi(l1)
+
+     ! Check matrix*matrix multiply
+     do j=0,2**(dimen*dimen)-1
+        forall (k=1:dimen*dimen)
+           laux(k) = btest(i, k-1)
+        end forall
+        l2 = reshape(laux,shape(l2))
+        m2 = ltoi(l2)
+        if (any(matmul(l1,l2) .neqv. (matmul(m1,m2) /= 0))) then
+          call abort
+        end if
+     end do
+
+     ! Check vector*matrix and matrix*vector multiply.
+     do j=0,2**dimen-1
+        forall (k=1:dimen)
+           lv(k) = btest(j, k-1)
+        end forall
+        iv = ltoi(lv)
+        if (any(matmul(lv,l1) .neqv. (matmul(iv,m1) /=0))) then
+          call abort
+        end if
+        if (any(matmul(l1,lv) .neqv. (matmul(m1,iv) /= 0))) then
+          call abort
+        end if
+     end do
+  end do
+
+contains
+  elemental function ltoi(v)
+    implicit none
+    integer :: ltoi
+    real :: rtoi
+    logical(kind=4), intent(in) :: v
+    if (v) then
+       ltoi = 1
+    else
+       ltoi = 0
+    end if
+  end function ltoi
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/matmul_7.f90 b/gcc/testsuite/gfortran.dg/matmul_7.f90
new file mode 100644
index 000000000..b3f925a21
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/matmul_7.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! PR 35988 - failure on some zero-sized matmuls.
+! Test case contributed by Dick Hendrickson.
+
+       program try_gf1003
+
+      call       gf1003a(  9,  8,  6)   
+      call       gf1003b(  9,  8,  6)   
+      call       gf1003c(  9,  8,  6)   !fails
+      call       gf1003d(  9,  8,  6)   !fails
+      end program
+
+
+      SUBROUTINE GF1003a(nf9,nf8,nf6)
+      REAL RDA(3,2)
+      REAL RDA1(3,5)
+      REAL RDA2(5,2)
+      RDA = MATMUL(RDA1(:, 9:8),RDA2( 8:6,:))
+      END SUBROUTINE
+
+      SUBROUTINE GF1003b(nf9,nf8,nf6)
+      REAL RDA(3,2)
+      REAL RDA1(3,0)
+      REAL RDA2(0,2)
+      RDA = MATMUL(RDA1(:,NF9:NF8),RDA2(NF9:NF8,:))
+      END SUBROUTINE
+
+      SUBROUTINE GF1003c(nf9,nf8,nf6)
+      REAL RDA(3,2)
+      REAL RDA1(3,0)
+      REAL RDA2(0,2)
+      RDA = MATMUL(RDA1(:,NF9:NF8),RDA2(NF8:NF6,:))
+      END SUBROUTINE
+
+      SUBROUTINE GF1003d(nf9,nf8,nf6)
+      REAL RDA(3,2)
+      REAL RDA1(3,5)
+      REAL RDA2(5,2)
+      RDA = MATMUL(RDA1(:,NF9:NF8),RDA2(NF8:NF6,:))
+      END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/matmul_8.f03 b/gcc/testsuite/gfortran.dg/matmul_8.f03
new file mode 100644
index 000000000..fcd4b0d56
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/matmul_8.f03
@@ -0,0 +1,12 @@
+! { dg-do run }
+! Transformational intrinsic MATMUL as initialization expression.
+
+  REAL, PARAMETER :: PI = 3.141592654, theta = PI/6.0
+
+  REAL, PARAMETER :: unity(2,2) = RESHAPE([1.0, 0.0, 0.0, 1.0], [2, 2])
+  REAL, PARAMETER :: m1(2,2)    = RESHAPE([COS(theta), SIN(theta), -SIN(theta), COS(theta)], [2, 2])
+  REAL, PARAMETER :: m2(2,2)    = RESHAPE([COS(theta), -SIN(theta), SIN(theta), COS(theta)], [2, 2])
+  REAL, PARAMETER :: m(2,2)     = MATMUL(m1, m2)
+
+  IF (ANY(ABS(m - unity) > EPSILON(0.0))) CALL abort()
+END
diff --git a/gcc/testsuite/gfortran.dg/matmul_9.f90 b/gcc/testsuite/gfortran.dg/matmul_9.f90
new file mode 100644
index 000000000..bf2a299c8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/matmul_9.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/56318
+!
+! Contributed by Alberto Luaces
+!
+SUBROUTINE mass_matrix        
+  DOUBLE PRECISION,PARAMETER::m1=1.d0
+  DOUBLE PRECISION,DIMENSION(3,2),PARAMETER::A1=reshape([1.d0,0.d0, 0.d0, &
+       0.d0,1.d0, 0.d0],[3,2])
+  DOUBLE PRECISION,DIMENSION(2,2),PARAMETER::Mel=reshape([1.d0/3.d0, 0.d0, &
+       0.d0, 1.d0/3.d0],[2,2])
+
+  DOUBLE PRECISION,DIMENSION(3,3)::MM1
+
+  MM1=m1*matmul(A1,matmul(Mel,transpose(A1)))
+  !print '(3f8.3)', MM1
+  if (any (abs (MM1 &
+                - reshape ([1.d0/3.d0, 0.d0,      0.d0,  &
+                            0.d0,      1.d0/3.d0, 0.d0,  &
+                            0.d0,      0.d0,      0.d0], &
+                           [3,3])) > epsilon(1.0d0))) &
+    call abort ()
+END SUBROUTINE mass_matrix
+
+program name
+  implicit none
+  integer, parameter :: A(3,2) = reshape([1,2,3,4,5,6],[3,2])
+  integer, parameter :: B(2,3) = reshape([3,17,23,31,43,71],[2,3])
+  integer, parameter :: C(3)   = [-5,-7,-21]
+  integer, parameter :: m1 = 1
+
+!  print *, matmul(B,C)
+   if (any (matmul(B,C) /= [-1079, -1793])) call abort()
+!  print *, matmul(C,A)
+   if (any (matmul(C,A) /= [-82, -181])) call abort()
+!  print '(3i5)', m1*matmul(A,B)
+  if (any (m1*matmul(A,B) /= reshape([71,91,111, 147,201,255, 327,441,555],&
+                                     [3,3]))) &
+     call abort()
+  call mass_matrix
+end program name
+
+! { dg-final { scan-tree-dump-times "matmul" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/matmul_argument_types.f90 b/gcc/testsuite/gfortran.dg/matmul_argument_types.f90
new file mode 100644
index 000000000..1480655c4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/matmul_argument_types.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+!
+! PR fortran/36355
+! Check MATMUL argument types:
+!
+!           numeric   logical   other
+! numeric      1         2        3
+! logical      2         1        3
+! other        3         3        3
+!
+! where
+!   1    ok
+!   2    argument type mismatch
+!   3    invalid argument types
+!
+
+  INTEGER :: a(2,2)
+  LOGICAL :: b(2,2)
+  CHARACTER :: c
+
+  a = MATMUL(a, a)            ! ok
+  a = MATMUL(a, b)            ! { dg-error "must match" }
+  a = MATMUL(a, c)            ! { dg-error "must be numeric or LOGICAL" }
+
+  b = MATMUL(b, a)            ! { dg-error "must match" }
+  b = MATMUL(b, b)            ! ok
+  b = MATMUL(b, c)            ! { dg-error "must be numeric or LOGICAL" }
+
+  c = MATMUL(c, a)            ! { dg-error "must be numeric or LOGICAL" }
+  c = MATMUL(c, b)            ! { dg-error "must be numeric or LOGICAL" }
+  c = MATMUL(c, c)            ! { dg-error "must be numeric or LOGICAL" }
+END
diff --git a/gcc/testsuite/gfortran.dg/matmul_bounds_1.f90 b/gcc/testsuite/gfortran.dg/matmul_bounds_1.f90
new file mode 100644
index 000000000..1d180a0d4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/matmul_bounds_1.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+program matmul_bounds_1
+  implicit none
+  real, dimension(3,2) :: a
+  real, dimension(2,3) :: b
+  real, dimension(3,2) :: rab
+  real, dimension(2,2) :: rok
+  real, dimension(2) :: rv
+  real, dimension(3) :: rw
+  real, dimension(3) :: x
+  real, dimension(2) :: y
+  a = 1
+  b = 2
+  x = 3
+  y = 4
+  ! These tests should throw an error
+  rab = matmul(a,b) ! { dg-error "Different shape" }
+  rv = matmul(a,y) ! { dg-error "Different shape" }
+  rv = matmul(x,b) ! { dg-error "Different shape" }
+  ! These are ok.
+  rw = matmul(a,y)
+  rv = matmul(x,a)
+  rok = matmul(b,a)
+end program matmul_bounds_1
+
diff --git a/gcc/testsuite/gfortran.dg/matmul_bounds_2.f90 b/gcc/testsuite/gfortran.dg/matmul_bounds_2.f90
new file mode 100644
index 000000000..978751e70
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/matmul_bounds_2.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check -fno-realloc-lhs" }
+! { dg-shouldfail "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 2: is 2, should be 3" }
+program main
+  real, dimension(3,2) :: a
+  real, dimension(2,3) :: b
+  real, dimension(:,:), allocatable :: ret
+  allocate (ret(2,2))
+  a = 1.0
+  b = 2.3
+  ret = matmul(b,a)  ! This is OK
+  deallocate(ret)
+  allocate(ret(3,2))
+  ret = matmul(a,b)  ! This should throw an error.
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 2: is 2, should be 3" }
diff --git a/gcc/testsuite/gfortran.dg/matmul_bounds_3.f90 b/gcc/testsuite/gfortran.dg/matmul_bounds_3.f90
new file mode 100644
index 000000000..4b80f8c2b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/matmul_bounds_3.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check -fno-realloc-lhs" }
+! { dg-shouldfail "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 1: is 2, should be 3" }
+program main
+  real, dimension(3,2) :: a
+  real, dimension(2,3) :: b
+  real, dimension(:,:), allocatable :: ret
+  allocate (ret(3,3))
+  a = 1.0
+  b = 2.3
+  ret = matmul(a,b)  ! This is OK
+  deallocate(ret)
+  allocate(ret(2,3))
+  ret = matmul(a,b)  ! This should throw an error.
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 1: is 2, should be 3" }
diff --git a/gcc/testsuite/gfortran.dg/matmul_bounds_4.f90 b/gcc/testsuite/gfortran.dg/matmul_bounds_4.f90
new file mode 100644
index 000000000..94add6ce8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/matmul_bounds_4.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check -fno-realloc-lhs" }
+! { dg-shouldfail "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic: is 3, should be 2" }
+program main
+  real, dimension(3) :: a
+  real, dimension(3,2) :: b
+  real, dimension(:), allocatable :: ret
+  allocate (ret(2))
+  a = 1.0
+  b = 2.3
+  ret = matmul(a,b)  ! This is OK
+  deallocate(ret)
+  allocate(ret(3))
+  ret = matmul(a,b)  ! This should throw an error.
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic: is 3, should be 2" }
diff --git a/gcc/testsuite/gfortran.dg/matmul_bounds_5.f90 b/gcc/testsuite/gfortran.dg/matmul_bounds_5.f90
new file mode 100644
index 000000000..5261e8e44
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/matmul_bounds_5.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check -fno-realloc-lhs" }
+! { dg-shouldfail "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic: is 3, should be 2" }
+program main
+  real, dimension(2,3) :: a
+  real, dimension(3) :: b
+  real, dimension(:), allocatable :: ret
+  allocate (ret(2))
+  a = 1.0
+  b = 2.3
+  ret = matmul(a,b)  ! This is OK
+  deallocate(ret)
+  allocate(ret(3))
+  ret = matmul(a,b)  ! This should throw an error.
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic: is 3, should be 2" }
diff --git a/gcc/testsuite/gfortran.dg/maxloc_1.f90 b/gcc/testsuite/gfortran.dg/maxloc_1.f90
new file mode 100644
index 000000000..41115eda9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_1.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+  integer :: a(3), n
+  a(1) = -huge(n)
+  a(2) = -huge(n)
+  a(3) = -huge(n)
+  a(1) = a(1) - 1
+  a(2) = a(2) - 1
+  a(3) = a(3) - 1
+  n = maxloc (a, dim = 1)
+  if (n .ne. 1) call abort
+  a(2) = -huge(n)
+  n = maxloc (a, dim = 1)
+  if (n .ne. 2) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_1.f90 b/gcc/testsuite/gfortran.dg/maxloc_bounds_1.f90
new file mode 100644
index 000000000..a107db201
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_1.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic in dimension 1: is 3, should be 2" }
+program main
+  integer(kind=4), allocatable :: f(:,:)
+  integer(kind=4) :: res(3)
+  character(len=80) line
+  allocate (f(2,2))
+  f = 3
+  res = maxloc(f,dim=1)
+  write(line,fmt='(80I1)') res
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic in dimension 1: is 3, should be 2" }
+
diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_2.f90 b/gcc/testsuite/gfortran.dg/maxloc_bounds_2.f90
new file mode 100644
index 000000000..39af3cb9f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_2.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic in dimension 1: is 3, should be 2" }
+program main
+  integer(kind=4), allocatable :: f(:,:)
+  logical, allocatable :: m(:,:)
+  integer(kind=4) :: res(3)
+  character(len=80) line
+  allocate (f(2,2),m(2,2))
+  f = 3
+  m = .true.
+  res = maxloc(f,dim=1,mask=m)
+  write(line,fmt='(80I1)') res
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic in dimension 1: is 3, should be 2" }
+
diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_3.f90 b/gcc/testsuite/gfortran.dg/maxloc_bounds_3.f90
new file mode 100644
index 000000000..41df6a8d0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_3.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect extent in MASK argument of MAXLOC intrinsic in dimension 2: is 3, should be 2" }
+program main
+  integer(kind=4), allocatable :: f(:,:)
+  logical, allocatable :: m(:,:)
+  integer(kind=4) :: res(2)
+  character(len=80) line
+  allocate (f(2,2),m(2,3))
+  f = 3
+  m = .true.
+  res = maxloc(f,dim=1,mask=m)
+  write(line,fmt='(80I1)') res
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in MASK argument of MAXLOC intrinsic in dimension 2: is 3, should be 2" }
+
diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90 b/gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90
new file mode 100644
index 000000000..7ba103d61
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
+module tst
+contains
+  subroutine foo(res)
+    integer(kind=4), allocatable :: f(:,:)
+    integer, dimension(:) :: res
+    allocate (f(2,5))
+    f = 3
+    res = maxloc(f)
+  end subroutine foo
+
+end module tst
+program main
+  use tst
+  implicit none
+  integer :: res(3)
+  call foo(res)
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
+! { dg-final { cleanup-modules "tst" } }
+
diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90 b/gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90
new file mode 100644
index 000000000..34d06da55
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
+module tst
+contains
+  subroutine foo(res)
+    integer(kind=4), allocatable :: f(:,:)
+    integer, dimension(:) :: res
+    allocate (f(2,5))
+    f = 3
+    res = maxloc(f,mask=f>2)
+  end subroutine foo
+
+end module tst
+program main
+  use tst
+  implicit none
+  integer :: res(3)
+  call foo(res)
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
+! { dg-final { cleanup-modules "tst" } }
diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_6.f90 b/gcc/testsuite/gfortran.dg/maxloc_bounds_6.f90
new file mode 100644
index 000000000..3a63418ae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_6.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect extent in MASK argument of MAXLOC intrinsic in dimension 2: is 3, should be 2" }
+program main
+  integer(kind=4), allocatable :: f(:,:)
+  logical, allocatable :: m(:,:)
+  integer(kind=4) :: res(2)
+  character(len=80) line
+  allocate (f(2,2),m(2,3))
+  f = 3
+  m = .true.
+  res = maxloc(f,mask=m)
+  write(line,fmt='(80I1)') res
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in MASK argument of MAXLOC intrinsic in dimension 2: is 3, should be 2" }
diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90 b/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
new file mode 100644
index 000000000..817bf8fac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
+module tst
+contains
+  subroutine foo(res)
+    integer(kind=4), allocatable :: f(:,:)
+    integer, dimension(:) :: res
+    allocate (f(2,5))
+    f = 3
+    res = maxloc(f,mask=.true.)
+  end subroutine foo
+
+end module tst
+program main
+  use tst
+  implicit none
+  integer :: res(3)
+  call foo(res)
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
+! { dg-final { cleanup-modules "tst" } }
diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_8.f90 b/gcc/testsuite/gfortran.dg/maxloc_bounds_8.f90
new file mode 100644
index 000000000..4ec113716
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_8.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic in dimension 1: is 3, should be 2" }
+program main
+  integer(kind=4), allocatable :: f(:,:)
+  logical, allocatable :: m(:,:)
+  integer(kind=4) :: res(3)
+  character(len=80) line
+  allocate (f(2,2),m(2,2))
+  f = 3
+  m = .true.
+  res = maxloc(f,dim=1,mask=.true.)
+  write(line,fmt='(80I1)') res
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic in dimension 1: is 3, should be 2" }
+
diff --git a/gcc/testsuite/gfortran.dg/maxloc_shape_1.f90 b/gcc/testsuite/gfortran.dg/maxloc_shape_1.f90
new file mode 100644
index 000000000..0004f67f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_shape_1.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! Tests the implementation of compile-time shape testing, required to fix
+! PR19015.  The functionality of maxloc and friends is tested by existing
+! testcases.
+!
+! Contributed by Thomas Koeing  <Thomas.Koenig@online.de>
+!
+  integer, dimension(0:1,0:1) :: n
+  integer, dimension(1) :: i
+  n = reshape((/1, 2, 3, 4/), shape(n))
+  i = maxloc(n) ! { dg-error "Different shape for array assignment" }
+  i = maxloc(n,dim=1) ! { dg-error "Different shape for array assignment" }
+!  print *,i
+end program
diff --git a/gcc/testsuite/gfortran.dg/maxlocval_1.f90 b/gcc/testsuite/gfortran.dg/maxlocval_1.f90
new file mode 100644
index 000000000..11a92ca77
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxlocval_1.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+! Check that maxval uses for integers HUGE()-1.
+! PR fortran/30512
+
+program main
+implicit none
+integer(1) :: i1(3), a1(3:2)
+integer(2) :: i2(3), a2(3:2)
+integer(4) :: i4(3), a4(3:2)
+integer(8) :: i8(3), a8(3:2)
+
+integer(kind=4), allocatable :: a(:,:)
+integer(kind=8), allocatable :: b(:,:)
+
+logical :: msk(3)
+msk = .false.
+
+i1 = 1
+i2 = 1
+i4 = 1
+i8 = 1
+
+if(-huge(i1)-1_1 /= maxval(i1, msk)) call abort() ! { dg-warning "outside symmetric range implied by Standard Fortran" }
+if(-huge(a1)-1_1 /= maxval(a1))      call abort() ! { dg-warning "outside symmetric range implied by Standard Fortran" }
+
+if(-huge(i2)-1_2 /= maxval(i2, msk)) call abort() ! { dg-warning "outside symmetric range implied by Standard Fortran" }
+if(-huge(a2)-1_2 /= maxval(a2))      call abort() ! { dg-warning "outside symmetric range implied by Standard Fortran" }
+
+if(-huge(i4)-1_4 /= maxval(i4, msk)) call abort() ! { dg-warning "outside symmetric range implied by Standard Fortran" }
+if(-huge(a4)-1_4 /= maxval(a4))      call abort() ! { dg-warning "outside symmetric range implied by Standard Fortran" }
+
+if(-huge(i8)-1_4 /= maxval(i8, msk)) call abort() ! { dg-warning "outside symmetric range implied by Standard Fortran" }
+if(-huge(a8)-1_4 /= maxval(a8))      call abort() ! { dg-warning "outside symmetric range implied by Standard Fortran" }
+
+allocate (a(0:-1,1:1))
+allocate (b(0:-1,1:1))
+
+if(any(maxval(a,dim=1) /= -huge(a)-1_4)) call abort() ! { dg-warning "outside symmetric range implied by Standard Fortran" }
+if(any(minval(a,dim=1) /=  huge(a)    )) call abort()
+
+if(any(maxval(b,dim=1) /= -huge(b)-1_8)) call abort() ! { dg-warning "outside symmetric range implied by Standard Fortran" }
+if(any(minval(b,dim=1) /=  huge(b)    )) call abort()
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/maxlocval_2.f90 b/gcc/testsuite/gfortran.dg/maxlocval_2.f90
new file mode 100644
index 000000000..5f6b913b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxlocval_2.f90
@@ -0,0 +1,155 @@
+! { dg-do run }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+  real :: a(3), nan, minf, pinf
+  real, allocatable :: c(:)
+  logical :: l
+  logical :: l2(3)
+
+  nan = 0.0
+  minf = 0.0
+  pinf = 0.0
+  nan = 0.0/nan
+  minf = -1.0/minf
+  pinf = 1.0/pinf
+
+  allocate (c(3))
+  a(:) = nan
+  if (maxloc (a, dim = 1).ne.1) call abort
+  if (.not.isnan(maxval (a, dim = 1))) call abort
+  a(:) = minf
+  if (maxloc (a, dim = 1).ne.1) call abort
+  if (maxval (a, dim = 1).ne.minf) call abort
+  a(1:2) = nan
+  if (maxloc (a, dim = 1).ne.3) call abort
+  if (maxval (a, dim = 1).ne.minf) call abort
+  a(2) = 1.0
+  if (maxloc (a, dim = 1).ne.2) call abort
+  if (maxval (a, dim = 1).ne.1) call abort
+  a(2) = pinf
+  if (maxloc (a, dim = 1).ne.2) call abort
+  if (maxval (a, dim = 1).ne.pinf) call abort
+  c(:) = nan
+  if (maxloc (c, dim = 1).ne.1) call abort
+  if (.not.isnan(maxval (c, dim = 1))) call abort
+  c(:) = minf
+  if (maxloc (c, dim = 1).ne.1) call abort
+  if (maxval (c, dim = 1).ne.minf) call abort
+  c(1:2) = nan
+  if (maxloc (c, dim = 1).ne.3) call abort
+  if (maxval (c, dim = 1).ne.minf) call abort
+  c(2) = 1.0
+  if (maxloc (c, dim = 1).ne.2) call abort
+  if (maxval (c, dim = 1).ne.1) call abort
+  c(2) = pinf
+  if (maxloc (c, dim = 1).ne.2) call abort
+  if (maxval (c, dim = 1).ne.pinf) call abort
+  l = .false.
+  l2(:) = .false.
+  a(:) = nan
+  if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l).ne.-huge(minf)) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l2).ne.-huge(minf)) call abort
+  a(:) = minf
+  if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l).ne.-huge(minf)) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l2).ne.-huge(minf)) call abort
+  a(1:2) = nan
+  if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l).ne.-huge(minf)) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l2).ne.-huge(minf)) call abort
+  a(2) = 1.0
+  if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l).ne.-huge(minf)) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l2).ne.-huge(minf)) call abort
+  a(2) = pinf
+  if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l).ne.-huge(minf)) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l2).ne.-huge(minf)) call abort
+  c(:) = nan
+  if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l).ne.-huge(minf)) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l2).ne.-huge(minf)) call abort
+  c(:) = minf
+  if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l).ne.-huge(minf)) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l2).ne.-huge(minf)) call abort
+  c(1:2) = nan
+  if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l).ne.-huge(minf)) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l2).ne.-huge(minf)) call abort
+  c(2) = 1.0
+  if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l).ne.-huge(minf)) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l2).ne.-huge(minf)) call abort
+  c(2) = pinf
+  if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l).ne.-huge(minf)) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l2).ne.-huge(minf)) call abort
+  l = .true.
+  l2(:) = .true.
+  a(:) = nan
+  if (maxloc (a, dim = 1, mask = l).ne.1) call abort
+  if (.not.isnan(maxval (a, dim = 1, mask = l))) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.1) call abort
+  if (.not.isnan(maxval (a, dim = 1, mask = l2))) call abort
+  a(:) = minf
+  if (maxloc (a, dim = 1, mask = l).ne.1) call abort
+  if (maxval (a, dim = 1, mask = l).ne.minf) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.1) call abort
+  if (maxval (a, dim = 1, mask = l2).ne.minf) call abort
+  a(1:2) = nan
+  if (maxloc (a, dim = 1, mask = l).ne.3) call abort
+  if (maxval (a, dim = 1, mask = l).ne.minf) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.3) call abort
+  if (maxval (a, dim = 1, mask = l2).ne.minf) call abort
+  a(2) = 1.0
+  if (maxloc (a, dim = 1, mask = l).ne.2) call abort
+  if (maxval (a, dim = 1, mask = l).ne.1) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.2) call abort
+  if (maxval (a, dim = 1, mask = l2).ne.1) call abort
+  a(2) = pinf
+  if (maxloc (a, dim = 1, mask = l).ne.2) call abort
+  if (maxval (a, dim = 1, mask = l).ne.pinf) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.2) call abort
+  if (maxval (a, dim = 1, mask = l2).ne.pinf) call abort
+  c(:) = nan
+  if (maxloc (c, dim = 1, mask = l).ne.1) call abort
+  if (.not.isnan(maxval (c, dim = 1, mask = l))) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.1) call abort
+  if (.not.isnan(maxval (c, dim = 1, mask = l2))) call abort
+  c(:) = minf
+  if (maxloc (c, dim = 1, mask = l).ne.1) call abort
+  if (maxval (c, dim = 1, mask = l).ne.minf) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.1) call abort
+  if (maxval (c, dim = 1, mask = l2).ne.minf) call abort
+  c(1:2) = nan
+  if (maxloc (c, dim = 1, mask = l).ne.3) call abort
+  if (maxval (c, dim = 1, mask = l).ne.minf) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.3) call abort
+  if (maxval (c, dim = 1, mask = l2).ne.minf) call abort
+  c(2) = 1.0
+  if (maxloc (c, dim = 1, mask = l).ne.2) call abort
+  if (maxval (c, dim = 1, mask = l).ne.1) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.2) call abort
+  if (maxval (c, dim = 1, mask = l2).ne.1) call abort
+  c(2) = pinf
+  if (maxloc (c, dim = 1, mask = l).ne.2) call abort
+  if (maxval (c, dim = 1, mask = l).ne.pinf) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.2) call abort
+  if (maxval (c, dim = 1, mask = l2).ne.pinf) call abort
+  deallocate (c)
+  allocate (c(-2:-3))
+  if (maxloc (c, dim = 1).ne.0) call abort
+  if (maxval (c, dim = 1).ne.-huge(minf)) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/maxlocval_3.f90 b/gcc/testsuite/gfortran.dg/maxlocval_3.f90
new file mode 100644
index 000000000..cbd35957b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxlocval_3.f90
@@ -0,0 +1,122 @@
+! { dg-do run }
+  integer :: a(3), h
+  integer, allocatable :: c(:)
+  logical :: l
+  logical :: l2(3)
+
+  h = -huge(h)
+  h = h - 1
+  allocate (c(3))
+  a(:) = 5
+  if (maxloc (a, dim = 1).ne.1) call abort
+  if (maxval (a, dim = 1).ne.5) call abort
+  a(2) = huge(h)
+  if (maxloc (a, dim = 1).ne.2) call abort
+  if (maxval (a, dim = 1).ne.huge(h)) call abort
+  a(:) = h
+  if (maxloc (a, dim = 1).ne.1) call abort
+  if (maxval (a, dim = 1).ne.h) call abort
+  a(3) = -huge(h)
+  if (maxloc (a, dim = 1).ne.3) call abort
+  if (maxval (a, dim = 1).ne.-huge(h)) call abort
+  c(:) = 5
+  if (maxloc (c, dim = 1).ne.1) call abort
+  if (maxval (c, dim = 1).ne.5) call abort
+  c(2) = huge(h)
+  if (maxloc (c, dim = 1).ne.2) call abort
+  if (maxval (c, dim = 1).ne.huge(h)) call abort
+  c(:) = h
+  if (maxloc (c, dim = 1).ne.1) call abort
+  if (maxval (c, dim = 1).ne.h) call abort
+  c(3) = -huge(h)
+  if (maxloc (c, dim = 1).ne.3) call abort
+  if (maxval (c, dim = 1).ne.-huge(h)) call abort
+  l = .false.
+  l2(:) = .false.
+  a(:) = 5
+  if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l).ne.h) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l2).ne.h) call abort
+  a(2) = huge(h)
+  if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l).ne.h) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l2).ne.h) call abort
+  a(:) = h
+  if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l).ne.h) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l2).ne.h) call abort
+  a(3) = -huge(h)
+  if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l).ne.h) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (a, dim = 1, mask = l2).ne.h) call abort
+  c(:) = 5
+  if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l).ne.h) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l2).ne.h) call abort
+  c(2) = huge(h)
+  if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l).ne.h) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l2).ne.h) call abort
+  c(:) = h
+  if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l).ne.h) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l2).ne.h) call abort
+  c(3) = -huge(h)
+  if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l).ne.h) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (maxval (c, dim = 1, mask = l2).ne.h) call abort
+  l = .true.
+  l2(:) = .true.
+  a(:) = 5
+  if (maxloc (a, dim = 1, mask = l).ne.1) call abort
+  if (maxval (a, dim = 1, mask = l).ne.5) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.1) call abort
+  if (maxval (a, dim = 1, mask = l2).ne.5) call abort
+  a(2) = huge(h)
+  if (maxloc (a, dim = 1, mask = l).ne.2) call abort
+  if (maxval (a, dim = 1, mask = l).ne.huge(h)) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.2) call abort
+  if (maxval (a, dim = 1, mask = l2).ne.huge(h)) call abort
+  a(:) = h
+  if (maxloc (a, dim = 1, mask = l).ne.1) call abort
+  if (maxval (a, dim = 1, mask = l).ne.h) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.1) call abort
+  if (maxval (a, dim = 1, mask = l2).ne.h) call abort
+  a(3) = -huge(h)
+  if (maxloc (a, dim = 1, mask = l).ne.3) call abort
+  if (maxval (a, dim = 1, mask = l).ne.-huge(h)) call abort
+  if (maxloc (a, dim = 1, mask = l2).ne.3) call abort
+  if (maxval (a, dim = 1, mask = l2).ne.-huge(h)) call abort
+  c(:) = 5
+  if (maxloc (c, dim = 1, mask = l).ne.1) call abort
+  if (maxval (c, dim = 1, mask = l).ne.5) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.1) call abort
+  if (maxval (c, dim = 1, mask = l2).ne.5) call abort
+  c(2) = huge(h)
+  if (maxloc (c, dim = 1, mask = l).ne.2) call abort
+  if (maxval (c, dim = 1, mask = l).ne.huge(h)) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.2) call abort
+  if (maxval (c, dim = 1, mask = l2).ne.huge(h)) call abort
+  c(:) = h
+  if (maxloc (c, dim = 1, mask = l).ne.1) call abort
+  if (maxval (c, dim = 1, mask = l).ne.h) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.1) call abort
+  if (maxval (c, dim = 1, mask = l2).ne.h) call abort
+  c(3) = -huge(h)
+  if (maxloc (c, dim = 1, mask = l).ne.3) call abort
+  if (maxval (c, dim = 1, mask = l).ne.-huge(h)) call abort
+  if (maxloc (c, dim = 1, mask = l2).ne.3) call abort
+  if (maxval (c, dim = 1, mask = l2).ne.-huge(h)) call abort
+  deallocate (c)
+  allocate (c(-2:-3))
+  if (maxloc (c, dim = 1).ne.0) call abort
+  if (maxval (c, dim = 1).ne.h) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/maxlocval_4.f90 b/gcc/testsuite/gfortran.dg/maxlocval_4.f90
new file mode 100644
index 000000000..029abe3d1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxlocval_4.f90
@@ -0,0 +1,120 @@
+! { dg-do run }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+  real :: a(3,3), b(3), nan, minf, pinf, h
+  logical :: l, l2
+  logical :: l3(3,3), l4(3,3), l5(3,3)
+
+  nan = 0.0
+  minf = 0.0
+  pinf = 0.0
+  nan = 0.0/nan
+  minf = -1.0/minf
+  pinf = 1.0/pinf
+  h = -huge(h)
+  l = .false.
+  l2 = .true.
+  l3 = .false.
+  l4 = .true.
+  l5 = .true.
+  l5(1,1) = .false.
+  l5(1,2) = .false.
+  l5(2,3) = .false.
+  a = reshape ((/ nan, nan, nan, minf, minf, minf, minf, pinf, minf /), (/ 3, 3 /))
+  if (maxval (a).ne.pinf) call abort
+  if (any (maxloc (a).ne.(/ 2, 3 /))) call abort
+  b = maxval (a, dim = 1)
+  if (.not.isnan(b(1))) call abort
+  b(1) = 0.0
+  if (any (b.ne.(/ 0.0, minf, pinf /))) call abort
+  if (any (maxloc (a, dim = 1).ne.(/ 1, 1, 2 /))) call abort
+  b = maxval (a, dim = 2)
+  if (any (b.ne.(/ minf, pinf, minf /))) call abort
+  if (any (maxloc (a, dim = 2).ne.(/ 2, 3, 2 /))) call abort
+  if (maxval (a, mask = l).ne.h) call abort
+  if (any (maxloc (a, mask = l).ne.(/ 0, 0 /))) call abort
+  b = maxval (a, dim = 1, mask = l)
+  if (any (b.ne.(/ h, h, h /))) call abort
+  if (any (maxloc (a, dim = 1, mask = l).ne.(/ 0, 0, 0 /))) call abort
+  b = maxval (a, dim = 2, mask = l)
+  if (any (b.ne.(/ h, h, h /))) call abort
+  if (any (maxloc (a, dim = 2, mask = l).ne.(/ 0, 0, 0 /))) call abort
+  if (maxval (a, mask = l3).ne.h) call abort
+  if (any (maxloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
+  b = maxval (a, dim = 1, mask = l3)
+  if (any (b.ne.(/ h, h, h /))) call abort
+  if (any (maxloc (a, dim = 1, mask = l3).ne.(/ 0, 0, 0 /))) call abort
+  b = maxval (a, dim = 2, mask = l3)
+  if (any (b.ne.(/ h, h, h /))) call abort
+  if (any (maxloc (a, dim = 2, mask = l3).ne.(/ 0, 0, 0 /))) call abort
+  if (maxval (a, mask = l2).ne.pinf) call abort
+  if (maxval (a, mask = l4).ne.pinf) call abort
+  if (any (maxloc (a, mask = l2).ne.(/ 2, 3 /))) call abort
+  if (any (maxloc (a, mask = l4).ne.(/ 2, 3 /))) call abort
+  b = maxval (a, dim = 1, mask = l2)
+  if (.not.isnan(b(1))) call abort
+  b(1) = 0.0
+  if (any (b.ne.(/ 0.0, minf, pinf /))) call abort
+  if (any (maxloc (a, dim = 1, mask = l2).ne.(/ 1, 1, 2 /))) call abort
+  b = maxval (a, dim = 2, mask = l2)
+  if (any (b.ne.(/ minf, pinf, minf /))) call abort
+  if (any (maxloc (a, dim = 2, mask = l2).ne.(/ 2, 3, 2 /))) call abort
+  b = maxval (a, dim = 1, mask = l4)
+  if (.not.isnan(b(1))) call abort
+  b(1) = 0.0
+  if (any (b.ne.(/ 0.0, minf, pinf /))) call abort
+  if (any (maxloc (a, dim = 1, mask = l2).ne.(/ 1, 1, 2 /))) call abort
+  b = maxval (a, dim = 2, mask = l4)
+  if (any (b.ne.(/ minf, pinf, minf /))) call abort
+  if (any (maxloc (a, dim = 2, mask = l2).ne.(/ 2, 3, 2 /))) call abort
+  if (maxval (a, mask = l5).ne.minf) call abort
+  if (any (maxloc (a, mask = l5).ne.(/ 2, 2 /))) call abort
+  b = maxval (a, dim = 1, mask = l5)
+  if (.not.isnan(b(1))) call abort
+  b(1) = 0.0
+  if (any (b.ne.(/ 0.0, minf, minf /))) call abort
+  if (any (maxloc (a, dim = 1, mask = l5).ne.(/ 2, 2, 1 /))) call abort
+  b = maxval (a, dim = 2, mask = l5)
+  if (any (b.ne.(/ minf, minf, minf /))) call abort
+  if (any (maxloc (a, dim = 2, mask = l5).ne.(/ 3, 2, 2 /))) call abort
+  a = nan
+  if (.not.isnan(maxval (a))) call abort
+  if (maxval (a, mask = l).ne.h) call abort
+  if (.not.isnan(maxval (a, mask = l2))) call abort
+  if (maxval (a, mask = l3).ne.h) call abort
+  if (.not.isnan(maxval (a, mask = l4))) call abort
+  if (.not.isnan(maxval (a, mask = l5))) call abort
+  if (any (maxloc (a).ne.(/ 1, 1 /))) call abort
+  if (any (maxloc (a, mask = l).ne.(/ 0, 0 /))) call abort
+  if (any (maxloc (a, mask = l2).ne.(/ 1, 1 /))) call abort
+  if (any (maxloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
+  if (any (maxloc (a, mask = l4).ne.(/ 1, 1 /))) call abort
+  if (any (maxloc (a, mask = l5).ne.(/ 2, 1 /))) call abort
+  a = minf
+  if (maxval (a).ne.minf) call abort
+  if (maxval (a, mask = l).ne.h) call abort
+  if (maxval (a, mask = l2).ne.minf) call abort
+  if (maxval (a, mask = l3).ne.h) call abort
+  if (maxval (a, mask = l4).ne.minf) call abort
+  if (maxval (a, mask = l5).ne.minf) call abort
+  if (any (maxloc (a).ne.(/ 1, 1 /))) call abort
+  if (any (maxloc (a, mask = l).ne.(/ 0, 0 /))) call abort
+  if (any (maxloc (a, mask = l2).ne.(/ 1, 1 /))) call abort
+  if (any (maxloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
+  if (any (maxloc (a, mask = l4).ne.(/ 1, 1 /))) call abort
+  if (any (maxloc (a, mask = l5).ne.(/ 2, 1 /))) call abort
+  a = nan
+  a(1,3) = minf
+  if (maxval (a).ne.minf) call abort
+  if (maxval (a, mask = l).ne.h) call abort
+  if (maxval (a, mask = l2).ne.minf) call abort
+  if (maxval (a, mask = l3).ne.h) call abort
+  if (maxval (a, mask = l4).ne.minf) call abort
+  if (maxval (a, mask = l5).ne.minf) call abort
+  if (any (maxloc (a).ne.(/ 1, 3 /))) call abort
+  if (any (maxloc (a, mask = l).ne.(/ 0, 0 /))) call abort
+  if (any (maxloc (a, mask = l2).ne.(/ 1, 3 /))) call abort
+  if (any (maxloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
+  if (any (maxloc (a, mask = l4).ne.(/ 1, 3 /))) call abort
+  if (any (maxloc (a, mask = l5).ne.(/ 1, 3 /))) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/maxval_maxloc_conformance_1.f90 b/gcc/testsuite/gfortran.dg/maxval_maxloc_conformance_1.f90
new file mode 100644
index 000000000..3925eca31
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxval_maxloc_conformance_1.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! PR 26039:  Tests for different ranks for (min|max)loc, (min|max)val, product
+!            and sum were missing.
+program main
+  integer, dimension(2) :: a
+  logical, dimension(2,1) :: lo
+  logical, dimension(3) :: lo2
+  a = (/ 1, 2 /)
+  lo = .true.
+  print *,minloc(a,mask=lo) ! { dg-error "Incompatible ranks" }
+  print *,maxloc(a,mask=lo) ! { dg-error "Incompatible ranks" }
+  print *,minval(a,mask=lo) ! { dg-error "Incompatible ranks" }
+  print *,maxval(a,mask=lo) ! { dg-error "Incompatible ranks" }
+  print *,sum(a,mask=lo) ! { dg-error "Incompatible ranks" }
+  print *,product(a,mask=lo) ! { dg-error "Incompatible ranks" }
+  print *,minloc(a,1,mask=lo) ! { dg-error "Incompatible ranks" }
+  print *,maxloc(a,1,mask=lo) ! { dg-error "Incompatible ranks" }
+  print *,minval(a,1,mask=lo) ! { dg-error "Incompatible ranks" }
+  print *,maxval(a,1,mask=lo) ! { dg-error "Incompatible ranks" }
+  print *,sum(a,1,mask=lo) ! { dg-error "Incompatible ranks" }
+  print *,product(a,1,mask=lo) ! { dg-error "Incompatible ranks" }
+
+  print *,minloc(a,mask=lo2) ! { dg-error "Different shape" }
+  print *,maxloc(a,mask=lo2) ! { dg-error "Different shape" }
+  print *,minval(a,mask=lo2) ! { dg-error "Different shape" }
+  print *,maxval(a,mask=lo2) ! { dg-error "Different shape" }
+  print *,sum(a,mask=lo2) ! { dg-error "Different shape" }
+  print *,product(a,mask=lo2) ! { dg-error "Different shape" }
+  print *,minloc(a,1,mask=lo2) ! { dg-error "Different shape" }
+  print *,maxloc(a,1,mask=lo2) ! { dg-error "Different shape" }
+  print *,minval(a,1,mask=lo2) ! { dg-error "Different shape" }
+  print *,maxval(a,1,mask=lo2) ! { dg-error "Different shape" }
+  print *,sum(a,1,mask=lo2) ! { dg-error "Different shape" }
+  print *,product(a,1,mask=lo2) ! { dg-error "Different shape" }
+end program main
diff --git a/gcc/testsuite/gfortran.dg/mclock.f90 b/gcc/testsuite/gfortran.dg/mclock.f90
new file mode 100644
index 000000000..5af96d0fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mclock.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+  integer(kind=4) :: i4, j4
+  integer(kind=8) :: i8, j8
+
+  i4 = mclock()
+  i8 = mclock8()
+  j4 = mclock()
+  j8 = mclock8()
+
+  if (i4 > j4 .or. i8 > j8 .or. i4 > i8 .or. j4 > j8) call abort
+
+  end
diff --git a/gcc/testsuite/gfortran.dg/merge_bits_1.F90 b/gcc/testsuite/gfortran.dg/merge_bits_1.F90
new file mode 100644
index 000000000..e8f5e2af4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/merge_bits_1.F90
@@ -0,0 +1,55 @@
+! Test the MERGE_BITS intrinsic
+!
+! { dg-do run }
+! { dg-options "-ffree-line-length-none" }
+
+  interface run_merge
+    procedure run_merge_1
+    procedure run_merge_2
+    procedure run_merge_4
+    procedure run_merge_8
+  end interface
+
+#define CHECK(I,J,K) \
+  if (merge_bits(I,J,K) /= ior(iand(I,K),iand(J,not(K)))) call abort ; \
+  if (run_merge(I,J,K) /= merge_bits(I,J,K)) call abort
+
+  CHECK(13_1,18_1,22_1)
+  CHECK(-13_1,18_1,22_1)
+  CHECK(13_1,-18_1,22_1)
+  CHECK(13_1,18_1,-22_1)
+
+  CHECK(13_2,18_2,22_2)
+  CHECK(-13_2,18_2,22_2)
+  CHECK(13_2,-18_2,22_2)
+  CHECK(13_2,18_2,-22_2)
+
+  CHECK(13_4,18_4,22_4)
+  CHECK(-13_4,18_4,22_4)
+  CHECK(13_4,-18_4,22_4)
+  CHECK(13_4,18_4,-22_4)
+
+  CHECK(13_8,18_8,22_8)
+  CHECK(-13_8,18_8,22_8)
+  CHECK(13_8,-18_8,22_8)
+  CHECK(13_8,18_8,-22_8)
+
+contains
+
+  function run_merge_1 (i, j, k) result(res)
+    integer(kind=1) :: i, j, k, res
+    res = merge_bits(i,j,k)
+  end function 
+  function run_merge_2 (i, j, k) result(res)
+    integer(kind=2) :: i, j, k, res
+    res = merge_bits(i,j,k)
+  end function 
+  function run_merge_4 (i, j, k) result(res)
+    integer(kind=4) :: i, j, k, res
+    res = merge_bits(i,j,k)
+  end function 
+  function run_merge_8 (i, j, k) result(res)
+    integer(kind=8) :: i, j, k, res
+    res = merge_bits(i,j,k)
+  end function 
+end
diff --git a/gcc/testsuite/gfortran.dg/merge_bits_2.F90 b/gcc/testsuite/gfortran.dg/merge_bits_2.F90
new file mode 100644
index 000000000..4f2421e02
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/merge_bits_2.F90
@@ -0,0 +1,22 @@
+! Test the MERGE_BITS intrinsic
+!
+! { dg-do run }
+! { dg-options "-ffree-line-length-none" }
+! { dg-require-effective-target fortran_integer_16 }
+
+#define CHECK(I,J,K) \
+  if (merge_bits(I,J,K) /= ior(iand(I,K),iand(J,not(K)))) call abort ; \
+  if (run_merge(I,J,K) /= merge_bits(I,J,K)) call abort
+
+  CHECK(13_16,18_16,22_16)
+  CHECK(-13_16,18_16,22_16)
+  CHECK(13_16,-18_16,22_16)
+  CHECK(13_16,18_16,-22_16)
+
+contains
+
+  function run_merge (i, j, k) result(res)
+    integer(kind=16) :: i, j, k, res
+    res = merge_bits(i,j,k)
+  end function 
+end
diff --git a/gcc/testsuite/gfortran.dg/merge_char_1.f90 b/gcc/testsuite/gfortran.dg/merge_char_1.f90
new file mode 100644
index 000000000..5974e8c06
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/merge_char_1.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR 15327
+! The merge intrinsic didn't work for strings
+character*2 :: c(2)
+c = merge( (/ "AA", "BB" /), (/ "CC", "DD" /), (/ .TRUE., .FALSE. /) )
+if (c(1).ne."AA" .or. c(2).ne."DD") call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/merge_char_2.f90 b/gcc/testsuite/gfortran.dg/merge_char_2.f90
new file mode 100644
index 000000000..31ace4b8e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/merge_char_2.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! See PR fortran/31610
+!
+implicit none
+character(len=2) :: a
+character(len=3) :: b
+print *, merge(a,a,.true.)
+print *, merge(a,'aa',.true.)
+print *, merge('aa',a,.true.)
+print *, merge('aa','bb',.true.)
+print *, merge(a,   b,    .true.)  ! { dg-error "Unequal character lengths" }
+print *, merge(a,   'bbb',.true.)  ! { dg-error "Unequal character lengths" }
+print *, merge('aa',b,    .true.)  ! { dg-error "Unequal character lengths" }
+print *, merge('aa','bbb',.true.)  ! { dg-error "Unequal character lengths" }
+end
diff --git a/gcc/testsuite/gfortran.dg/merge_char_3.f90 b/gcc/testsuite/gfortran.dg/merge_char_3.f90
new file mode 100644
index 000000000..498e3ec73
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/merge_char_3.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Unequal character lengths" }
+
+! PR fortran/38137
+! Test that -fbounds-check detects unequal character lengths to MERGE
+! at runtime.
+
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+subroutine foo(a)
+implicit none
+character(len=*) :: a
+character(len=3) :: b
+print *, merge(a,b,.true.)  ! Unequal character lengths
+end subroutine foo
+
+call foo("ab")
+end
diff --git a/gcc/testsuite/gfortran.dg/merge_char_const.f90 b/gcc/testsuite/gfortran.dg/merge_char_const.f90
new file mode 100644
index 000000000..32c87f510
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/merge_char_const.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-options "-O0" }
+! This tests the patch for PR24311 in which the PRINT statement would
+! ICE on trying to print a MERGE statement with character constants
+! for the first two arguments.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+  integer, dimension(6) :: i = (/1,0,0,1,1,0/)
+  print '(6a1)', Merge ("a", "b", i  == 1) ! { dg-output "abbaab" }
+  end
+
+
diff --git a/gcc/testsuite/gfortran.dg/merge_init_expr.f90 b/gcc/testsuite/gfortran.dg/merge_init_expr.f90
new file mode 100644
index 000000000..c691aa0e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/merge_init_expr.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! Check simplification of MERGE.
+!
+
+  INTEGER, PARAMETER :: array(3) = [1, 2, 3]
+  LOGICAL, PARAMETER :: mask(3)  = [ .TRUE., .FALSE., .TRUE. ]
+
+  INTEGER, PARAMETER :: scalar_1 = MERGE (1, 0, .TRUE.)
+  INTEGER, PARAMETER :: scalar_2 = MERGE (0, 1, .FALSE.)
+
+  INTEGER, PARAMETER :: array_1(3) = MERGE (array, 0, .TRUE.)
+  INTEGER, PARAMETER :: array_2(3) = MERGE (array, 0, .FALSE.)
+  INTEGER, PARAMETER :: array_3(3) = MERGE (0, array, .TRUE.)
+  INTEGER, PARAMETER :: array_4(3) = MERGE (0, array, .FALSE.)
+  INTEGER, PARAMETER :: array_5(3) = MERGE (1, 0, mask)
+  INTEGER, PARAMETER :: array_6(3) = MERGE (array, -array, mask)
+
+  INTEGER, PARAMETER :: array_7(3) = MERGE ([1,2,3], -array, mask)
+
+  IF (scalar_1 /= 1 .OR. scalar_2 /= 1) CALL abort
+  IF (.NOT. ALL (array_1 == array)) CALL abort
+  IF (.NOT. ALL (array_2 == [0, 0, 0])) CALL abort
+  IF (.NOT. ALL (array_3 == [0, 0, 0])) CALL abort
+  IF (.NOT. ALL (array_4 == array)) CALL abort
+  IF (.NOT. ALL (array_5 == [1, 0, 1])) CALL abort
+  IF (.NOT. ALL (array_6 == [1, -2, 3])) CALL abort
+END
diff --git a/gcc/testsuite/gfortran.dg/min_max_conformance.f90 b/gcc/testsuite/gfortran.dg/min_max_conformance.f90
new file mode 100644
index 000000000..57e37d0e7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/min_max_conformance.f90
@@ -0,0 +1,51 @@
+! { dg-do compile }
+! { dg-options "-fmax-errors=0" }
+! PR 31919:  Tests for different ranks in min/max were missing.
+program pr31919
+  integer :: i4, i4a(2, 2), i4b(2), i4c(4)
+  real(4) :: r4, r4a(2, 2), r4b(2), r4c(4)
+  real(8) :: r8, r8a(2, 2), r8b(2), r8c(4)
+
+  i4a = max(i4a, i4b)            ! { dg-error "Incompatible ranks" }
+  i4a = max0(i4a, i4b)           ! { dg-error "Incompatible ranks" }
+  r4a = amax0(i4a, i4b)          ! { dg-error "Incompatible ranks" }
+  i4a = max1(r4a, r4b)           ! { dg-error "Incompatible ranks" }
+  r4a = amax1(r4a, r4b)          ! { dg-error "Incompatible ranks" }
+  r8a = dmax1(r8a, r8b)          ! { dg-error "Incompatible ranks" }
+
+  i4a = min(i4a, i4b)            ! { dg-error "Incompatible ranks" }
+  i4a = min0(i4a, i4b)           ! { dg-error "Incompatible ranks" }
+  i4a = amin0(i4a, i4b)          ! { dg-error "Incompatible ranks" }
+  r4a = min1(r4a, r4b)           ! { dg-error "Incompatible ranks" }
+  r4a = amin1(r4a, r4b)          ! { dg-error "Incompatible ranks" }
+  r8a = dmin1(r8a, r8b)          ! { dg-error "Incompatible ranks" }
+
+  i4a = max(i4b, i4c)            ! { dg-error "Different shape for arguments" }
+  i4a = max0(i4b, i4c)           ! { dg-error "Different shape for arguments" }
+  r4a = amax0(i4b, i4c)          ! { dg-error "Different shape for arguments" }
+  i4a = max1(r4b, r4c)           ! { dg-error "Different shape for arguments" }
+  r4a = amax1(r4b, r4c)          ! { dg-error "Different shape for arguments" }
+  r8a = dmax1(r8B, r8c)          ! { dg-error "Different shape for arguments" }
+
+  i4a = min(i4b, i4c)            ! { dg-error "Different shape for arguments" }
+  i4a = min0(i4b, i4c)           ! { dg-error "Different shape for arguments" }
+  i4a = amin0(i4b, i4c)          ! { dg-error "Different shape for arguments" }
+  r4a = min1(r4b, r4c)           ! { dg-error "Different shape for arguments" }
+  r4a = amin1(r4b, r4c)          ! { dg-error "Different shape for arguments" }
+  r8a = dmin1(r8b, r8c)          ! { dg-error "Different shape for arguments" }
+
+  ! checking needs to be position independent
+  i4a = min(i4, i4a, i4, i4b)    ! { dg-error "Incompatible ranks" }
+  r4a = min(r4, r4a, r4, r4b)    ! { dg-error "Incompatible ranks" }
+  r8a = min(r8, r8a, r8, r8b)    ! { dg-error "Incompatible ranks" }
+  i4a = min(i4, i4b, i4, i4c)    ! { dg-error "Different shape for arguments" }
+  r4a = min(r4, r4b, r4, r4c)    ! { dg-error "Different shape for arguments" }
+  r8a = min(r8, r8b, r8, r8c)    ! { dg-error "Different shape for arguments" }
+
+  i4a = max(i4, i4a, i4, i4b)    ! { dg-error "Incompatible ranks" }
+  r4a = max(r4, r4a, r4, r4b)    ! { dg-error "Incompatible ranks" }
+  r8a = max(r8, r8a, r8, r8b)    ! { dg-error "Incompatible ranks" }
+  i4a = max(i4, i4b, i4, i4c)    ! { dg-error "Different shape for arguments" }
+  r4a = max(r4, r4b, r4, r4c)    ! { dg-error "Different shape for arguments" }
+  r8a = max(r8, r8b, r8, r8c)    ! { dg-error "Different shape for arguments" }
+end program
diff --git a/gcc/testsuite/gfortran.dg/min_max_optional_1.f90 b/gcc/testsuite/gfortran.dg/min_max_optional_1.f90
new file mode 100644
index 000000000..250010dff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/min_max_optional_1.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+IF (T1(1.0,1.0) .NE. (1.0,1.0) ) CALL ABORT()
+IF (T1(1.0) .NE. (1.0,0.0)) CALL ABORT()
+IF (M1(1,2,3) .NE. 3) CALL ABORT()
+IF (M1(1,2,A4=4) .NE. 4) CALL ABORT()
+CONTAINS
+
+COMPLEX FUNCTION T1(X,Y)
+  REAL :: X
+  REAL, OPTIONAL :: Y
+  T1=CMPLX(X,Y)
+END FUNCTION T1
+
+INTEGER FUNCTION M1(A1,A2,A3,A4)
+  INTEGER :: A1,A2
+  INTEGER, OPTIONAL :: A3,A4
+  M1=MAX(A1,A2,A3,A4)
+END FUNCTION M1
+
+END
diff --git a/gcc/testsuite/gfortran.dg/min_max_optional_5.f90 b/gcc/testsuite/gfortran.dg/min_max_optional_5.f90
new file mode 100644
index 000000000..ae3344f79
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/min_max_optional_5.f90
@@ -0,0 +1,21 @@
+! More tests for MIN/MAX with optional arguments
+! PR33095
+!
+! { dg-do run }
+  if (m1(3,4) /= 4) call abort
+  if (m1(3) /= 3) call abort
+  if (m1() /= 2) call abort
+
+  if (m1(3,4) /= 4) call abort
+  if (m1(3) /= 3) call abort
+contains
+  integer function m1(a1,a2)
+    integer, optional, intent(in) :: a1, a2
+    m1 = max(1, 2, a1, a2)
+  end function m1
+
+  integer function m2(a1,a2)
+    integer, optional, intent(in) :: a1, a2
+    m2 = max(1, a1, 2, a2)
+  end function m2
+end
diff --git a/gcc/testsuite/gfortran.dg/minlocval_1.f90 b/gcc/testsuite/gfortran.dg/minlocval_1.f90
new file mode 100644
index 000000000..261cab346
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minlocval_1.f90
@@ -0,0 +1,155 @@
+! { dg-do run }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+  real :: a(3), nan, minf, pinf
+  real, allocatable :: c(:)
+  logical :: l
+  logical :: l2(3)
+
+  nan = 0.0
+  minf = 0.0
+  pinf = 0.0
+  nan = 0.0/nan
+  minf = -1.0/minf
+  pinf = 1.0/pinf
+
+  allocate (c(3))
+  a(:) = nan
+  if (minloc (a, dim = 1).ne.1) call abort
+  if (.not.isnan(minval (a, dim = 1))) call abort
+  a(:) = pinf
+  if (minloc (a, dim = 1).ne.1) call abort
+  if (minval (a, dim = 1).ne.pinf) call abort
+  a(1:2) = nan
+  if (minloc (a, dim = 1).ne.3) call abort
+  if (minval (a, dim = 1).ne.pinf) call abort
+  a(2) = 1.0
+  if (minloc (a, dim = 1).ne.2) call abort
+  if (minval (a, dim = 1).ne.1) call abort
+  a(2) = minf
+  if (minloc (a, dim = 1).ne.2) call abort
+  if (minval (a, dim = 1).ne.minf) call abort
+  c(:) = nan
+  if (minloc (c, dim = 1).ne.1) call abort
+  if (.not.isnan(minval (c, dim = 1))) call abort
+  c(:) = pinf
+  if (minloc (c, dim = 1).ne.1) call abort
+  if (minval (c, dim = 1).ne.pinf) call abort
+  c(1:2) = nan
+  if (minloc (c, dim = 1).ne.3) call abort
+  if (minval (c, dim = 1).ne.pinf) call abort
+  c(2) = 1.0
+  if (minloc (c, dim = 1).ne.2) call abort
+  if (minval (c, dim = 1).ne.1) call abort
+  c(2) = minf
+  if (minloc (c, dim = 1).ne.2) call abort
+  if (minval (c, dim = 1).ne.minf) call abort
+  l = .false.
+  l2(:) = .false.
+  a(:) = nan
+  if (minloc (a, dim = 1, mask = l).ne.0) call abort
+  if (minval (a, dim = 1, mask = l).ne.huge(pinf)) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (minval (a, dim = 1, mask = l2).ne.huge(pinf)) call abort
+  a(:) = pinf
+  if (minloc (a, dim = 1, mask = l).ne.0) call abort
+  if (minval (a, dim = 1, mask = l).ne.huge(pinf)) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (minval (a, dim = 1, mask = l2).ne.huge(pinf)) call abort
+  a(1:2) = nan
+  if (minloc (a, dim = 1, mask = l).ne.0) call abort
+  if (minval (a, dim = 1, mask = l).ne.huge(pinf)) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (minval (a, dim = 1, mask = l2).ne.huge(pinf)) call abort
+  a(2) = 1.0
+  if (minloc (a, dim = 1, mask = l).ne.0) call abort
+  if (minval (a, dim = 1, mask = l).ne.huge(pinf)) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (minval (a, dim = 1, mask = l2).ne.huge(pinf)) call abort
+  a(2) = minf
+  if (minloc (a, dim = 1, mask = l).ne.0) call abort
+  if (minval (a, dim = 1, mask = l).ne.huge(pinf)) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (minval (a, dim = 1, mask = l2).ne.huge(pinf)) call abort
+  c(:) = nan
+  if (minloc (c, dim = 1, mask = l).ne.0) call abort
+  if (minval (c, dim = 1, mask = l).ne.huge(pinf)) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (minval (c, dim = 1, mask = l2).ne.huge(pinf)) call abort
+  c(:) = pinf
+  if (minloc (c, dim = 1, mask = l).ne.0) call abort
+  if (minval (c, dim = 1, mask = l).ne.huge(pinf)) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (minval (c, dim = 1, mask = l2).ne.huge(pinf)) call abort
+  c(1:2) = nan
+  if (minloc (c, dim = 1, mask = l).ne.0) call abort
+  if (minval (c, dim = 1, mask = l).ne.huge(pinf)) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (minval (c, dim = 1, mask = l2).ne.huge(pinf)) call abort
+  c(2) = 1.0
+  if (minloc (c, dim = 1, mask = l).ne.0) call abort
+  if (minval (c, dim = 1, mask = l).ne.huge(pinf)) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (minval (c, dim = 1, mask = l2).ne.huge(pinf)) call abort
+  c(2) = minf
+  if (minloc (c, dim = 1, mask = l).ne.0) call abort
+  if (minval (c, dim = 1, mask = l).ne.huge(pinf)) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (minval (c, dim = 1, mask = l2).ne.huge(pinf)) call abort
+  l = .true.
+  l2(:) = .true.
+  a(:) = nan
+  if (minloc (a, dim = 1, mask = l).ne.1) call abort
+  if (.not.isnan(minval (a, dim = 1, mask = l))) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.1) call abort
+  if (.not.isnan(minval (a, dim = 1, mask = l2))) call abort
+  a(:) = pinf
+  if (minloc (a, dim = 1, mask = l).ne.1) call abort
+  if (minval (a, dim = 1, mask = l).ne.pinf) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.1) call abort
+  if (minval (a, dim = 1, mask = l2).ne.pinf) call abort
+  a(1:2) = nan
+  if (minloc (a, dim = 1, mask = l).ne.3) call abort
+  if (minval (a, dim = 1, mask = l).ne.pinf) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.3) call abort
+  if (minval (a, dim = 1, mask = l2).ne.pinf) call abort
+  a(2) = 1.0
+  if (minloc (a, dim = 1, mask = l).ne.2) call abort
+  if (minval (a, dim = 1, mask = l).ne.1) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.2) call abort
+  if (minval (a, dim = 1, mask = l2).ne.1) call abort
+  a(2) = minf
+  if (minloc (a, dim = 1, mask = l).ne.2) call abort
+  if (minval (a, dim = 1, mask = l).ne.minf) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.2) call abort
+  if (minval (a, dim = 1, mask = l2).ne.minf) call abort
+  c(:) = nan
+  if (minloc (c, dim = 1, mask = l).ne.1) call abort
+  if (.not.isnan(minval (c, dim = 1, mask = l))) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.1) call abort
+  if (.not.isnan(minval (c, dim = 1, mask = l2))) call abort
+  c(:) = pinf
+  if (minloc (c, dim = 1, mask = l).ne.1) call abort
+  if (minval (c, dim = 1, mask = l).ne.pinf) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.1) call abort
+  if (minval (c, dim = 1, mask = l2).ne.pinf) call abort
+  c(1:2) = nan
+  if (minloc (c, dim = 1, mask = l).ne.3) call abort
+  if (minval (c, dim = 1, mask = l).ne.pinf) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.3) call abort
+  if (minval (c, dim = 1, mask = l2).ne.pinf) call abort
+  c(2) = 1.0
+  if (minloc (c, dim = 1, mask = l).ne.2) call abort
+  if (minval (c, dim = 1, mask = l).ne.1) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.2) call abort
+  if (minval (c, dim = 1, mask = l2).ne.1) call abort
+  c(2) = minf
+  if (minloc (c, dim = 1, mask = l).ne.2) call abort
+  if (minval (c, dim = 1, mask = l).ne.minf) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.2) call abort
+  if (minval (c, dim = 1, mask = l2).ne.minf) call abort
+  deallocate (c)
+  allocate (c(-2:-3))
+  if (minloc (c, dim = 1).ne.0) call abort
+  if (minval (c, dim = 1).ne.huge(pinf)) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/minlocval_2.f90 b/gcc/testsuite/gfortran.dg/minlocval_2.f90
new file mode 100644
index 000000000..8e04dc6de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minlocval_2.f90
@@ -0,0 +1,122 @@
+! { dg-do run }
+  integer :: a(3), h
+  integer, allocatable :: c(:)
+  logical :: l
+  logical :: l2(3)
+
+  h = -huge(h)
+  h = h - 1
+  allocate (c(3))
+  a(:) = 5
+  if (minloc (a, dim = 1).ne.1) call abort
+  if (minval (a, dim = 1).ne.5) call abort
+  a(2) = h
+  if (minloc (a, dim = 1).ne.2) call abort
+  if (minval (a, dim = 1).ne.h) call abort
+  a(:) = huge(h)
+  if (minloc (a, dim = 1).ne.1) call abort
+  if (minval (a, dim = 1).ne.huge(h)) call abort
+  a(3) = huge(h) - 1
+  if (minloc (a, dim = 1).ne.3) call abort
+  if (minval (a, dim = 1).ne.huge(h)-1) call abort
+  c(:) = 5
+  if (minloc (c, dim = 1).ne.1) call abort
+  if (minval (c, dim = 1).ne.5) call abort
+  c(2) = h
+  if (minloc (c, dim = 1).ne.2) call abort
+  if (minval (c, dim = 1).ne.h) call abort
+  c(:) = huge(h)
+  if (minloc (c, dim = 1).ne.1) call abort
+  if (minval (c, dim = 1).ne.huge(h)) call abort
+  c(3) = huge(h) - 1
+  if (minloc (c, dim = 1).ne.3) call abort
+  if (minval (c, dim = 1).ne.huge(h)-1) call abort
+  l = .false.
+  l2(:) = .false.
+  a(:) = 5
+  if (minloc (a, dim = 1, mask = l).ne.0) call abort
+  if (minval (a, dim = 1, mask = l).ne.huge(h)) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (minval (a, dim = 1, mask = l2).ne.huge(h)) call abort
+  a(2) = h
+  if (minloc (a, dim = 1, mask = l).ne.0) call abort
+  if (minval (a, dim = 1, mask = l).ne.huge(h)) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (minval (a, dim = 1, mask = l2).ne.huge(h)) call abort
+  a(:) = huge(h)
+  if (minloc (a, dim = 1, mask = l).ne.0) call abort
+  if (minval (a, dim = 1, mask = l).ne.huge(h)) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (minval (a, dim = 1, mask = l2).ne.huge(h)) call abort
+  a(3) = huge(h) - 1
+  if (minloc (a, dim = 1, mask = l).ne.0) call abort
+  if (minval (a, dim = 1, mask = l).ne.huge(h)) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+  if (minval (a, dim = 1, mask = l2).ne.huge(h)) call abort
+  c(:) = 5
+  if (minloc (c, dim = 1, mask = l).ne.0) call abort
+  if (minval (c, dim = 1, mask = l).ne.huge(h)) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (minval (c, dim = 1, mask = l2).ne.huge(h)) call abort
+  c(2) = h
+  if (minloc (c, dim = 1, mask = l).ne.0) call abort
+  if (minval (c, dim = 1, mask = l).ne.huge(h)) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (minval (c, dim = 1, mask = l2).ne.huge(h)) call abort
+  c(:) = huge(h)
+  if (minloc (c, dim = 1, mask = l).ne.0) call abort
+  if (minval (c, dim = 1, mask = l).ne.huge(h)) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (minval (c, dim = 1, mask = l2).ne.huge(h)) call abort
+  c(3) = huge(h) - 1
+  if (minloc (c, dim = 1, mask = l).ne.0) call abort
+  if (minval (c, dim = 1, mask = l).ne.huge(h)) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+  if (minval (c, dim = 1, mask = l2).ne.huge(h)) call abort
+  l = .true.
+  l2(:) = .true.
+  a(:) = 5
+  if (minloc (a, dim = 1, mask = l).ne.1) call abort
+  if (minval (a, dim = 1, mask = l).ne.5) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.1) call abort
+  if (minval (a, dim = 1, mask = l2).ne.5) call abort
+  a(2) = h
+  if (minloc (a, dim = 1, mask = l).ne.2) call abort
+  if (minval (a, dim = 1, mask = l).ne.h) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.2) call abort
+  if (minval (a, dim = 1, mask = l2).ne.h) call abort
+  a(:) = huge(h)
+  if (minloc (a, dim = 1, mask = l).ne.1) call abort
+  if (minval (a, dim = 1, mask = l).ne.huge(h)) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.1) call abort
+  if (minval (a, dim = 1, mask = l2).ne.huge(h)) call abort
+  a(3) = huge(h) - 1
+  if (minloc (a, dim = 1, mask = l).ne.3) call abort
+  if (minval (a, dim = 1, mask = l).ne.huge(h)-1) call abort
+  if (minloc (a, dim = 1, mask = l2).ne.3) call abort
+  if (minval (a, dim = 1, mask = l2).ne.huge(h)-1) call abort
+  c(:) = 5
+  if (minloc (c, dim = 1, mask = l).ne.1) call abort
+  if (minval (c, dim = 1, mask = l).ne.5) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.1) call abort
+  if (minval (c, dim = 1, mask = l2).ne.5) call abort
+  c(2) = h
+  if (minloc (c, dim = 1, mask = l).ne.2) call abort
+  if (minval (c, dim = 1, mask = l).ne.h) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.2) call abort
+  if (minval (c, dim = 1, mask = l2).ne.h) call abort
+  c(:) = huge(h)
+  if (minloc (c, dim = 1, mask = l).ne.1) call abort
+  if (minval (c, dim = 1, mask = l).ne.huge(h)) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.1) call abort
+  if (minval (c, dim = 1, mask = l2).ne.huge(h)) call abort
+  c(3) = huge(h) - 1
+  if (minloc (c, dim = 1, mask = l).ne.3) call abort
+  if (minval (c, dim = 1, mask = l).ne.huge(h)-1) call abort
+  if (minloc (c, dim = 1, mask = l2).ne.3) call abort
+  if (minval (c, dim = 1, mask = l2).ne.huge(h)-1) call abort
+  deallocate (c)
+  allocate (c(-2:-3))
+  if (minloc (c, dim = 1).ne.0) call abort
+  if (minval (c, dim = 1).ne.huge(h)) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/minlocval_3.f90 b/gcc/testsuite/gfortran.dg/minlocval_3.f90
new file mode 100644
index 000000000..6a4fc558a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minlocval_3.f90
@@ -0,0 +1,284 @@
+  real :: a(30), b(10, 10), m
+  real, allocatable :: c(:), d(:, :)
+  integer :: e(30), f(10, 10), n
+  integer, allocatable :: g(:), h(:,:)
+  logical :: l(30), l2(10, 10)
+  allocate (c (30))
+  allocate (d (10, 10))
+  allocate (g (30))
+  allocate (h (10, 10))
+  a = 7.0
+  b = 7.0
+  c = 7.0
+  d = 7.0
+  e = 7
+  f = 7
+  g = 7
+  h = 7
+  m = huge(m)
+  n = huge(n)
+  a(7) = 6.0
+  b(5, 5) = 6.0
+  b(5, 6) = 5.0
+  b(6, 7) = 4.0
+  c(7) = 6.0
+  d(5, 5) = 6.0
+  d(5, 6) = 5.0
+  d(6, 7) = 4.0
+  e(7) = 6
+  f(5, 5) = 6
+  f(5, 6) = 5
+  f(6, 7) = 4
+  g(7) = 6
+  h(5, 5) = 6
+  h(5, 6) = 5
+  h(6, 7) = 4
+  if (minloc (a, dim = 1).ne.7) call abort
+  if (minval (a, dim = 1).ne.6.0) call abort
+  if (minloc (a(::2), dim = 1).ne.4) call abort
+  if (minval (a(::2), dim = 1).ne.6.0) call abort
+  if (any (minloc (a).ne.(/ 7 /))) call abort
+  if (minval (a).ne.6.0) call abort
+  if (any (minloc (a(::2)).ne.(/ 4 /))) call abort
+  if (minval (a(::2)).ne.6.0) call abort
+  if (any (minloc (b, dim = 1).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
+  if (any (minval (b, dim = 1).ne.(/ 7.0, 7.0, 7.0, 7.0, 6.0, 5.0, 4.0, 7.0, 7.0, 7.0 /))) call abort
+  if (any (minloc (b(::2,::2), dim = 1).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+  if (any (minval (b(::2,::2), dim = 1).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
+  if (any (minloc (b, dim = 2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
+  if (any (minval (b, dim = 2).ne.(/ 7.0, 7.0, 7.0, 7.0, 5.0, 4.0, 7.0, 7.0, 7.0, 7.0 /))) call abort
+  if (any (minloc (b(::2,::2), dim = 2).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+  if (any (minval (b(::2,::2), dim = 2).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
+  if (any (minloc (b).ne.(/ 6, 7 /))) call abort
+  if (minval (b).ne.4.0) call abort
+  if (any (minloc (b(::2,::2)).ne.(/ 3, 3 /))) call abort
+  if (minval (b(::2,::2)).ne.6.0) call abort
+  if (minloc (c, dim = 1).ne.7) call abort
+  if (minval (c, dim = 1).ne.6.0) call abort
+  if (minloc (c(::2), dim = 1).ne.4) call abort
+  if (minval (c(::2), dim = 1).ne.6.0) call abort
+  if (any (minloc (c).ne.(/ 7 /))) call abort
+  if (minval (c).ne.6.0) call abort
+  if (any (minloc (c(::2)).ne.(/ 4 /))) call abort
+  if (minval (c(::2)).ne.6.0) call abort
+  if (any (minloc (d, dim = 1).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
+  if (any (minval (d, dim = 1).ne.(/ 7.0, 7.0, 7.0, 7.0, 6.0, 5.0, 4.0, 7.0, 7.0, 7.0 /))) call abort
+  if (any (minloc (d(::2,::2), dim = 1).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+  if (any (minval (d(::2,::2), dim = 1).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
+  if (any (minloc (d, dim = 2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
+  if (any (minval (d, dim = 2).ne.(/ 7.0, 7.0, 7.0, 7.0, 5.0, 4.0, 7.0, 7.0, 7.0, 7.0 /))) call abort
+  if (any (minloc (d(::2,::2), dim = 2).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+  if (any (minval (d(::2,::2), dim = 2).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
+  if (any (minloc (d).ne.(/ 6, 7 /))) call abort
+  if (minval (d).ne.4.0) call abort
+  if (any (minloc (d(::2,::2)).ne.(/ 3, 3 /))) call abort
+  if (minval (d(::2,::2)).ne.6.0) call abort
+  if (minloc (e, dim = 1).ne.7) call abort
+  if (minval (e, dim = 1).ne.6) call abort
+  if (minloc (e(::2), dim = 1).ne.4) call abort
+  if (minval (e(::2), dim = 1).ne.6) call abort
+  if (any (minloc (e).ne.(/ 7 /))) call abort
+  if (minval (e).ne.6) call abort
+  if (any (minloc (e(::2)).ne.(/ 4 /))) call abort
+  if (minval (e(::2)).ne.6) call abort
+  if (any (minloc (f, dim = 1).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
+  if (any (minval (f, dim = 1).ne.(/ 7, 7, 7, 7, 6, 5, 4, 7, 7, 7 /))) call abort
+  if (any (minloc (f(::2,::2), dim = 1).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+  if (any (minval (f(::2,::2), dim = 1).ne.(/ 7, 7, 6, 7, 7 /))) call abort
+  if (any (minloc (f, dim = 2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
+  if (any (minval (f, dim = 2).ne.(/ 7, 7, 7, 7, 5, 4, 7, 7, 7, 7 /))) call abort
+  if (any (minloc (f(::2,::2), dim = 2).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+  if (any (minval (f(::2,::2), dim = 2).ne.(/ 7, 7, 6, 7, 7 /))) call abort
+  if (any (minloc (f).ne.(/ 6, 7 /))) call abort
+  if (minval (f).ne.4) call abort
+  if (any (minloc (f(::2,::2)).ne.(/ 3, 3 /))) call abort
+  if (minval (f(::2,::2)).ne.6) call abort
+  if (minloc (g, dim = 1).ne.7) call abort
+  if (minval (g, dim = 1).ne.6) call abort
+  if (minloc (g(::2), dim = 1).ne.4) call abort
+  if (minval (g(::2), dim = 1).ne.6) call abort
+  if (any (minloc (g).ne.(/ 7 /))) call abort
+  if (minval (g).ne.6) call abort
+  if (any (minloc (g(::2)).ne.(/ 4 /))) call abort
+  if (minval (g(::2)).ne.6) call abort
+  if (any (minloc (h, dim = 1).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
+  if (any (minval (h, dim = 1).ne.(/ 7, 7, 7, 7, 6, 5, 4, 7, 7, 7 /))) call abort
+  if (any (minloc (h(::2,::2), dim = 1).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+  if (any (minval (h(::2,::2), dim = 1).ne.(/ 7, 7, 6, 7, 7 /))) call abort
+  if (any (minloc (h, dim = 2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
+  if (any (minval (h, dim = 2).ne.(/ 7, 7, 7, 7, 5, 4, 7, 7, 7, 7 /))) call abort
+  if (any (minloc (h(::2,::2), dim = 2).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+  if (any (minval (h(::2,::2), dim = 2).ne.(/ 7, 7, 6, 7, 7 /))) call abort
+  if (any (minloc (h).ne.(/ 6, 7 /))) call abort
+  if (minval (h).ne.4) call abort
+  if (any (minloc (h(::2,::2)).ne.(/ 3, 3 /))) call abort
+  if (minval (h(::2,::2)).ne.6) call abort
+  l = .true.
+  l2 = .true.
+  if (minloc (a, dim = 1, mask = l).ne.7) call abort
+  if (minval (a, dim = 1, mask = l).ne.6.0) call abort
+  if (minloc (a(::2), dim = 1, mask = l(::2)).ne.4) call abort
+  if (minval (a(::2), dim = 1, mask = l(::2)).ne.6.0) call abort
+  if (any (minloc (a, mask = l).ne.(/ 7 /))) call abort
+  if (minval (a, mask = l).ne.6.0) call abort
+  if (any (minloc (a(::2), mask = l(::2)).ne.(/ 4 /))) call abort
+  if (minval (a(::2), mask = l(::2)).ne.6.0) call abort
+  if (any (minloc (b, dim = 1, mask = l2).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
+  if (any (minval (b, dim = 1, mask = l2).ne.(/ 7.0, 7.0, 7.0, 7.0, 6.0, 5.0, 4.0, 7.0, 7.0, 7.0 /))) call abort
+  if (any (minloc (b(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+  if (any (minval (b(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
+  if (any (minloc (b, dim = 2, mask = l2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
+  if (any (minval (b, dim = 2, mask = l2).ne.(/ 7.0, 7.0, 7.0, 7.0, 5.0, 4.0, 7.0, 7.0, 7.0, 7.0 /))) call abort
+  if (any (minloc (b(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+  if (any (minval (b(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
+  if (any (minloc (b, mask = l2).ne.(/ 6, 7 /))) call abort
+  if (minval (b, mask = l2).ne.4.0) call abort
+  if (any (minloc (b(::2,::2), mask = l2(::2,::2)).ne.(/ 3, 3 /))) call abort
+  if (minval (b(::2,::2), mask = l2(::2,::2)).ne.6.0) call abort
+  if (minloc (c, dim = 1, mask = l).ne.7) call abort
+  if (minval (c, dim = 1, mask = l).ne.6.0) call abort
+  if (minloc (c(::2), dim = 1, mask = l(::2)).ne.4) call abort
+  if (minval (c(::2), dim = 1, mask = l(::2)).ne.6.0) call abort
+  if (any (minloc (c, mask = l).ne.(/ 7 /))) call abort
+  if (minval (c, mask = l).ne.6.0) call abort
+  if (any (minloc (c(::2), mask = l(::2)).ne.(/ 4 /))) call abort
+  if (minval (c(::2), mask = l(::2)).ne.6.0) call abort
+  if (any (minloc (d, dim = 1, mask = l2).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
+  if (any (minval (d, dim = 1, mask = l2).ne.(/ 7.0, 7.0, 7.0, 7.0, 6.0, 5.0, 4.0, 7.0, 7.0, 7.0 /))) call abort
+  if (any (minloc (d(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+  if (any (minval (d(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
+  if (any (minloc (d, dim = 2, mask = l2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
+  if (any (minval (d, dim = 2, mask = l2).ne.(/ 7.0, 7.0, 7.0, 7.0, 5.0, 4.0, 7.0, 7.0, 7.0, 7.0 /))) call abort
+  if (any (minloc (d(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+  if (any (minval (d(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
+  if (any (minloc (d, mask = l2).ne.(/ 6, 7 /))) call abort
+  if (minval (d, mask = l2).ne.4.0) call abort
+  if (any (minloc (d(::2,::2), mask = l2(::2,::2)).ne.(/ 3, 3 /))) call abort
+  if (minval (d(::2,::2), mask = l2(::2,::2)).ne.6.0) call abort
+  if (minloc (e, dim = 1, mask = l).ne.7) call abort
+  if (minval (e, dim = 1, mask = l).ne.6) call abort
+  if (minloc (e(::2), dim = 1, mask = l(::2)).ne.4) call abort
+  if (minval (e(::2), dim = 1, mask = l(::2)).ne.6) call abort
+  if (any (minloc (e, mask = l).ne.(/ 7 /))) call abort
+  if (minval (e, mask = l).ne.6) call abort
+  if (any (minloc (e(::2), mask = l(::2)).ne.(/ 4 /))) call abort
+  if (minval (e(::2), mask = l(::2)).ne.6) call abort
+  if (any (minloc (f, dim = 1, mask = l2).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
+  if (any (minval (f, dim = 1, mask = l2).ne.(/ 7, 7, 7, 7, 6, 5, 4, 7, 7, 7 /))) call abort
+  if (any (minloc (f(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+  if (any (minval (f(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 7, 7, 6, 7, 7 /))) call abort
+  if (any (minloc (f, dim = 2, mask = l2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
+  if (any (minval (f, dim = 2, mask = l2).ne.(/ 7, 7, 7, 7, 5, 4, 7, 7, 7, 7 /))) call abort
+  if (any (minloc (f(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+  if (any (minval (f(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 7, 7, 6, 7, 7 /))) call abort
+  if (any (minloc (f, mask = l2).ne.(/ 6, 7 /))) call abort
+  if (minval (f, mask = l2).ne.4) call abort
+  if (any (minloc (f(::2,::2), mask = l2(::2,::2)).ne.(/ 3, 3 /))) call abort
+  if (minval (f(::2,::2), mask = l2(::2,::2)).ne.6) call abort
+  if (minloc (g, dim = 1, mask = l).ne.7) call abort
+  if (minval (g, dim = 1, mask = l).ne.6) call abort
+  if (minloc (g(::2), dim = 1, mask = l(::2)).ne.4) call abort
+  if (minval (g(::2), dim = 1, mask = l(::2)).ne.6) call abort
+  if (any (minloc (g, mask = l).ne.(/ 7 /))) call abort
+  if (minval (g, mask = l).ne.6) call abort
+  if (any (minloc (g(::2), mask = l(::2)).ne.(/ 4 /))) call abort
+  if (minval (g(::2), mask = l(::2)).ne.6) call abort
+  if (any (minloc (h, dim = 1, mask = l2).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
+  if (any (minval (h, dim = 1, mask = l2).ne.(/ 7, 7, 7, 7, 6, 5, 4, 7, 7, 7 /))) call abort
+  if (any (minloc (h(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+  if (any (minval (h(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 7, 7, 6, 7, 7 /))) call abort
+  if (any (minloc (h, dim = 2, mask = l2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
+  if (any (minval (h, dim = 2, mask = l2).ne.(/ 7, 7, 7, 7, 5, 4, 7, 7, 7, 7 /))) call abort
+  if (any (minloc (h(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+  if (any (minval (h(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 7, 7, 6, 7, 7 /))) call abort
+  if (any (minloc (h, mask = l2).ne.(/ 6, 7 /))) call abort
+  if (minval (h, mask = l2).ne.4) call abort
+  if (any (minloc (h(::2,::2), mask = l2(::2,::2)).ne.(/ 3, 3 /))) call abort
+  if (minval (h(::2,::2), mask = l2(::2,::2)).ne.6) call abort
+  l = .false.
+  l2 = .false.
+  if (minloc (a, dim = 1, mask = l).ne.0) call abort
+  if (minval (a, dim = 1, mask = l).ne.m) call abort
+  if (minloc (a(::2), dim = 1, mask = l(::2)).ne.0) call abort
+  if (minval (a(::2), dim = 1, mask = l(::2)).ne.m) call abort
+  if (any (minloc (a, mask = l).ne.(/ 0 /))) call abort
+  if (minval (a, mask = l).ne.m) call abort
+  if (any (minloc (a(::2), mask = l(::2)).ne.(/ 0 /))) call abort
+  if (minval (a(::2), mask = l(::2)).ne.m) call abort
+  if (any (minloc (b, dim = 1, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
+  if (any (minval (b, dim = 1, mask = l2).ne.(/ m, m, m, m, m, m, m, m, m, m /))) call abort
+  if (any (minloc (b(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
+  if (any (minval (b(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ m, m, m, m, m /))) call abort
+  if (any (minloc (b, dim = 2, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
+  if (any (minval (b, dim = 2, mask = l2).ne.(/ m, m, m, m, m, m, m, m, m, m /))) call abort
+  if (any (minloc (b(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
+  if (any (minval (b(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ m, m, m, m, m /))) call abort
+  if (any (minloc (b, mask = l2).ne.(/ 0, 0 /))) call abort
+  if (minval (b, mask = l2).ne.m) call abort
+  if (any (minloc (b(::2,::2), mask = l2(::2,::2)).ne.(/ 0, 0 /))) call abort
+  if (minval (b(::2,::2), mask = l2(::2,::2)).ne.m) call abort
+  if (minloc (c, dim = 1, mask = l).ne.0) call abort
+  if (minval (c, dim = 1, mask = l).ne.m) call abort
+  if (minloc (c(::2), dim = 1, mask = l(::2)).ne.0) call abort
+  if (minval (c(::2), dim = 1, mask = l(::2)).ne.m) call abort
+  if (any (minloc (c, mask = l).ne.(/ 0 /))) call abort
+  if (minval (c, mask = l).ne.m) call abort
+  if (any (minloc (c(::2), mask = l(::2)).ne.(/ 0 /))) call abort
+  if (minval (c(::2), mask = l(::2)).ne.m) call abort
+  if (any (minloc (d, dim = 1, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
+  if (any (minval (d, dim = 1, mask = l2).ne.(/ m, m, m, m, m, m, m, m, m, m /))) call abort
+  if (any (minloc (d(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
+  if (any (minval (d(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ m, m, m, m, m /))) call abort
+  if (any (minloc (d, dim = 2, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
+  if (any (minval (d, dim = 2, mask = l2).ne.(/ m, m, m, m, m, m, m, m, m, m /))) call abort
+  if (any (minloc (d(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
+  if (any (minval (d(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ m, m, m, m, m /))) call abort
+  if (any (minloc (d, mask = l2).ne.(/ 0, 0 /))) call abort
+  if (minval (d, mask = l2).ne.m) call abort
+  if (any (minloc (d(::2,::2), mask = l2(::2,::2)).ne.(/ 0, 0 /))) call abort
+  if (minval (d(::2,::2), mask = l2(::2,::2)).ne.m) call abort
+  if (minloc (e, dim = 1, mask = l).ne.0) call abort
+  if (minval (e, dim = 1, mask = l).ne.n) call abort
+  if (minloc (e(::2), dim = 1, mask = l(::2)).ne.0) call abort
+  if (minval (e(::2), dim = 1, mask = l(::2)).ne.n) call abort
+  if (any (minloc (e, mask = l).ne.(/ 0 /))) call abort
+  if (minval (e, mask = l).ne.n) call abort
+  if (any (minloc (e(::2), mask = l(::2)).ne.(/ 0 /))) call abort
+  if (minval (e(::2), mask = l(::2)).ne.n) call abort
+  if (any (minloc (f, dim = 1, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
+  if (any (minval (f, dim = 1, mask = l2).ne.(/ n, n, n, n, n, n, n, n, n, n /))) call abort
+  if (any (minloc (f(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
+  if (any (minval (f(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ n, n, n, n, n /))) call abort
+  if (any (minloc (f, dim = 2, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
+  if (any (minval (f, dim = 2, mask = l2).ne.(/ n, n, n, n, n, n, n, n, n, n /))) call abort
+  if (any (minloc (f(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
+  if (any (minval (f(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ n, n, n, n, n /))) call abort
+  if (any (minloc (f, mask = l2).ne.(/ 0, 0 /))) call abort
+  if (minval (f, mask = l2).ne.n) call abort
+  if (any (minloc (f(::2,::2), mask = l2(::2,::2)).ne.(/ 0, 0 /))) call abort
+  if (minval (f(::2,::2), mask = l2(::2,::2)).ne.n) call abort
+  if (minloc (g, dim = 1, mask = l).ne.0) call abort
+  if (minval (g, dim = 1, mask = l).ne.n) call abort
+  if (minloc (g(::2), dim = 1, mask = l(::2)).ne.0) call abort
+  if (minval (g(::2), dim = 1, mask = l(::2)).ne.n) call abort
+  if (any (minloc (g, mask = l).ne.(/ 0 /))) call abort
+  if (minval (g, mask = l).ne.n) call abort
+  if (any (minloc (g(::2), mask = l(::2)).ne.(/ 0 /))) call abort
+  if (minval (g(::2), mask = l(::2)).ne.n) call abort
+  if (any (minloc (h, dim = 1, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
+  if (any (minval (h, dim = 1, mask = l2).ne.(/ n, n, n, n, n, n, n, n, n, n /))) call abort
+  if (any (minloc (h(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
+  if (any (minval (h(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ n, n, n, n, n /))) call abort
+  if (any (minloc (h, dim = 2, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
+  if (any (minval (h, dim = 2, mask = l2).ne.(/ n, n, n, n, n, n, n, n, n, n /))) call abort
+  if (any (minloc (h(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
+  if (any (minval (h(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ n, n, n, n, n /))) call abort
+  if (any (minloc (h, mask = l2).ne.(/ 0, 0 /))) call abort
+  if (minval (h, mask = l2).ne.n) call abort
+  if (any (minloc (h(::2,::2), mask = l2(::2,::2)).ne.(/ 0, 0 /))) call abort
+  if (minval (h(::2,::2), mask = l2(::2,::2)).ne.n) call abort
+  a = 7.0
+  b = 7.0
+  c = 7.0
+  d = 7.0
+end
diff --git a/gcc/testsuite/gfortran.dg/minlocval_4.f90 b/gcc/testsuite/gfortran.dg/minlocval_4.f90
new file mode 100644
index 000000000..c42b01944
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minlocval_4.f90
@@ -0,0 +1,120 @@
+! { dg-do run }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+  real :: a(3,3), b(3), nan, minf, pinf, h
+  logical :: l, l2
+  logical :: l3(3,3), l4(3,3), l5(3,3)
+
+  nan = 0.0
+  minf = 0.0
+  pinf = 0.0
+  nan = 0.0/nan
+  minf = -1.0/minf
+  pinf = 1.0/pinf
+  h = huge(h)
+  l = .false.
+  l2 = .true.
+  l3 = .false.
+  l4 = .true.
+  l5 = .true.
+  l5(1,1) = .false.
+  l5(1,2) = .false.
+  l5(2,3) = .false.
+  a = reshape ((/ nan, nan, nan, pinf, pinf, pinf, pinf, minf, pinf /), (/ 3, 3 /))
+  if (minval (a).ne.minf) call abort
+  if (any (minloc (a).ne.(/ 2, 3 /))) call abort
+  b = minval (a, dim = 1)
+  if (.not.isnan(b(1))) call abort
+  b(1) = 0.0
+  if (any (b.ne.(/ 0.0, pinf, minf /))) call abort
+  if (any (minloc (a, dim = 1).ne.(/ 1, 1, 2 /))) call abort
+  b = minval (a, dim = 2)
+  if (any (b.ne.(/ pinf, minf, pinf /))) call abort
+  if (any (minloc (a, dim = 2).ne.(/ 2, 3, 2 /))) call abort
+  if (minval (a, mask = l).ne.h) call abort
+  if (any (minloc (a, mask = l).ne.(/ 0, 0 /))) call abort
+  b = minval (a, dim = 1, mask = l)
+  if (any (b.ne.(/ h, h, h /))) call abort
+  if (any (minloc (a, dim = 1, mask = l).ne.(/ 0, 0, 0 /))) call abort
+  b = minval (a, dim = 2, mask = l)
+  if (any (b.ne.(/ h, h, h /))) call abort
+  if (any (minloc (a, dim = 2, mask = l).ne.(/ 0, 0, 0 /))) call abort
+  if (minval (a, mask = l3).ne.h) call abort
+  if (any (minloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
+  b = minval (a, dim = 1, mask = l3)
+  if (any (b.ne.(/ h, h, h /))) call abort
+  if (any (minloc (a, dim = 1, mask = l3).ne.(/ 0, 0, 0 /))) call abort
+  b = minval (a, dim = 2, mask = l3)
+  if (any (b.ne.(/ h, h, h /))) call abort
+  if (any (minloc (a, dim = 2, mask = l3).ne.(/ 0, 0, 0 /))) call abort
+  if (minval (a, mask = l2).ne.minf) call abort
+  if (minval (a, mask = l4).ne.minf) call abort
+  if (any (minloc (a, mask = l2).ne.(/ 2, 3 /))) call abort
+  if (any (minloc (a, mask = l4).ne.(/ 2, 3 /))) call abort
+  b = minval (a, dim = 1, mask = l2)
+  if (.not.isnan(b(1))) call abort
+  b(1) = 0.0
+  if (any (b.ne.(/ 0.0, pinf, minf /))) call abort
+  if (any (minloc (a, dim = 1, mask = l2).ne.(/ 1, 1, 2 /))) call abort
+  b = minval (a, dim = 2, mask = l2)
+  if (any (b.ne.(/ pinf, minf, pinf /))) call abort
+  if (any (minloc (a, dim = 2, mask = l2).ne.(/ 2, 3, 2 /))) call abort
+  b = minval (a, dim = 1, mask = l4)
+  if (.not.isnan(b(1))) call abort
+  b(1) = 0.0
+  if (any (b.ne.(/ 0.0, pinf, minf /))) call abort
+  if (any (minloc (a, dim = 1, mask = l2).ne.(/ 1, 1, 2 /))) call abort
+  b = minval (a, dim = 2, mask = l4)
+  if (any (b.ne.(/ pinf, minf, pinf /))) call abort
+  if (any (minloc (a, dim = 2, mask = l2).ne.(/ 2, 3, 2 /))) call abort
+  if (minval (a, mask = l5).ne.pinf) call abort
+  if (any (minloc (a, mask = l5).ne.(/ 2, 2 /))) call abort
+  b = minval (a, dim = 1, mask = l5)
+  if (.not.isnan(b(1))) call abort
+  b(1) = 0.0
+  if (any (b.ne.(/ 0.0, pinf, pinf /))) call abort
+  if (any (minloc (a, dim = 1, mask = l5).ne.(/ 2, 2, 1 /))) call abort
+  b = minval (a, dim = 2, mask = l5)
+  if (any (b.ne.(/ pinf, pinf, pinf /))) call abort
+  if (any (minloc (a, dim = 2, mask = l5).ne.(/ 3, 2, 2 /))) call abort
+  a = nan
+  if (.not.isnan(minval (a))) call abort
+  if (minval (a, mask = l).ne.h) call abort
+  if (.not.isnan(minval (a, mask = l2))) call abort
+  if (minval (a, mask = l3).ne.h) call abort
+  if (.not.isnan(minval (a, mask = l4))) call abort
+  if (.not.isnan(minval (a, mask = l5))) call abort
+  if (any (minloc (a).ne.(/ 1, 1 /))) call abort
+  if (any (minloc (a, mask = l).ne.(/ 0, 0 /))) call abort
+  if (any (minloc (a, mask = l2).ne.(/ 1, 1 /))) call abort
+  if (any (minloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
+  if (any (minloc (a, mask = l4).ne.(/ 1, 1 /))) call abort
+  if (any (minloc (a, mask = l5).ne.(/ 2, 1 /))) call abort
+  a = pinf
+  if (minval (a).ne.pinf) call abort
+  if (minval (a, mask = l).ne.h) call abort
+  if (minval (a, mask = l2).ne.pinf) call abort
+  if (minval (a, mask = l3).ne.h) call abort
+  if (minval (a, mask = l4).ne.pinf) call abort
+  if (minval (a, mask = l5).ne.pinf) call abort
+  if (any (minloc (a).ne.(/ 1, 1 /))) call abort
+  if (any (minloc (a, mask = l).ne.(/ 0, 0 /))) call abort
+  if (any (minloc (a, mask = l2).ne.(/ 1, 1 /))) call abort
+  if (any (minloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
+  if (any (minloc (a, mask = l4).ne.(/ 1, 1 /))) call abort
+  if (any (minloc (a, mask = l5).ne.(/ 2, 1 /))) call abort
+  a = nan
+  a(1,3) = pinf
+  if (minval (a).ne.pinf) call abort
+  if (minval (a, mask = l).ne.h) call abort
+  if (minval (a, mask = l2).ne.pinf) call abort
+  if (minval (a, mask = l3).ne.h) call abort
+  if (minval (a, mask = l4).ne.pinf) call abort
+  if (minval (a, mask = l5).ne.pinf) call abort
+  if (any (minloc (a).ne.(/ 1, 3 /))) call abort
+  if (any (minloc (a, mask = l).ne.(/ 0, 0 /))) call abort
+  if (any (minloc (a, mask = l2).ne.(/ 1, 3 /))) call abort
+  if (any (minloc (a, mask = l3).ne.(/ 0, 0 /))) call abort
+  if (any (minloc (a, mask = l4).ne.(/ 1, 3 /))) call abort
+  if (any (minloc (a, mask = l5).ne.(/ 1, 3 /))) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/minmax_char_1.f90 b/gcc/testsuite/gfortran.dg/minmax_char_1.f90
new file mode 100644
index 000000000..9e73e9850
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmax_char_1.f90
@@ -0,0 +1,73 @@
+! Tests for MIN and MAX intrinsics with character arguments
+!
+! { dg-do run }
+program test
+  character(len=3), parameter :: sp = "gee"
+  character(len=6), parameter :: tp = "crunch", wp = "flunch"
+  character(len=2), parameter :: up = "az", vp = "da"
+
+  character(len=3) :: s
+  character(len=6) :: t, w
+  character(len=2) :: u, v
+  s = "gee"
+  t = "crunch"
+  u = "az"
+  v = "da"
+  w = "flunch"
+
+  if (.not. equal(min("foo", "bar"), "bar")) call abort
+  if (.not. equal(max("foo", "bar"), "foo")) call abort
+  if (.not. equal(min("bar", "foo"), "bar")) call abort
+  if (.not. equal(max("bar", "foo"), "foo")) call abort
+
+  if (.not. equal(min("bar", "foo", sp), "bar")) call abort
+  if (.not. equal(max("bar", "foo", sp), "gee")) call abort
+  if (.not. equal(min("bar", sp, "foo"), "bar")) call abort
+  if (.not. equal(max("bar", sp, "foo"), "gee")) call abort
+  if (.not. equal(min(sp, "bar", "foo"), "bar")) call abort
+  if (.not. equal(max(sp, "bar", "foo"), "gee")) call abort
+
+  if (.not. equal(min("foo", "bar", s), "bar")) call abort
+  if (.not. equal(max("foo", "bar", s), "gee")) call abort
+  if (.not. equal(min("foo", s, "bar"), "bar")) call abort
+  if (.not. equal(max("foo", s, "bar"), "gee")) call abort
+  if (.not. equal(min(s, "foo", "bar"), "bar")) call abort
+  if (.not. equal(max(s, "foo", "bar"), "gee")) call abort
+
+  if (.not. equal(min("", ""), "")) call abort
+  if (.not. equal(max("", ""), "")) call abort
+  if (.not. equal(min("", " "), " ")) call abort
+  if (.not. equal(max("", " "), " ")) call abort
+
+  if (.not. equal(min(u,v,w), "az    ")) call abort
+  if (.not. equal(max(u,v,w), "flunch")) call abort
+  if (.not. equal(min(u,vp,w), "az    ")) call abort
+  if (.not. equal(max(u,vp,w), "flunch")) call abort
+  if (.not. equal(min(u,v,wp), "az    ")) call abort
+  if (.not. equal(max(u,v,wp), "flunch")) call abort
+  if (.not. equal(min(up,v,w), "az    ")) call abort
+  if (.not. equal(max(up,v,w), "flunch")) call abort
+
+  call foo("gee   ","az    ",s,t,u,v)
+  call foo("gee   ","az    ",s,t,u,v)
+  call foo("gee   ","az    ",s,t,u)
+  call foo("gee   ","crunch",s,t)
+
+contains
+
+  subroutine foo(res_max, res_min, a, b, c, d)
+    character(len=*) :: res_min, res_max
+    character(len=*), optional :: a, b, c, d
+
+    if (.not. equal(min(a,b,c,d), res_min)) call abort
+    if (.not. equal(max(a,b,c,d), res_max)) call abort
+  end subroutine foo
+
+  pure function equal(a,b)
+    character(len=*), intent(in) :: a, b
+    logical :: equal
+
+    equal = (len(a) == len(b)) .and. (a == b)
+  end function equal
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/minmax_char_2.f90 b/gcc/testsuite/gfortran.dg/minmax_char_2.f90
new file mode 100644
index 000000000..b5f74eac9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmax_char_2.f90
@@ -0,0 +1,4 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+  print *, min("foo", "bar") ! { dg-error "Fortran 2003.* CHARACTER argument" }
+  end
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_1.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_1.f90
new file mode 100644
index 000000000..fcdf7952e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_1.f90
@@ -0,0 +1,118 @@
+! { dg-do run }
+! Check max/minloc.
+! PR fortran/31726
+!
+program test
+  implicit none
+  integer :: i(1), j(-1:1), res(1)
+  logical, volatile :: m(3), m2(3)
+  m = (/ .false., .false., .false. /)
+  m2 = (/ .false., .true., .false. /)
+  call check(1, 0, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=.FALSE.))
+  call check(2, 0, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=m))
+  call check(3, 2, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=m2))
+  call check(4, 0, MAXLOC(i(1:0), DIM=1, MASK=.TRUE.))
+  call check(5, 0, MAXLOC(i(1:0), DIM=1, MASK=.FALSE.))
+  call check(6, 0, MAXLOC(i(1:0), DIM=1, MASK=m(1:0)))
+  call check(7, 0, MAXLOC(i(1:0), DIM=1))
+  call check(8, 0, MINLOC((/ 42, 23, 11 /), DIM=1, MASK=.FALSE.))
+  call check(9, 0, MINLOC((/ 42, 23, 11 /), DIM=1, MASK=m))
+  call check(10, 0, MINLOC(i(1:0), DIM=1, MASK=.FALSE.))
+  call check(11,0, MINLOC(i(1:0), DIM=1, MASK=m(1:0)))
+  call check(12,0, MINLOC(i(1:0), DIM=1, MASK=.TRUE.))
+  call check(13,0, MINLOC(i(1:0), DIM=1))
+
+  j = (/ 1, 2, 1 /); call check(14, 2, MAXLOC(j, DIM=1))
+  j = (/ 1, 2, 3 /); call check(15, 3, MAXLOC(j, DIM=1))
+  j = (/ 3, 2, 1 /); call check(16, 1, MAXLOC(j, DIM=1))
+  j = (/ 1, 2, 1 /); call check(17, 1, MINLOC(j, DIM=1))
+  j = (/ 1, 2, 3 /); call check(18, 1, MINLOC(j, DIM=1))
+  j = (/ 3, 2, 1 /); call check(19, 3, MINLOC(j, DIM=1))
+
+  j = (/ 1, 2, 1 /); call check(20, 2, MAXLOC(j, DIM=1,mask=.true.))
+  j = (/ 1, 2, 3 /); call check(21, 3, MAXLOC(j, DIM=1,mask=.true.))
+  j = (/ 3, 2, 1 /); call check(22, 1, MAXLOC(j, DIM=1,mask=.true.))
+  j = (/ 1, 2, 1 /); call check(23, 1, MINLOC(j, DIM=1,mask=.true.))
+  j = (/ 1, 2, 3 /); call check(24, 1, MINLOC(j, DIM=1,mask=.true.))
+  j = (/ 3, 2, 1 /); call check(25, 3, MINLOC(j, DIM=1,mask=.true.))
+
+  j = (/ 1, 2, 1 /); call check(26, 0, MAXLOC(j, DIM=1,mask=.false.))
+  j = (/ 1, 2, 3 /); call check(27, 0, MAXLOC(j, DIM=1,mask=.false.))
+  j = (/ 3, 2, 1 /); call check(28, 0, MAXLOC(j, DIM=1,mask=.false.))
+  j = (/ 1, 2, 1 /); call check(29, 0, MINLOC(j, DIM=1,mask=.false.))
+  j = (/ 1, 2, 3 /); call check(30, 0, MINLOC(j, DIM=1,mask=.false.))
+  j = (/ 3, 2, 1 /); call check(31, 0, MINLOC(j, DIM=1,mask=.false.))
+
+  j = (/ 1, 2, 1 /); call check(32, 0, MAXLOC(j, DIM=1,mask=m))
+  j = (/ 1, 2, 3 /); call check(33, 0, MAXLOC(j, DIM=1,mask=m))
+  j = (/ 3, 2, 1 /); call check(34, 0, MAXLOC(j, DIM=1,mask=m))
+  j = (/ 1, 2, 1 /); call check(35, 0, MINLOC(j, DIM=1,mask=m))
+  j = (/ 1, 2, 3 /); call check(36, 0, MINLOC(j, DIM=1,mask=m))
+  j = (/ 3, 2, 1 /); call check(37, 0, MINLOC(j, DIM=1,mask=m))
+
+  j = (/ 1, 2, 1 /); call check(38, 2, MAXLOC(j, DIM=1,mask=m2))
+  j = (/ 1, 2, 3 /); call check(39, 2, MAXLOC(j, DIM=1,mask=m2))
+  j = (/ 3, 2, 1 /); call check(40, 2, MAXLOC(j, DIM=1,mask=m2))
+  j = (/ 1, 2, 1 /); call check(41, 2, MINLOC(j, DIM=1,mask=m2))
+  j = (/ 1, 2, 3 /); call check(42, 2, MINLOC(j, DIM=1,mask=m2))
+  j = (/ 3, 2, 1 /); call check(43, 2, MINLOC(j, DIM=1,mask=m2))
+
+! Check the library minloc and maxloc
+  res = MAXLOC((/ 42, 23, 11 /), MASK=.FALSE.); call check(44, 0,  res(1))
+  res = MAXLOC((/ 42, 23, 11 /), MASK=m); call check(45, 0,  res(1))
+  res = MAXLOC((/ 42, 23, 11 /), MASK=m2); call check(46, 2,  res(1))
+  res = MAXLOC(i(1:0), MASK=.TRUE.); call check(47, 0,  res(1))
+  res = MAXLOC(i(1:0), MASK=.FALSE.); call check(48, 0,  res(1))
+  res = MAXLOC(i(1:0), MASK=m(1:0)); call check(49, 0,  res(1))
+  res = MAXLOC(i(1:0)); call check(50, 0,  res(1))
+  res = MINLOC((/ 42, 23, 11 /), MASK=.FALSE.); call check(51, 0, res(1))
+  res = MINLOC((/ 42, 23, 11 /), MASK=m); call check(52, 0, res(1))
+  res = MINLOC(i(1:0), MASK=.FALSE.); call check(53, 0, res(1))
+  res = MINLOC(i(1:0), MASK=m(1:0)); call check(54,0, res(1))
+  res = MINLOC(i(1:0), MASK=.TRUE.); call check(55,0, res(1))
+  res = MINLOC(i(1:0)); call check(56,0, res(1))
+
+  j = (/ 1, 2, 1 /); res = MAXLOC(j); call check(57, 2,  res(1))
+  j = (/ 1, 2, 3 /); res = MAXLOC(j); call check(58, 3,  res(1))
+  j = (/ 3, 2, 1 /); res = MAXLOC(j); call check(59, 1,  res(1))
+  j = (/ 1, 2, 1 /); res = MINLOC(j); call check(60, 1, res(1))
+  j = (/ 1, 2, 3 /); res = MINLOC(j); call check(61, 1, res(1))
+  j = (/ 3, 2, 1 /); res = MINLOC(j); call check(62, 3, res(1))
+
+  j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=.true.); call check(63, 2,  res(1))
+  j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=.true.); call check(65, 3,  res(1))
+  j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=.true.); call check(66, 1,  res(1))
+  j = (/ 1, 2, 1 /); res = MINLOC(j,mask=.true.); call check(67, 1, res(1))
+  j = (/ 1, 2, 3 /); res = MINLOC(j,mask=.true.); call check(68, 1, res(1))
+  j = (/ 3, 2, 1 /); res = MINLOC(j,mask=.true.); call check(69, 3, res(1))
+
+  j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=.false.); call check(70, 0,  res(1))
+  j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=.false.); call check(71, 0,  res(1))
+  j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=.false.); call check(72, 0,  res(1))
+  j = (/ 1, 2, 1 /); res = MINLOC(j,mask=.false.); call check(73, 0, res(1))
+  j = (/ 1, 2, 3 /); res = MINLOC(j,mask=.false.); call check(74, 0, res(1))
+  j = (/ 3, 2, 1 /); res = MINLOC(j,mask=.false.); call check(75, 0, res(1))
+
+  j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=m); call check(76, 0,  res(1))
+  j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=m); call check(77, 0,  res(1))
+  j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=m); call check(78, 0,  res(1))
+  j = (/ 1, 2, 1 /); res = MINLOC(j,mask=m); call check(79, 0, res(1))
+  j = (/ 1, 2, 3 /); res = MINLOC(j,mask=m); call check(80, 0, res(1))
+  j = (/ 3, 2, 1 /); res = MINLOC(j,mask=m);call check(81, 0, res(1))
+
+  j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=m2); call check(82, 2,  res(1))
+  j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=m2); call check(83, 2,  res(1))
+  j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=m2); call check(84, 2,  res(1))
+  j = (/ 1, 2, 1 /); res = MINLOC(j,mask=m2); call check(85, 2, res(1))
+  j = (/ 1, 2, 3 /); res = MINLOC(j,mask=m2); call check(86, 2, res(1))
+  j = (/ 3, 2, 1 /); res = MINLOC(j,mask=m2); call check(87, 2, res(1))
+
+contains
+subroutine check(n, i,j)
+  integer, value, intent(in) :: i,j,n
+  if(i /= j) then
+     call abort()
+!    print *, 'ERROR: Test',n,' expected ',i,' received ', j
+  end if
+end subroutine check
+end program
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_2.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_2.f90
new file mode 100644
index 000000000..a4fd7ae5e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_2.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! Tests the fix for PR32298, in which the scalarizer would generate
+! a temporary in the course of evaluating MINLOC or MAXLOC, thereby
+! setting the start of the scalarizer loop to zero.
+!
+! Contributed by Jens Bischoff <jens.bischoff@freenet.de> 
+!
+PROGRAM ERR_MINLOC
+
+   INTEGER, PARAMETER :: N = 7
+
+   DOUBLE PRECISION, DIMENSION (N), PARAMETER :: A &
+     = (/ 0.3D0, 0.455D0, 0.6D0, 0.7D0, 0.72D0, 0.76D0, 0.79D0 /)
+
+   DOUBLE PRECISION :: B
+   INTEGER          :: I, J(N), K(N)
+
+  DO I = 1, N
+    B = A(I)
+    J(I) = MINLOC (ABS (A - B), 1)
+    K(I) = MAXLOC (ABS (A - B), 1)
+  END DO
+
+  if (any (J .NE. (/1,2,3,4,5,6,7/))) call abort ()
+  if (any (K .NE. (/7,7,1,1,1,1,1/))) call abort ()
+
+  STOP
+
+END PROGRAM ERR_MINLOC
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_3.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_3.f90
new file mode 100644
index 000000000..fbc1b09f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_3.f90
@@ -0,0 +1,119 @@
+! { dg-do run }
+! { dg-options "-fdefault-integer-8" }
+! Check max/minloc.
+! PR fortran/32956, wrong mask kind with -fdefault-integer-8
+!
+program test
+  implicit none
+  integer :: i(1), j(-1:1), res(1)
+  logical, volatile :: m(3), m2(3)
+  m = (/ .false., .false., .false. /)
+  m2 = (/ .false., .true., .false. /)
+  call check(1, 0, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=.FALSE.))
+  call check(2, 0, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=m))
+  call check(3, 2, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=m2))
+  call check(4, 0, MAXLOC(i(1:0), DIM=1, MASK=.TRUE.))
+  call check(5, 0, MAXLOC(i(1:0), DIM=1, MASK=.FALSE.))
+  call check(6, 0, MAXLOC(i(1:0), DIM=1, MASK=m(1:0)))
+  call check(7, 0, MAXLOC(i(1:0), DIM=1))
+  call check(8, 0, MINLOC((/ 42, 23, 11 /), DIM=1, MASK=.FALSE.))
+  call check(9, 0, MINLOC((/ 42, 23, 11 /), DIM=1, MASK=m))
+  call check(10, 0, MINLOC(i(1:0), DIM=1, MASK=.FALSE.))
+  call check(11,0, MINLOC(i(1:0), DIM=1, MASK=m(1:0)))
+  call check(12,0, MINLOC(i(1:0), DIM=1, MASK=.TRUE.))
+  call check(13,0, MINLOC(i(1:0), DIM=1))
+
+  j = (/ 1, 2, 1 /); call check(14, 2, MAXLOC(j, DIM=1))
+  j = (/ 1, 2, 3 /); call check(15, 3, MAXLOC(j, DIM=1))
+  j = (/ 3, 2, 1 /); call check(16, 1, MAXLOC(j, DIM=1))
+  j = (/ 1, 2, 1 /); call check(17, 1, MINLOC(j, DIM=1))
+  j = (/ 1, 2, 3 /); call check(18, 1, MINLOC(j, DIM=1))
+  j = (/ 3, 2, 1 /); call check(19, 3, MINLOC(j, DIM=1))
+
+  j = (/ 1, 2, 1 /); call check(20, 2, MAXLOC(j, DIM=1,mask=.true.))
+  j = (/ 1, 2, 3 /); call check(21, 3, MAXLOC(j, DIM=1,mask=.true.))
+  j = (/ 3, 2, 1 /); call check(22, 1, MAXLOC(j, DIM=1,mask=.true.))
+  j = (/ 1, 2, 1 /); call check(23, 1, MINLOC(j, DIM=1,mask=.true.))
+  j = (/ 1, 2, 3 /); call check(24, 1, MINLOC(j, DIM=1,mask=.true.))
+  j = (/ 3, 2, 1 /); call check(25, 3, MINLOC(j, DIM=1,mask=.true.))
+
+  j = (/ 1, 2, 1 /); call check(26, 0, MAXLOC(j, DIM=1,mask=.false.))
+  j = (/ 1, 2, 3 /); call check(27, 0, MAXLOC(j, DIM=1,mask=.false.))
+  j = (/ 3, 2, 1 /); call check(28, 0, MAXLOC(j, DIM=1,mask=.false.))
+  j = (/ 1, 2, 1 /); call check(29, 0, MINLOC(j, DIM=1,mask=.false.))
+  j = (/ 1, 2, 3 /); call check(30, 0, MINLOC(j, DIM=1,mask=.false.))
+  j = (/ 3, 2, 1 /); call check(31, 0, MINLOC(j, DIM=1,mask=.false.))
+
+  j = (/ 1, 2, 1 /); call check(32, 0, MAXLOC(j, DIM=1,mask=m))
+  j = (/ 1, 2, 3 /); call check(33, 0, MAXLOC(j, DIM=1,mask=m))
+  j = (/ 3, 2, 1 /); call check(34, 0, MAXLOC(j, DIM=1,mask=m))
+  j = (/ 1, 2, 1 /); call check(35, 0, MINLOC(j, DIM=1,mask=m))
+  j = (/ 1, 2, 3 /); call check(36, 0, MINLOC(j, DIM=1,mask=m))
+  j = (/ 3, 2, 1 /); call check(37, 0, MINLOC(j, DIM=1,mask=m))
+
+  j = (/ 1, 2, 1 /); call check(38, 2, MAXLOC(j, DIM=1,mask=m2))
+  j = (/ 1, 2, 3 /); call check(39, 2, MAXLOC(j, DIM=1,mask=m2))
+  j = (/ 3, 2, 1 /); call check(40, 2, MAXLOC(j, DIM=1,mask=m2))
+  j = (/ 1, 2, 1 /); call check(41, 2, MINLOC(j, DIM=1,mask=m2))
+  j = (/ 1, 2, 3 /); call check(42, 2, MINLOC(j, DIM=1,mask=m2))
+  j = (/ 3, 2, 1 /); call check(43, 2, MINLOC(j, DIM=1,mask=m2))
+
+! Check the library minloc and maxloc
+  res = MAXLOC((/ 42, 23, 11 /), MASK=.FALSE.); call check(44, 0,  res(1))
+  res = MAXLOC((/ 42, 23, 11 /), MASK=m); call check(45, 0,  res(1))
+  res = MAXLOC((/ 42, 23, 11 /), MASK=m2); call check(46, 2,  res(1))
+  res = MAXLOC(i(1:0), MASK=.TRUE.); call check(47, 0,  res(1))
+  res = MAXLOC(i(1:0), MASK=.FALSE.); call check(48, 0,  res(1))
+  res = MAXLOC(i(1:0), MASK=m(1:0)); call check(49, 0,  res(1))
+  res = MAXLOC(i(1:0)); call check(50, 0,  res(1))
+  res = MINLOC((/ 42, 23, 11 /), MASK=.FALSE.); call check(51, 0, res(1))
+  res = MINLOC((/ 42, 23, 11 /), MASK=m); call check(52, 0, res(1))
+  res = MINLOC(i(1:0), MASK=.FALSE.); call check(53, 0, res(1))
+  res = MINLOC(i(1:0), MASK=m(1:0)); call check(54,0, res(1))
+  res = MINLOC(i(1:0), MASK=.TRUE.); call check(55,0, res(1))
+  res = MINLOC(i(1:0)); call check(56,0, res(1))
+
+  j = (/ 1, 2, 1 /); res = MAXLOC(j); call check(57, 2,  res(1))
+  j = (/ 1, 2, 3 /); res = MAXLOC(j); call check(58, 3,  res(1))
+  j = (/ 3, 2, 1 /); res = MAXLOC(j); call check(59, 1,  res(1))
+  j = (/ 1, 2, 1 /); res = MINLOC(j); call check(60, 1, res(1))
+  j = (/ 1, 2, 3 /); res = MINLOC(j); call check(61, 1, res(1))
+  j = (/ 3, 2, 1 /); res = MINLOC(j); call check(62, 3, res(1))
+
+  j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=.true.); call check(63, 2,  res(1))
+  j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=.true.); call check(65, 3,  res(1))
+  j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=.true.); call check(66, 1,  res(1))
+  j = (/ 1, 2, 1 /); res = MINLOC(j,mask=.true.); call check(67, 1, res(1))
+  j = (/ 1, 2, 3 /); res = MINLOC(j,mask=.true.); call check(68, 1, res(1))
+  j = (/ 3, 2, 1 /); res = MINLOC(j,mask=.true.); call check(69, 3, res(1))
+
+  j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=.false.); call check(70, 0,  res(1))
+  j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=.false.); call check(71, 0,  res(1))
+  j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=.false.); call check(72, 0,  res(1))
+  j = (/ 1, 2, 1 /); res = MINLOC(j,mask=.false.); call check(73, 0, res(1))
+  j = (/ 1, 2, 3 /); res = MINLOC(j,mask=.false.); call check(74, 0, res(1))
+  j = (/ 3, 2, 1 /); res = MINLOC(j,mask=.false.); call check(75, 0, res(1))
+
+  j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=m); call check(76, 0,  res(1))
+  j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=m); call check(77, 0,  res(1))
+  j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=m); call check(78, 0,  res(1))
+  j = (/ 1, 2, 1 /); res = MINLOC(j,mask=m); call check(79, 0, res(1))
+  j = (/ 1, 2, 3 /); res = MINLOC(j,mask=m); call check(80, 0, res(1))
+  j = (/ 3, 2, 1 /); res = MINLOC(j,mask=m);call check(81, 0, res(1))
+
+  j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=m2); call check(82, 2,  res(1))
+  j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=m2); call check(83, 2,  res(1))
+  j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=m2); call check(84, 2,  res(1))
+  j = (/ 1, 2, 1 /); res = MINLOC(j,mask=m2); call check(85, 2, res(1))
+  j = (/ 1, 2, 3 /); res = MINLOC(j,mask=m2); call check(86, 2, res(1))
+  j = (/ 3, 2, 1 /); res = MINLOC(j,mask=m2); call check(87, 2, res(1))
+
+contains
+subroutine check(n, i,j)
+  integer, value, intent(in) :: i,j,n
+  if(i /= j) then
+     call abort()
+!    print *, 'ERROR: Test',n,' expected ',i,' received ', j
+  end if
+end subroutine check
+end program
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_4.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_4.f90
new file mode 100644
index 000000000..673739518
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_4.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! Test to make sure that PR 33354 remains fixed and doesn't regress
+PROGRAM TST
+  IMPLICIT NONE
+  REAL :: A(1,3)
+  A(:,1) = 10
+  A(:,2) = 20
+  A(:,3) = 30
+
+  !WRITE(*,*) SUM(A(:,1:3),1)
+  !WRITE(*,*) MINLOC(SUM(A(:,1:3),1),1)
+  if (minloc(sum(a(:,1:3),1),1) .ne. 1) call abort()
+  if (maxloc(sum(a(:,1:3),1),1) .ne. 3) call abort()
+
+END PROGRAM TST
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_5.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_5.f90
new file mode 100644
index 000000000..92e2103de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_5.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR35994 [4.3/4.4 regression] MAXLOC and MINLOC off by one with mask
+program GA4076
+  REAL DDA(100)
+  dda = (/(J1,J1=1,100)/)
+  IDS = MAXLOC(DDA,1)
+  if (ids.ne.100) call abort  !expect 100
+  
+  IDS = MAXLOC(DDA,1, (/(J1,J1=1,100)/) > 50)
+  if (ids.ne.100) call abort  !expect 100
+
+  IDS = minLOC(DDA,1)
+  if (ids.ne.1) call abort  !expect 1
+
+  IDS = MinLOC(DDA,1, (/(J1,J1=1,100)/) > 50)
+  if (ids.ne.51) call abort !expect 51
+
+END
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_6.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_6.f90
new file mode 100644
index 000000000..c61fab47e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_6.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! PR35994 [4.3/4.4 regression] MAXLOC and MINLOC off by one with mask
+  REAL DDA(5:104)
+  dda = (/(J1,J1=1,100)/)
+
+  IDS = MAXLOC(DDA,1)
+  if (ids.ne.100) call abort  !expect 100
+  IDS = MAXLOC(DDA,1, (/(J1,J1=1,100)/) > 50)
+  if (ids.ne.100) call abort  !expect 100
+
+  END
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_integer_kinds_1.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_integer_kinds_1.f90
new file mode 100644
index 000000000..cbf84ec41
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_integer_kinds_1.f90
@@ -0,0 +1,10 @@
+! { dg-do link }
+! PR 30415 - minloc and maxloc for integer kinds=1 and 2 were missing
+! Test case by Harald Anlauf
+program gfcbug55
+  integer(kind=1) :: i1(4) = 1
+  integer(kind=2) :: i2(4) = 1
+  print *, minloc(i1), maxloc(i1)
+  print *, minloc(i2), maxloc(i2)
+end program gfcbug55
+
diff --git a/gcc/testsuite/gfortran.dg/minmaxval_1.f90 b/gcc/testsuite/gfortran.dg/minmaxval_1.f90
new file mode 100644
index 000000000..bb16d2e5f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxval_1.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! Tests the fix for PR37836 in which the specification expressions for
+! y were not simplified because there was no simplifier for minval and
+! maxval.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+! nint(exp(3.0)) is equal to 20 :-)
+!
+      function fun4a()
+         integer fun4a
+         real y(minval([25, nint(exp(3.0)), 15]))
+
+        fun4a = size (y, 1)
+       end function fun4a
+
+      function fun4b()
+         integer fun4b
+         real y(maxval([25, nint(exp(3.0)), 15]))
+         save
+
+         fun4b = size (y, 1)
+      end function fun4b
+
+      EXTERNAL fun4a, fun4b
+      integer fun4a, fun4b
+      if (fun4a () .ne. 15) call abort 
+      if (fun4b () .ne. 25) call abort 
+      end
diff --git a/gcc/testsuite/gfortran.dg/missing_derived_type_1.f90 b/gcc/testsuite/gfortran.dg/missing_derived_type_1.f90
new file mode 100644
index 000000000..49c1ec8ce
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/missing_derived_type_1.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! Tests the fix for PR29364, in which the the absence of the derived type
+! 'nonexist' was not diagnosed.
+!
+! Contributed by Tobias Burnus  <tobias.burnus@physik.fu-berlin.de>
+!
+module test
+  implicit none
+  type epot_t
+    integer :: c
+    type(nonexist),pointer :: l ! { dg-error "has not been declared" }
+  end type epot_t
+end module test
+! { dg-final { cleanup-modules "test" } }
diff --git a/gcc/testsuite/gfortran.dg/missing_optional_dummy_1.f90 b/gcc/testsuite/gfortran.dg/missing_optional_dummy_1.f90
new file mode 100644
index 000000000..29f08f9e0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/missing_optional_dummy_1.f90
@@ -0,0 +1,49 @@
+! { dg-do run }
+! Test the fix for PR26891, in which an optional argument, whose actual
+! is a missing dummy argument would cause a segfault.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+  logical :: back =.false.
+
+! This was the case that would fail - PR case was an intrinsic call.
+  if (scan ("A quick brown fox jumps over the lazy dog", "lazy", back) &
+      .ne. myscan ("A quick brown fox jumps over the lazy dog", "lazy")) &
+    call abort ()
+
+! Check that the patch works with non-intrinsic functions.
+  if (myscan ("A quick brown fox jumps over the lazy dog", "fox", back) &
+      .ne. thyscan ("A quick brown fox jumps over the lazy dog", "fox")) &
+    call abort ()
+
+! Check that missing, optional character actual arguments are OK.
+  if (scan ("A quick brown fox jumps over the lazy dog", "over", back) &
+      .ne. thyscan ("A quick brown fox jumps over the lazy dog")) &
+    call abort ()
+
+contains
+  integer function myscan (str, substr, back)
+    character(*), intent(in) :: str, substr
+    logical, optional, intent(in) :: back
+    myscan = scan (str, substr, back)
+  end function myscan
+
+  integer function thyscan (str, substr, back)
+    character(*), intent(in) :: str
+    character(*), optional, intent(in) :: substr
+    logical, optional, intent(in) :: back
+    thyscan = isscan (str, substr, back)
+  end function thyscan
+
+  integer function isscan (str, substr, back)
+    character(*), intent(in) :: str
+    character(*), optional :: substr
+    logical, optional, intent(in) :: back
+    if (.not.present(substr)) then
+      isscan = myscan (str, "over", back)
+    else
+      isscan = myscan (str, substr, back)
+    end if
+  end function isscan
+
+end
diff --git a/gcc/testsuite/gfortran.dg/missing_optional_dummy_2.f90 b/gcc/testsuite/gfortran.dg/missing_optional_dummy_2.f90
new file mode 100644
index 000000000..100784d87
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/missing_optional_dummy_2.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+! Tests the fix for PR29321 and PR29322, in which ICEs occurred for the
+! lack of proper attention to checking pointers in gfc_conv_function_call.
+!
+! Contributed by Olav Vahtras  <vahtras@pdc.kth.se>
+! and Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+!
+MODULE myint
+   TYPE NUM
+      INTEGER :: R = 0
+   END TYPE NUM
+   CONTAINS 
+      FUNCTION FUNC(A,B) RESULT(E)
+      IMPLICIT NONE
+      TYPE(NUM)  A,B,E
+      INTENT(IN) ::  A,B
+      OPTIONAL B
+      E%R=A%R
+      CALL SUB(A,E)
+      END FUNCTION FUNC
+
+      SUBROUTINE SUB(A,E,B,C)
+      IMPLICIT NONE
+      TYPE(NUM) A,E,B,C
+      INTENT(IN)   A,B
+      INTENT(OUT)  E,C
+      OPTIONAL B,C
+      E%R=A%R
+      END SUBROUTINE SUB
+END MODULE myint
+
+  if (isscan () /= 0) call abort
+contains
+  integer function isscan (substr)
+    character(*), optional :: substr
+    if (.not.present(substr)) isscan = myscan ("foo", "over")
+  end function isscan
+end
+! { dg-final { cleanup-modules "myint" } }
+
diff --git a/gcc/testsuite/gfortran.dg/missing_optional_dummy_3.f90 b/gcc/testsuite/gfortran.dg/missing_optional_dummy_3.f90
new file mode 100644
index 000000000..d330ddaea
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/missing_optional_dummy_3.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! Tests the fix for PR29976, in which the call to CMPLX caused an
+! ICE with an optional dummy for the imaginary part.
+!
+! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!
+SUBROUTINE pw_sumup (alpha_im)
+  REAL, INTENT(in), OPTIONAL :: alpha_im
+  COMPLEX :: my_alpha_c
+  IF (PRESENT(alpha_im)) THEN
+     my_alpha_c = CMPLX(0.,alpha_im)
+  END IF
+END SUBROUTINE pw_sumup
+
+! Check non-intrinsic functions.
+SUBROUTINE pw_sumup_2 (alpha_im)
+  REAL, INTENT(in), OPTIONAL :: alpha_im
+  COMPLEX :: my_alpha_c
+  IF (PRESENT(alpha_im)) THEN
+     my_alpha_c = MY_CMPLX(0.,alpha_im)
+  END IF
+contains
+  complex function MY_CMPLX (re, im)
+    real, intent(in) :: re
+    real, intent(in), optional :: im
+    if (present (im)) then 
+      MY_CMPLX = cmplx (re, im)
+    else
+      MY_CMPLX = cmplx (re, 0.0)
+    end if
+  end function MY_CMPLX
+END SUBROUTINE pw_sumup_2
diff --git a/gcc/testsuite/gfortran.dg/missing_optional_dummy_4.f90 b/gcc/testsuite/gfortran.dg/missing_optional_dummy_4.f90
new file mode 100644
index 000000000..9b1a574d7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/missing_optional_dummy_4.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/34848
+! 
+! The "0" for the string size of the absent optional
+! argument was missing.
+!
+module krmod
+contains
+ subroutine doit()
+   implicit none
+    real :: doit1
+    doit1 = tm_doit()
+   return
+ end subroutine doit
+ function tm_doit(genloc)
+   implicit none
+   character, optional  :: genloc
+   real :: tm_doit
+   tm_doit = 42.0 
+ end function tm_doit
+end module krmod
+
+! { dg-final { scan-tree-dump " tm_doit \\(0B, 0\\);" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-modules "krmod" } }
+
diff --git a/gcc/testsuite/gfortran.dg/missing_optional_dummy_5.f90 b/gcc/testsuite/gfortran.dg/missing_optional_dummy_5.f90
new file mode 100644
index 000000000..29a9d70f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/missing_optional_dummy_5.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/34848
+! 
+! This was before giving an ICE; additionally
+! the "0" for the string size of the absent optional
+! argument was missing.
+!
+module krmod
+contains
+ subroutine doit()
+   implicit none
+    real :: doit1(2)
+    doit1 = tm_doit()
+   return
+ end subroutine doit
+ function tm_doit(genloc)
+   implicit none
+   character, optional  :: genloc
+   real :: tm_doit(2)
+   tm_doit = 42.0 
+ end function tm_doit
+end module krmod
+
+! { dg-final { scan-tree-dump " tm_doit \\(&parm\.., 0B, 0\\);" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-modules "krmod" } }
+
diff --git a/gcc/testsuite/gfortran.dg/missing_optional_dummy_6.f90 b/gcc/testsuite/gfortran.dg/missing_optional_dummy_6.f90
new file mode 100644
index 000000000..408582289
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/missing_optional_dummy_6.f90
@@ -0,0 +1,60 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/41907
+!
+program test
+  implicit none
+  call scalar1 ()
+  call assumed_shape1 ()
+  call explicit_shape1 ()
+contains
+
+  ! Calling functions
+  subroutine scalar1 (slr1)
+    integer, optional :: slr1
+    call scalar2 (slr1)
+  end subroutine scalar1
+
+  subroutine assumed_shape1 (as1)
+    integer, dimension(:), optional :: as1
+    call assumed_shape2 (as1)
+    call explicit_shape2 (as1)
+  end subroutine assumed_shape1
+
+  subroutine explicit_shape1 (es1)
+    integer, dimension(5), optional :: es1
+    call assumed_shape2 (es1)
+    call explicit_shape2 (es1)
+  end subroutine explicit_shape1
+
+
+  ! Called functions
+  subroutine assumed_shape2 (as2)
+    integer, dimension(:),optional :: as2
+    if (present (as2)) call abort()
+  end subroutine assumed_shape2
+
+  subroutine explicit_shape2 (es2)
+    integer, dimension(5),optional :: es2
+    if (present (es2)) call abort()
+  end subroutine explicit_shape2
+
+  subroutine scalar2 (slr2)
+    integer, optional :: slr2
+    if (present (slr2)) call abort()
+  end subroutine scalar2
+
+end program test
+
+! { dg-final { scan-tree-dump-times "scalar2 \\(slr1" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "= es1 != 0B" 1 "original" } }
+! { dg-final { scan-tree-dump-times "assumed_shape2 \\(es1" 0 "original" } }
+! { dg-final { scan-tree-dump-times "explicit_shape2 \\(es1" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "= as1 != 0B" 2 "original" } }
+! { dg-final { scan-tree-dump-times "assumed_shape2 \\(as1" 0 "original" } }
+! { dg-final { scan-tree-dump-times "explicit_shape2 \\(as1" 0 "original" } }
+
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/missing_parens_1.f90 b/gcc/testsuite/gfortran.dg/missing_parens_1.f90
new file mode 100644
index 000000000..e9657f9bc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/missing_parens_1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! PR34325 Wrong error message for syntax error
+program aa
+implicit none
+real(kind=8)::r1=0
+real(kind=8),dimension((1)::r2 ! { dg-error "Missing '\\)' in statement" }
+real(kind=8),dimension(3,3)::r3
+character(25) :: a
+a = 'I am not a )))))'')''.'
+if ((((((a /= "I am not a )))))')'.")))))) call abort
+if ((((((a /= 'I am not a )))))'')''.')))))) call abort
+a = "I am not a )))))"")""."
+if ((((((a /= "I am not a )))))"")"".")))))) call abort
+if (((3*r1)**2)>= 0) a = "good"
+if ((3*r1)**2)>= 0) a = "bad" ! { dg-error "Missing '\\(' in statement" }
+r3((2,2)) = 4.3 ! { dg-error "found COMPLEX" }
+do while ((.true.) ! { dg-error "Missing '\\)' in statement" }
+do while (.true. ! { dg-error "Missing '\\)' in statement" }
+end
diff --git a/gcc/testsuite/gfortran.dg/missing_parens_2.f90 b/gcc/testsuite/gfortran.dg/missing_parens_2.f90
new file mode 100644
index 000000000..b06c2ae67
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/missing_parens_2.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! PR34325 Wrong error message for syntax error
+program aa
+implicit none
+real(kind=8)::r1=0
+character(25) :: a
+a = 'I am not a )))))'')''.'
+if ((((((a /= "I am not a )))))')'.")))))) call abort
+if ((((((a /= 'I am not a )))))'')''.')))))) call abort
+a = "I am not a )))))"")""."
+if ((((((a /= "I am not a )))))"")"".")))))) call abort
+if (((3*r1)**2)>= 0) a = "good"
+if (a /= "good") call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/mixed_io_1.c b/gcc/testsuite/gfortran.dg/mixed_io_1.c
new file mode 100644
index 000000000..0f8d9cdcf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mixed_io_1.c
@@ -0,0 +1,4 @@
+#include <stdio.h>
+void cio_(void){
+  printf("12345");
+}
diff --git a/gcc/testsuite/gfortran.dg/mixed_io_1.f90 b/gcc/testsuite/gfortran.dg/mixed_io_1.f90
new file mode 100644
index 000000000..4ea719fb4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mixed_io_1.f90
@@ -0,0 +1,6 @@
+! { dg-do run }
+! { dg-additional-sources mixed_io_1.c }
+! { dg-options "-w" } 
+      call cio
+      write(*,"(A)") '6789' ! { dg-output "123456789" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/module_blank_common.f90 b/gcc/testsuite/gfortran.dg/module_blank_common.f90
new file mode 100644
index 000000000..a06ff0098
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_blank_common.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+!
+! This tests that blank common works in modules. PR23270
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module global
+  common a, b
+  real    a, b
+end module global
+program blank_common
+  use global
+  common z
+  complex z
+  a = 999.0_4
+  b = -999.0_4
+  if (z.ne.cmplx (a,b)) call abort ()
+end program blank_common
+
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/module_commons_1.f90 b/gcc/testsuite/gfortran.dg/module_commons_1.f90
new file mode 100644
index 000000000..bd2c7f99b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_commons_1.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! This program tests that use associated common blocks work.
+!
+! provided by Paul Thomas - pault@gcc.gnu.org
+!
+module m1
+  common /x/ a
+end module m1
+module m2
+  common /x/ a
+end module m2
+
+subroutine foo ()
+  use m2
+  if (a.ne.99.0) call abort ()
+end subroutine foo
+
+program collision
+  use m1
+  use m2, only: b=>a
+  b = 99.0
+  call foo ()
+end program collision
+
+! { dg-final { cleanup-modules "m1 m2" } }
diff --git a/gcc/testsuite/gfortran.dg/module_commons_2.f90 b/gcc/testsuite/gfortran.dg/module_commons_2.f90
new file mode 100644
index 000000000..3c3214c20
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_commons_2.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! Tests the fix for PR35474, in which the PRIVATE statement would
+! cause the error Internal Error at (1): free_pi_tree(): Unresolved fixup
+! This arose because the symbol for 'i' emanating from the COMMON was
+! not being fixed-up as the EQUIVALENCE was built.
+!
+! Contributed by FX Coudert <fxcoudert@gcc.gnu.org>
+!
+module h5global
+  integer i
+  integer j
+  common /c/ i
+  equivalence (i, j)
+  private
+end module h5global
+
+program bug
+  use h5global
+end
+
+! { dg-final { cleanup-modules "h5global" } }
diff --git a/gcc/testsuite/gfortran.dg/module_commons_3.f90 b/gcc/testsuite/gfortran.dg/module_commons_3.f90
new file mode 100644
index 000000000..a57863e9a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_commons_3.f90
@@ -0,0 +1,57 @@
+! { dg-do run }
+!
+! PR fortran/38657, in which the mixture of PRIVATE and
+! COMMON in TEST4, would mess up the association with
+! TESTCHAR in TEST2.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+! From a report in clf by Chris Bradley.
+!
+MODULE TEST4
+  PRIVATE
+  CHARACTER(LEN=80) :: T1 = &
+    "Mary had a little lamb, Its fleece was white as snow;"
+  CHARACTER(LEN=80) :: T2 = &
+    "And everywhere that Mary went, The lamb was sure to go."
+  CHARACTER(LEN=80) :: TESTCHAR
+  COMMON /TESTCOMMON1/ TESTCHAR
+  PUBLIC T1, T2, FOOBAR
+CONTAINS
+  subroutine FOOBAR (CHECK)
+    CHARACTER(LEN=80) :: CHECK
+    IF (TESTCHAR .NE. CHECK) CALL ABORT
+  end subroutine
+END MODULE TEST4
+
+MODULE TEST3
+  CHARACTER(LEN=80) :: TESTCHAR
+  COMMON /TESTCOMMON1/ TESTCHAR
+END MODULE TEST3
+
+MODULE TEST2
+  use TEST4
+  USE TEST3, chr => testchar
+  PRIVATE
+  CHARACTER(LEN=80) :: TESTCHAR
+  COMMON /TESTCOMMON1/ TESTCHAR
+  PUBLIC TESTCHAR, FOO, BAR, CHR, T1, T2, FOOBAR
+contains
+  subroutine FOO
+    TESTCHAR = T1
+  end subroutine
+  subroutine BAR (CHECK)
+    CHARACTER(LEN=80) :: CHECK
+    IF (TESTCHAR .NE. CHECK) CALL ABORT
+    IF (CHR .NE. CHECK) CALL ABORT
+  end subroutine
+END MODULE TEST2
+
+PROGRAM TEST1
+  USE TEST2
+  call FOO
+  call BAR (T1)
+  TESTCHAR = T2
+  call BAR (T2)
+  CALL FOOBAR (T2)
+END PROGRAM TEST1
+! { dg-final { cleanup-modules "TEST2 TEST3 TEST4" } }
diff --git a/gcc/testsuite/gfortran.dg/module_double_reuse.f90 b/gcc/testsuite/gfortran.dg/module_double_reuse.f90
new file mode 100644
index 000000000..694e821b7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_double_reuse.f90
@@ -0,0 +1,20 @@
+! Test of fix for PR18878
+!
+! Based on example in PR by Steve Kargl
+!
+module a
+  integer, parameter :: b = kind(1.d0)
+  real(b)            :: z
+end module a
+program d
+  use a, only : e => b, f => b, u => z, v => z
+  real(e) x
+  real(f) y
+  x = 1.e0_e
+  y = 1.e0_f
+  u = 99.0
+  if (kind(x).ne.kind(y)) call abort ()
+  if (v.ne.u) call abort ()
+end program d
+
+! { dg-final { cleanup-modules "a" } }
diff --git a/gcc/testsuite/gfortran.dg/module_equivalence_1.f90 b/gcc/testsuite/gfortran.dg/module_equivalence_1.f90
new file mode 100644
index 000000000..fecfb89fa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_equivalence_1.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! This tests the fix for PR17917, where equivalences were not being
+! written to and read back from modules.
+!
+! Contributed by Paul Thomas  pault@gcc.gnu.org
+!
+module test_equiv !Bug 17917
+  common /my_common/ d
+  real    a(2),b(4),c(4), d(8)
+  equivalence (a(1),b(2)), (c(1),d(5))
+end module test_equiv
+
+subroutine foo ()
+  use test_equiv, z=>b
+  if (any (d(5:8)/=z)) call abort ()
+end subroutine foo
+
+program module_equiv
+  use test_equiv
+  b = 99.0_4
+  a = 999.0_4
+  c = (/99.0_4, 999.0_4, 999.0_4, 99.0_4/)
+  call foo ()
+end program module_equiv
+
+! { dg-final { cleanup-modules "test_equiv" } }
diff --git a/gcc/testsuite/gfortran.dg/module_equivalence_2.f90 b/gcc/testsuite/gfortran.dg/module_equivalence_2.f90
new file mode 100644
index 000000000..f6a3c3403
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_equivalence_2.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! Tests the fix for PR27269 and PR27xxx.
+! The former caused a segfault in trying to process
+! module b, with an unused equivalence in a. The latter
+! produced an assembler error due to multiple declarations
+! for a module equivalence, when one of the variables was
+! initialized, as M in module a.
+!
+module a
+  integer, parameter :: dp = selected_real_kind (10)
+  real(dp) :: reM, M = 1.77d0
+  equivalence (M, reM)
+end module a
+
+module b
+  use a, only : dp
+end module b
+
+  use a
+  use b
+  if (reM .ne. 1.77d0) call abort ()
+  reM = 0.57d1
+  if (M .ne. 0.57d1) call abort ()
+end
+! { dg-final { cleanup-modules "a b" } }
diff --git a/gcc/testsuite/gfortran.dg/module_equivalence_3.f90 b/gcc/testsuite/gfortran.dg/module_equivalence_3.f90
new file mode 100644
index 000000000..d646f9740
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_equivalence_3.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! This checks the fix for PR32103 in which not using one member
+! of an equivalence group would cause all memory of the equivalence
+! to be lost and subsequent incorrect referencing of the remaining
+! members. 
+!
+! Contributed by Toon Moene <toon@moene.indiv.nluug.nl> 
+!
+module aap
+   real :: a(5) = (/1.0,2.0,3.0,4.0,5.0/) 
+   real :: b(3)
+   real :: d(5) = (/1.0,2.0,3.0,4.0,5.0/) 
+   equivalence (a(3),b(1))
+end module aap
+
+  use aap, only : b
+  call foo
+  call bar
+!  call foobar
+contains
+  subroutine foo
+    use aap, only : c=>b
+    if (any(c .ne. b)) call abort ()
+  end subroutine
+  subroutine bar
+    use aap, only : a
+    if (any(a(3:5) .ne. b)) call abort ()
+  end subroutine
+
+! Make sure that bad things do not happen if we do not USE a or b.
+
+  subroutine foobar
+    use aap, only : d
+    if (any(d(3:5) .ne. b)) call abort ()
+  end subroutine
+end
+
+! { dg-final { cleanup-modules "aap" } }
diff --git a/gcc/testsuite/gfortran.dg/module_equivalence_4.f90 b/gcc/testsuite/gfortran.dg/module_equivalence_4.f90
new file mode 100644
index 000000000..7a8ef9c7c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_equivalence_4.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! This checks the fix for PR37706 in which the equivalence would be
+! inserted into the 'nudata' namespace with the inevitable consequences.
+!
+! Contributed by Lester Petrie <petrielmjr@ornl.gov>
+!
+module data_C 
+    integer, dimension(200) :: l  = (/(201-i, i = 1,200)/)
+    integer :: l0
+    integer :: l24, l27, l28, l29
+    equivalence ( l(1), l0 )
+  end module data_C 
+
+subroutine nudata(nlibe, a, l) 
+  USE data_C, only:  l24, l27, l28, l29
+  implicit none
+  integer  :: nlibe 
+  integer  :: l(*) 
+  real :: a(*)
+  print *, l(1), l(2)
+  return  
+end subroutine nudata
+      
+  integer  :: l_(2) = (/1,2/), nlibe_ = 42
+  real :: a_(2) = (/1.,2./)  
+  call nudata (nlibe_, a_, l_)
+end
+
+! { dg-final { cleanup-modules "data_C" } }
diff --git a/gcc/testsuite/gfortran.dg/module_equivalence_5.f90 b/gcc/testsuite/gfortran.dg/module_equivalence_5.f90
new file mode 100644
index 000000000..de1d5043d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_equivalence_5.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+!
+! Fixes PR37787 where the EQUIVALENCE between QLA1 and QLA2 wasn't recognized
+! in the dependency checking because the compiler was looking in the wrong name
+! space.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+module stuff
+  integer, parameter :: r4_kv = 4
+contains
+
+  SUBROUTINE CF0004
+!  COPYRIGHT 1999   SPACKMAN & HENDRICKSON, INC.
+    REAL(R4_KV), dimension (10) :: QLA1, QLA2, QLA3, &
+                                   QCA = (/(i, i= 1, 10)/)
+    EQUIVALENCE (QLA1, QLA2)
+    QLA1 = QCA
+    QLA3 = QCA
+    QLA3( 2:10:3) = QCA ( 1:5:2) + 1
+    QLA1( 2:10:3) = QLA2( 1:5:2) + 1  !failed because of dependency
+    if (any (qla1 .ne. qla3)) call abort
+  END SUBROUTINE
+end module
+
+program try_cf004
+  use stuff
+  nf1 = 1
+  nf2 = 2
+  call cf0004
+end
+
+! { dg-final { cleanup-modules "stuff" } }
+
diff --git a/gcc/testsuite/gfortran.dg/module_equivalence_6.f90 b/gcc/testsuite/gfortran.dg/module_equivalence_6.f90
new file mode 100644
index 000000000..c33a2caa3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_equivalence_6.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+!
+! Fixes PR38171 a regression caused by the fix for PR37706.
+!
+! Contributed by Scot Breitenfeld <brtnfld@hdfgroup.org>
+!
+MODULE H5GLOBAL
+  IMPLICIT NONE
+  INTEGER :: H5P_flags
+  INTEGER :: H5P_DEFAULT_F
+  EQUIVALENCE(H5P_flags, H5P_DEFAULT_F)
+END MODULE H5GLOBAL
+MODULE HDF5
+  USE H5GLOBAL
+END MODULE HDF5
+PROGRAM fortranlibtest
+  USE HDF5
+  IMPLICIT NONE
+  INTEGER :: ii
+  ii = H5P_DEFAULT_F 
+END PROGRAM fortranlibtest
+! { dg-final { cleanup-modules "H5GLOBAL HDF5" } }
diff --git a/gcc/testsuite/gfortran.dg/module_error_1.f90 b/gcc/testsuite/gfortran.dg/module_error_1.f90
new file mode 100644
index 000000000..84decc0a5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_error_1.f90
@@ -0,0 +1,5 @@
+! { dg-do compile }
+! PR fortran/50627
+module kernels
+      select type (args) ! { dg-error "Unexpected SELECT TYPE" }
+end module kernels
diff --git a/gcc/testsuite/gfortran.dg/module_function_type_1.f90 b/gcc/testsuite/gfortran.dg/module_function_type_1.f90
new file mode 100644
index 000000000..b0a40488c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_function_type_1.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! This checks the fix for PR33295 in which the A_type in initA was
+! not promoted to module level and so not recognised as being the
+! same as that emanating directly from module a. 
+!
+! Contributed by Janus Weil <jaydub66@gmail.com>
+!
+module A
+  type A_type
+    real comp
+  end type
+end module A
+
+module B
+contains
+  function initA()
+    use A
+    implicit none
+    type(A_type):: initA
+    initA%comp=1.0
+  end function
+end module B
+
+program C
+  use B
+  use A
+  implicit none
+  type(A_type):: A_var
+  A_var = initA()
+end program C
+
+! { dg-final { cleanup-modules "A B" } }
+
diff --git a/gcc/testsuite/gfortran.dg/module_implicit_conversion.f90 b/gcc/testsuite/gfortran.dg/module_implicit_conversion.f90
new file mode 100644
index 000000000..d7835a7f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_implicit_conversion.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-std=gnu" }
+
+module module_implicit_conversion
+  ! double complex :: s = (1.0D0, 0D0) 
+  double complex :: s = (1.0, 0D0)
+end module module_implicit_conversion
+
+! { dg-final { cleanup-modules "module_implicit_conversion" } }
diff --git a/gcc/testsuite/gfortran.dg/module_interface_1.f90 b/gcc/testsuite/gfortran.dg/module_interface_1.f90
new file mode 100644
index 000000000..54ea14bca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_interface_1.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! This tests the fix for PR16940, module interfaces to
+! contained functions caused ICEs.
+! This is a simplified version of the example in the PR
+! discussion, which was due to L.Meissner.
+!
+! Submitted by Paul Thomas  pault@gcc.gnu.org
+!
+  module Max_Loc_Mod
+    implicit none
+    interface Max_Location
+      module procedure I_Max_Loc
+    end interface
+  contains
+    function I_Max_Loc (Vector) result(Ans)
+      integer, intent (in), dimension(:) :: Vector
+      integer, dimension(1) :: Ans
+      Ans = maxloc(Vector)
+      return
+    end function I_Max_Loc
+  end module Max_Loc_Mod
+  program module_interface
+    use Max_Loc_Mod
+    implicit none
+    integer :: Vector (7)
+    Vector = (/1,6,3,5,19,1,2/)
+    call Selection_Sort (Vector)
+  contains
+    subroutine Selection_Sort (Unsorted)
+      integer, intent (in), dimension(:) :: Unsorted
+      integer, dimension (1) :: N
+      N = Max_Location (Unsorted)
+      if (N(1).ne.5) call abort ()
+      return
+    end subroutine Selection_Sort
+  end program module_interface
+
+! { dg-final { cleanup-modules "max_loc_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/module_interface_2.f90 b/gcc/testsuite/gfortran.dg/module_interface_2.f90
new file mode 100644
index 000000000..1f9fde81e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_interface_2.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! Tests the fix for PR29464, in which the second USE of the generic
+! interface caused an error.
+!
+! Contributed by Vivek Rao <vivekrao4@yahoo.com>
+!
+module foo_mod
+  implicit none
+  interface twice
+     module procedure twice_real
+  end interface twice
+contains
+  real function twice_real(x)
+    real :: x
+    twice_real = 2*x
+  end function twice_real
+end module foo_mod
+
+  subroutine foobar ()
+    use foo_mod, only: twice, twice
+    print *, twice (99.0)
+  end subroutine foobar
+
+  program xfoo
+  use foo_mod, only: two => twice, dbl => twice
+  implicit none
+  call foobar ()
+  print *, two (2.3)
+  print *, dbl (2.3)
+end program xfoo
+! { dg-final { cleanup-modules "foo_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/module_md5_1.f90 b/gcc/testsuite/gfortran.dg/module_md5_1.f90
new file mode 100644
index 000000000..e725b4b76
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_md5_1.f90
@@ -0,0 +1,14 @@
+! Check that we can write a module file, that it has a correct MD5 sum,
+! and that we can read it back.
+!
+! { dg-do compile }
+module foo
+  integer(kind=4), parameter :: pi = 3_4
+end module foo
+
+program test
+  use foo
+  print *, pi
+end program test
+! { dg-final { scan-module "foo" "MD5:5632bcd379cf023bf7e663e91d52fa12" } }
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/module_naming_1.f90 b/gcc/testsuite/gfortran.dg/module_naming_1.f90
new file mode 100644
index 000000000..7b9df0a99
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_naming_1.f90
@@ -0,0 +1,32 @@
+! { dg-do assemble }
+! PR 31144
+! Makes sure that our name mangling scheme can't be outwitted
+
+! old scheme
+module m1
+contains
+  subroutine m2__m3()
+  end subroutine m2__m3
+end module m1
+
+module m1__m2
+contains
+  subroutine m3()
+  end subroutine m3
+end module m1__m2
+
+! New scheme, relies on capitalization
+module m2
+contains
+  subroutine m2_MOD_m3()
+    ! mangled to __m2_MOD_m2_mod_m3
+  end subroutine m2_MOD_m3
+end module m2
+
+module m2_MOD_m2
+contains
+  subroutine m3()
+    ! mangled to __m2_mod_m2_MOD_m3
+  end subroutine m3
+end module m2_MOD_m2
+! { dg-final { cleanup-modules "m1 m1__m2 m2 m2_MOD_m2" } }
diff --git a/gcc/testsuite/gfortran.dg/module_nan.f90 b/gcc/testsuite/gfortran.dg/module_nan.f90
new file mode 100644
index 000000000..202781f07
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_nan.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! { dg-options "-fno-range-check" }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+!
+! PR fortran/34318
+!
+! Infinity and NaN were not properly written to the .mod file.
+!
+module nonordinal
+  implicit none
+  real, parameter :: inf = 1./0., nan = 0./0., minf = -1./0.0
+end module nonordinal
+
+program a
+  use nonordinal
+  implicit none
+  character(len=20) :: str
+  if (log(abs(inf))  < huge(inf)) call abort()
+  if (log(abs(minf)) < huge(inf)) call abort()
+  if (.not. isnan(nan)) call abort()
+  write(str,"(sp,f10.2)") inf
+  if (adjustl(str) /= "+Infinity") call abort()
+  write(str,*) minf
+  if (adjustl(str) /= "-Infinity") call abort()
+  write(str,*) nan
+  if (adjustl(str) /= "NaN") call abort()
+end program a
+
+! { dg-final { cleanup-modules "nonordinal" } }
diff --git a/gcc/testsuite/gfortran.dg/module_parameter_array_refs_1.f90 b/gcc/testsuite/gfortran.dg/module_parameter_array_refs_1.f90
new file mode 100644
index 000000000..592e2f3dd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_parameter_array_refs_1.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! Tests the fix for 26074, in which the array reference below would
+! be determined not to be constant within modules.
+!
+! Contributed by Jonathan Dursi  <ljdursi@cita.utoronto.ca>
+!
+module foo
+
+   integer, parameter :: len = 5
+   integer :: arr(max(len,1))
+
+end
+
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/module_private_1.f90 b/gcc/testsuite/gfortran.dg/module_private_1.f90
new file mode 100644
index 000000000..7d854a1a9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_private_1.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-fmodule-private" }
+module bar
+  implicit none
+  public :: i
+  integer :: i
+end module bar
+
+module foo
+  implicit none
+  integer :: j
+end module foo
+
+program main
+  use bar, only : i
+  use foo, only : j ! { dg-error "not found in module" }
+  i = 1
+  j = 1
+  print *, i, j
+end program main
+
+! { dg-final { cleanup-modules "bar foo" } }
diff --git a/gcc/testsuite/gfortran.dg/module_private_array_refs_1.f90 b/gcc/testsuite/gfortran.dg/module_private_array_refs_1.f90
new file mode 100644
index 000000000..e2591ab4b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_private_array_refs_1.f90
@@ -0,0 +1,52 @@
+! { dg-do compile }
+! This tests the fix for PR28735 in which an ICE would be triggered in resolve_ref
+! because the references to 'a' and 'b' in the dummy arguments of mysub have
+! no symtrees in module bar, being private there.
+!
+! Contributed by  Andrew Sampson  <adsspamtrap01@yahoo.com>
+!
+!-- foo.F -----------------------------------------------
+module foo
+  implicit none
+  public
+  integer, allocatable :: a(:), b(:)
+end module foo
+
+!-- bar.F ---------------------------------------------
+module bar
+  use foo
+  implicit none
+  private                !  This triggered the ICE
+  public :: mysub        !  since a and b are not public
+
+contains
+
+  subroutine mysub(n, parray1)
+    integer, intent(in) :: n
+    real, dimension(a(n):b(n)) :: parray1
+    if ((n == 1) .and. size(parray1, 1) /= 10) call abort ()
+    if ((n == 2) .and. size(parray1, 1) /= 42) call abort ()
+  end subroutine mysub
+end module bar
+
+!-- sub.F -------------------------------------------------------
+subroutine sub()
+
+  use foo
+  use bar
+  real :: z(100)
+  allocate (a(2), b(2))
+  a = (/1, 6/)
+  b = (/10, 47/)
+  call mysub (1, z)
+  call mysub (2, z)
+
+  return
+end
+
+!-- MAIN ------------------------------------------------------
+  use bar
+  call sub ()
+end
+
+! { dg-final { cleanup-modules "foo bar" } }
diff --git a/gcc/testsuite/gfortran.dg/module_proc_external_dummy.f90 b/gcc/testsuite/gfortran.dg/module_proc_external_dummy.f90
new file mode 100644
index 000000000..86c66c2fa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_proc_external_dummy.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! This tests the fix for PR24866 in which the reference to the external str, in
+! sub_module, would get mixed up with the module procedure, str, thus
+! causing an ICE.  This is a completed version of the reporter's testcase; ie
+! it adds a main program and working subroutines to allow a check for
+! correct functioning.
+!
+! Contributed by Uttam Pawar  <uttamp@us.ibm.com>
+!
+   subroutine sub()
+     print *, "external sub"
+   end subroutine sub
+
+module test_module
+ contains
+   subroutine sub_module(str)
+     external :: str
+     call str ()
+   end subroutine sub_module
+   subroutine str()
+     print *, "module str"
+   end subroutine str
+end module test_module
+
+   use test_module
+   external sub
+   call sub_module (sub)
+   call sub_module (str)
+end
+! { dg-final { cleanup-modules "test_module" } }
diff --git a/gcc/testsuite/gfortran.dg/module_procedure_1.f90 b/gcc/testsuite/gfortran.dg/module_procedure_1.f90
new file mode 100644
index 000000000..5e1fa15c7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_procedure_1.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+! Modified program from http://groups.google.com/group/\
+! comp.lang.fortran/browse_frm/thread/423e4392dc965ab7#
+!
+module myoperator
+   contains
+      function dadd(arg1,arg2)
+         integer ::dadd(2)
+         integer, intent(in) :: arg1(2), arg2(2)
+         dadd(1)=arg1(1)+arg2(1)
+         dadd(2)=arg1(2)+arg2(2)
+      end function dadd
+end module myoperator
+
+program test_interface
+
+   use myoperator
+
+   implicit none
+
+   interface operator (.myadd.)
+      module procedure dadd
+   end interface
+
+   integer input1(2), input2(2), mysum(2)
+
+   input1 = (/0,1/)
+   input2 = (/3,3/)
+   mysum = input1 .myadd. input2
+   if (mysum(1) /= 3 .and. mysum(2) /= 4) call abort 
+
+   call test_sub(input1, input2)
+
+end program test_interface 
+
+subroutine test_sub(input1, input2)
+
+   use myoperator
+
+   implicit none
+
+   interface operator (.myadd.)
+      module procedure dadd
+   end interface
+
+   integer, intent(in) :: input1(2), input2(2)
+   integer mysum(2)
+
+   mysum = input1 .myadd. input2
+   if (mysum(1) /= 3 .and. mysum(2) /= 4) call abort 
+
+end subroutine test_sub 
+! { dg-final { cleanup-modules "myoperator" } }
diff --git a/gcc/testsuite/gfortran.dg/module_procedure_2.f90 b/gcc/testsuite/gfortran.dg/module_procedure_2.f90
new file mode 100644
index 000000000..8f6db25fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_procedure_2.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+program test
+   implicit none
+   intrinsic sin
+   interface gen2
+      module procedure sin  ! { dg-error "cannot be a MODULE PROCEDURE" }
+   end interface gen2
+end program test
diff --git a/gcc/testsuite/gfortran.dg/module_procedure_double_colon_1.f90 b/gcc/testsuite/gfortran.dg/module_procedure_double_colon_1.f90
new file mode 100644
index 000000000..200f0ff26
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_procedure_double_colon_1.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+! PR fortran/49265
+! Contributed by Erik Toussaint
+!
+module m1
+   implicit none
+   interface foo
+      module procedure::bar
+      module procedure ::bar_none
+      module procedure:: none_bar
+   end interface
+contains
+   subroutine bar
+   end subroutine
+   subroutine bar_none(i)
+     integer i
+   end subroutine
+   subroutine none_bar(x)
+     real x
+   end subroutine
+end module
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/module_procedure_double_colon_2.f90 b/gcc/testsuite/gfortran.dg/module_procedure_double_colon_2.f90
new file mode 100644
index 000000000..9300215e7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_procedure_double_colon_2.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/49265
+! Contributed by Erik Toussaint
+!
+module m1
+   implicit none
+   interface foo
+      module procedure::bar       ! { dg-error "double colon" }
+      module procedure ::bar_none ! { dg-error "double colon" }
+      module procedure:: none_bar ! { dg-error "double colon" }
+   end interface
+contains
+   subroutine bar
+   end subroutine
+   subroutine bar_none(i)
+     integer i
+   end subroutine
+   subroutine none_bar(x)
+     real x
+   end subroutine
+end module
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/module_read_1.f90 b/gcc/testsuite/gfortran.dg/module_read_1.f90
new file mode 100644
index 000000000..226c7366c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_read_1.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! { dg-options "-Wreturn-type" }
+! PR fortran/33941
+! The problem was that the intrinsic operators
+! were written to the module file as '/=' etc.
+! but this format was not understood on reading.
+!
+! Test case by Toby White, stripped down by
+! Dominique d'Humieres and Francois-Xavier Coudert
+
+module foo
+contains
+  function pop(n) result(item)          ! { dg-warning "not set" }
+    integer :: n
+    character(len=merge(1, 0, n > 0)) :: item
+  end function pop
+  function push(n) result(item)         ! { dg-warning "not set" }
+    integer :: n
+    character(len=merge(1, 0, n /= 0)) :: item
+  end function push
+end module foo
+
+program test
+  use foo
+  if(len(pop(0)) /= 0) call abort()
+  if(len(pop(1)) /= 1) call abort()
+  if(len(push(0)) /= 0) call abort()
+  if(len(push(1)) /= 1) call abort()
+end program
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/module_read_2.f90 b/gcc/testsuite/gfortran.dg/module_read_2.f90
new file mode 100644
index 000000000..d001ca758
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_read_2.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+!
+! PR fortran/43199
+!
+! This program gave an ICE due to reading the REF_COMPONENT with CLASS.
+!
+module m_string
+  type t_string
+      character, dimension(:), allocatable :: string
+  end type t_string
+contains
+pure function string_to_char ( s ) result(res)
+  class(t_string), intent(in) :: s
+  character(len=size(s%string)) :: res
+  integer :: i
+  do i = 1,len(res)
+    res(i:i) = s%string(i)
+  end do
+end function string_to_char
+end module m_string
+
+use m_string
+type(t_string) :: str
+allocate(str%string(5))
+str%string = ['H','e','l','l','o']
+if (len (string_to_char (str)) /= 5) call abort ()
+if (string_to_char (str) /= "Hello") call abort ()
+end
+
+! { dg-final { cleanup-modules "m_string" } }
diff --git a/gcc/testsuite/gfortran.dg/module_widestring_1.f90 b/gcc/testsuite/gfortran.dg/module_widestring_1.f90
new file mode 100644
index 000000000..f2e9fe235
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_widestring_1.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+!
+! Testcase from PR36162
+module m
+  character(*), parameter ::  a ='H\0z'
+end module m
+
+  use m
+  character(len=20) :: s
+  if (a /= 'H\0z') call abort
+  if (ichar(a(2:2)) /= 0) call abort
+  write (s,"(A)") a
+end
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/module_write_1.f90 b/gcc/testsuite/gfortran.dg/module_write_1.f90
new file mode 100644
index 000000000..3b488ce55
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_write_1.f90
@@ -0,0 +1,59 @@
+! { dg-do compile }
+!
+! PR fortran/41869
+!
+! Was ICEing while module write of symbol 'vs_str' in m_dom_dom
+! because of "len" being private in fox_m_fsys_format.
+!
+module fox_m_fsys_array_str
+contains
+  pure function str_vs(vs) result(s)
+    character, dimension(:), intent(in) :: vs
+    character(len=size(vs)) :: s
+    s = transfer(vs, s)
+  end function str_vs
+  pure function vs_str(s) result(vs)
+    character(len=*), intent(in) :: s
+    character, dimension(len(s)) :: vs
+    vs = transfer(s, vs)
+  end function vs_str
+end module fox_m_fsys_array_str
+
+module fox_m_fsys_format
+  private
+  interface str
+    module procedure  str_logical_array
+  end interface str
+  interface len
+    module procedure str_logical_array_len
+  end interface
+  public :: str
+contains
+  pure function str_logical_array_len(la) result(n)
+    logical, dimension(:), intent(in)   :: la
+  end function str_logical_array_len
+  pure function str_logical_array(la) result(s)
+    logical, dimension(:), intent(in)   :: la
+    character(len=len(la)) :: s
+  end function str_logical_array
+  pure function checkFmt(fmt) result(good)
+    character(len=*), intent(in) :: fmt
+    logical :: good
+    good = len(fmt) > 0
+  end function checkFmt
+end module fox_m_fsys_format
+
+module m_dom_dom
+  use fox_m_fsys_array_str, only: str_vs, vs_str
+end module m_dom_dom
+
+module FoX_dom
+  use fox_m_fsys_format
+  use m_dom_dom
+end module FoX_dom
+
+use FoX_dom
+implicit none
+print *, vs_str("ABC")
+end
+! { dg-final { cleanup-modules "fox_m_fsys_array_str fox_m_fsys_format m_dom_dom fox_dom" } }
diff --git a/gcc/testsuite/gfortran.dg/modulo_1.f90 b/gcc/testsuite/gfortran.dg/modulo_1.f90
new file mode 100644
index 000000000..52c3b0966
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/modulo_1.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR fortran/23912
+  integer(kind=4) i4
+  integer(kind=8) i8
+
+  i4 = modulo(i4,i8) ! { dg-warning "Extension" }
+  i4 = modulo(i8,i4) ! { dg-warning "Extension" }
+
+  end
diff --git a/gcc/testsuite/gfortran.dg/move_alloc.f90 b/gcc/testsuite/gfortran.dg/move_alloc.f90
new file mode 100644
index 000000000..2d8217750
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/move_alloc.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! Test the move_alloc intrinsic.
+!
+! Contributed by Erik Edelmann  <eedelmann@gcc.gnu.org>
+!            and Paul Thomas  <pault@gcc.gnu.org>
+!
+program test_move_alloc
+
+    implicit none
+    integer, allocatable :: x(:), y(:), temp(:)
+    character(4), allocatable :: a(:), b(:)
+    integer :: i
+
+    allocate (x(2))
+    allocate (a(2))
+
+    x = [ 42, 77 ]
+
+    call move_alloc (x, y)
+    if (allocated(x)) call abort()
+    if (.not.allocated(y)) call abort()
+    if (any(y /= [ 42, 77 ])) call abort()
+
+    a = [ "abcd", "efgh" ]
+    call move_alloc (a, b)
+    if (allocated(a)) call abort()
+    if (.not.allocated(b)) call abort()
+    if (any(b /= [ "abcd", "efgh" ])) call abort()
+
+    ! Now one of the intended applications of move_alloc; resizing
+
+    call move_alloc (y, temp)
+    allocate (y(6), stat=i)
+    if (i /= 0) call abort()
+    y(1:2) = temp
+    y(3:) = 99
+    deallocate(temp)
+    if (any(y /= [ 42, 77, 99, 99, 99, 99 ])) call abort()
+end program test_move_alloc
diff --git a/gcc/testsuite/gfortran.dg/move_alloc_12.f90 b/gcc/testsuite/gfortran.dg/move_alloc_12.f90
new file mode 100644
index 000000000..880b302d5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/move_alloc_12.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+!
+! PR fortran/51948
+!
+  type :: t
+  end type t
+contains
+  function func(x, y)
+    class(t) :: y
+    type(t), allocatable :: func
+    type(t), allocatable :: x
+
+    select type (y)
+      type is(t)
+        call move_alloc (x, func)
+    end select
+  end function
+
+  function func2(x, y)
+    class(t) :: y
+    class(t), allocatable :: func2
+    class(t), allocatable :: x
+
+    block
+    block
+    select type (y)
+      type is(t)
+        call move_alloc (x, func2)
+    end select
+    end block
+    end block
+  end function
+end
diff --git a/gcc/testsuite/gfortran.dg/move_alloc_2.f90 b/gcc/testsuite/gfortran.dg/move_alloc_2.f90
new file mode 100644
index 000000000..5dabca849
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/move_alloc_2.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+!
+! PR 45004: [OOP] Segfault with allocatable scalars and move_alloc
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+program bug18
+
+  type foo
+    integer :: i
+  end type foo
+
+  type bar
+    class(foo), allocatable :: bf
+  end type bar
+
+  class(foo), allocatable :: afab
+  type(bar) :: bb
+
+  allocate(foo :: afab)
+  afab%i = 8
+  call move_alloc(afab, bb%bf)
+  if (.not. allocated(bb%bf)) call abort()
+  if (allocated(afab)) call abort()
+  if (bb%bf%i/=8) call abort()
+
+end program bug18
diff --git a/gcc/testsuite/gfortran.dg/move_alloc_3.f90 b/gcc/testsuite/gfortran.dg/move_alloc_3.f90
new file mode 100644
index 000000000..3855eede9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/move_alloc_3.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+!
+! PR 44595: INTENT of arguments to intrinsic procedures not checked
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+ 
+subroutine test(f)
+  implicit none
+  integer, allocatable, intent(in) :: f
+  integer, allocatable :: t
+  call move_alloc(f,t)        ! { dg-error "cannot be INTENT.IN." }
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/move_alloc_5.f90 b/gcc/testsuite/gfortran.dg/move_alloc_5.f90
new file mode 100644
index 000000000..b2759de2c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/move_alloc_5.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+!
+! PR 48699: [4.6/4.7 Regression] [OOP] MOVE_ALLOC inside SELECT TYPE
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+program testmv1
+
+  type bar
+  end type
+
+  type, extends(bar) ::  bar2
+  end type
+
+  class(bar), allocatable :: sm
+  type(bar2), allocatable :: sm2
+
+  allocate (sm2)
+  call move_alloc (sm2,sm)
+
+  if (allocated(sm2)) call abort()
+  if (.not. allocated(sm)) call abort()
+
+end program 
diff --git a/gcc/testsuite/gfortran.dg/move_alloc_8.f90 b/gcc/testsuite/gfortran.dg/move_alloc_8.f90
new file mode 100644
index 000000000..2fa530666
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/move_alloc_8.f90
@@ -0,0 +1,106 @@
+! { dg-do compile }
+!
+! PR fortran/50684
+!
+! Module "bug" contributed by Martin Steghöfer.
+!
+
+MODULE BUG
+  TYPE MY_TYPE
+    INTEGER, ALLOCATABLE :: VALUE
+  END TYPE
+CONTAINS
+  SUBROUTINE POINTER_INTENT_IN_BUG_WORKING(POINTER_INTENT_IN_VARIABLE)
+    TYPE(MY_TYPE), POINTER, INTENT(IN) :: POINTER_INTENT_IN_VARIABLE
+    TYPE(MY_TYPE), POINTER :: POINTER_VARIABLE_LOCAL
+    INTEGER, ALLOCATABLE :: LOCAL_VALUE
+    
+    POINTER_VARIABLE_LOCAL=>POINTER_INTENT_IN_VARIABLE
+    CALL MOVE_ALLOC(POINTER_VARIABLE_LOCAL%VALUE, LOCAL_VALUE)
+    
+    RETURN
+  END SUBROUTINE POINTER_INTENT_IN_BUG_WORKING
+  
+  SUBROUTINE POINTER_INTENT_IN_BUG_FAILING(POINTER_INTENT_IN_VARIABLE)
+    TYPE(MY_TYPE), POINTER, INTENT(IN) :: POINTER_INTENT_IN_VARIABLE
+    INTEGER, ALLOCATABLE :: LOCAL_VALUE
+    
+    CALL MOVE_ALLOC(POINTER_INTENT_IN_VARIABLE%VALUE, LOCAL_VALUE)
+    
+    RETURN
+  END SUBROUTINE POINTER_INTENT_IN_BUG_FAILING
+end module bug
+
+subroutine test1()
+  TYPE MY_TYPE
+    INTEGER, ALLOCATABLE :: VALUE
+  END TYPE
+CONTAINS
+  SUBROUTINE sub (dt)
+    type(MY_TYPE), intent(in) :: dt
+    INTEGER, ALLOCATABLE :: lv
+    call move_alloc(dt%VALUE, lv) ! { dg-error "cannot be INTENT.IN." }
+  END SUBROUTINE
+end subroutine test1
+
+subroutine test2 (x, px)
+  implicit none
+  type t
+    integer, allocatable :: a
+  end type t
+
+  type t2
+    type(t), pointer :: ptr
+    integer, allocatable :: a
+  end type t2
+
+  type(t2), intent(in) :: x
+  type(t2), pointer, intent(in) :: px
+
+  integer, allocatable :: a
+  type(t2), pointer :: ta
+
+  call move_alloc (px, ta)      ! { dg-error "cannot be INTENT.IN." }
+  call move_alloc (x%a, a)      ! { dg-error "cannot be INTENT.IN." }
+  call move_alloc (x%ptr%a, a)  ! OK (3)
+  call move_alloc (px%a, a)     ! OK (4)
+  call move_alloc (px%ptr%a, a) ! OK (5)
+end subroutine test2
+
+subroutine test3 (x, px)
+  implicit none
+  type t
+    integer, allocatable :: a
+  end type t
+
+  type t2
+    class(t), pointer :: ptr
+    integer, allocatable :: a
+  end type t2
+
+  type(t2), intent(in) :: x
+  class(t2), pointer, intent(in) :: px
+
+  integer, allocatable :: a
+  class(t2), pointer :: ta
+
+  call move_alloc (px, ta)      ! { dg-error "cannot be INTENT.IN." }
+  call move_alloc (x%a, a)      ! { dg-error "cannot be INTENT.IN." }
+  call move_alloc (x%ptr%a, a)  ! OK (6)
+  call move_alloc (px%a, a)     ! OK (7)
+  call move_alloc (px%ptr%a, a) ! OK (8)
+end subroutine test3
+
+subroutine test4()
+  TYPE MY_TYPE
+    INTEGER, ALLOCATABLE :: VALUE
+  END TYPE
+CONTAINS
+  SUBROUTINE sub (dt)
+    CLASS(MY_TYPE), intent(in) :: dt
+    INTEGER, ALLOCATABLE :: lv
+    call move_alloc(dt%VALUE, lv) ! { dg-error "cannot be INTENT.IN." }
+  END SUBROUTINE
+end subroutine test4
+
+! { dg-final { cleanup-modules "bug" } }
diff --git a/gcc/testsuite/gfortran.dg/multiple_allocation_1.f90 b/gcc/testsuite/gfortran.dg/multiple_allocation_1.f90
new file mode 100644
index 000000000..2b913734e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/multiple_allocation_1.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! PR 25031 - We didn't cause an error when allocating an already
+!            allocated array.
+program alloc_test
+  implicit none
+  integer :: i
+  integer, allocatable :: a(:)
+  integer, pointer :: b(:)
+
+  allocate(a(4))
+  ! This should set the stat code and change the size.
+  allocate(a(3),stat=i)
+  if (i == 0) call abort
+  if (.not. allocated(a)) call abort
+  if (size(a) /= 3) call abort
+  ! It's OK to allocate pointers twice (even though this causes
+  ! a memory leak)
+  allocate(b(4))
+  allocate(b(4))
+end program
diff --git a/gcc/testsuite/gfortran.dg/multiple_allocation_2.f90 b/gcc/testsuite/gfortran.dg/multiple_allocation_2.f90
new file mode 100644
index 000000000..617405be1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/multiple_allocation_2.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! PR 27470: This used fail because of confusion between
+!           mol (allocatable) and mol(1)%array(:) (pointer).
+!           Derived from a test case by FX Coudert.
+PROGRAM MAIN
+  TYPE foo
+    INTEGER, DIMENSION(:), POINTER :: array
+  END TYPE foo
+
+  type(foo),allocatable,dimension(:) :: mol
+
+  ALLOCATE (mol(1))
+  ALLOCATE (mol(1)%array(5))
+  ALLOCATE (mol(1)%array(5))
+
+  END
diff --git a/gcc/testsuite/gfortran.dg/mvbits_1.f90 b/gcc/testsuite/gfortran.dg/mvbits_1.f90
new file mode 100644
index 000000000..90e92bb0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mvbits_1.f90
@@ -0,0 +1,39 @@
+! PR 25577
+! MVBITS didn't work correctly for integer types wider than a C int
+! The testcase is based on the one Dale Ranta posted in the bug report
+implicit none
+integer(1) i1,j1
+integer(2) i2,j2
+integer(4) i4,j4
+integer(8) i8,j8
+integer ibits,n
+
+ibits=bit_size(1_1)
+do n=1,ibits
+   i1=-1
+   call mvbits(1_1, 0,n,i1,0)
+   j1=-1-2_1**n+2
+   if(i1.ne.j1)call abort
+enddo
+ibits=bit_size(1_2)
+do n=1,ibits
+   i2=-1
+   call mvbits(1_2, 0,n,i2,0)
+   j2=-1-2_2**n+2
+   if(i2.ne.j2)call abort
+enddo
+ibits=bit_size(1_4)
+do n=1,ibits
+   i4=-1
+   call mvbits(1_4, 0,n,i4,0)
+   j4=-1-2_4**n+2
+   if(i4.ne.j4)call abort
+enddo
+ibits=bit_size(1_8)
+do n=1,ibits
+   i8=-1
+   call mvbits(1_8, 0,n,i8,0)
+   j8=-1-2_8**n+2
+   if(i8.ne.j8)call abort
+enddo
+end
diff --git a/gcc/testsuite/gfortran.dg/mvbits_2.f90 b/gcc/testsuite/gfortran.dg/mvbits_2.f90
new file mode 100644
index 000000000..885002ad6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mvbits_2.f90
@@ -0,0 +1,16 @@
+! Test for the MVBITS subroutine
+! This used to fail on big-endian architectures (PR 32357)
+! { dg-do run }
+  integer(kind=8) :: i8 = 0
+  integer(kind=4) :: i4 = 0
+  integer(kind=2) :: i2 = 0
+  integer(kind=1) :: i1 = 0
+  call mvbits (1_1, 0, 8, i1, 0)
+  if (i1 /= 1) call abort
+  call mvbits (1_2, 0, 16, i2, 0)
+  if (i2 /= 1) call abort
+  call mvbits (1_4, 0, 16, i4, 0)
+  if (i4 /= 1) call abort
+  call mvbits (1_8, 0, 16, i8, 0)
+  if (i8 /= 1) call abort
+  end
diff --git a/gcc/testsuite/gfortran.dg/mvbits_3.f90 b/gcc/testsuite/gfortran.dg/mvbits_3.f90
new file mode 100644
index 000000000..74f24e001
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mvbits_3.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+!
+! PR fortran/
+!
+! The trans-*.c part of the compiler did no know
+! that mvbits is an elemental function.
+!
+! Test case contributed by P.H. Lundow.
+!
+program main
+  implicit none
+  integer :: a( 2 ), b( 2 )
+  integer :: x, y
+
+  a = 1
+  b = 0
+  x = 1
+  y = 0
+
+  call mvbits (a, 0, 1, b, 1)
+  call mvbits (x, 0, 1, y, 1)
+
+!  write (*, *) 'a: ', a
+!  write (*, *) 'x: ', x
+!  write (*, *)
+!  write (*, *) 'b: ', b
+!  write (*, *) 'y: ', y
+!  write (*, *)
+
+  if ( any (b /= y) ) call abort()
+end program main
diff --git a/gcc/testsuite/gfortran.dg/mvbits_4.f90 b/gcc/testsuite/gfortran.dg/mvbits_4.f90
new file mode 100644
index 000000000..b8d32140c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mvbits_4.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+
+! PR fortran/35681
+! Check that dependencies of MVBITS arguments are resolved correctly by using
+! temporaries if both arguments refer to the same variable.
+
+  integer, dimension(10) :: ila1 = (/1,2,3,4,5,6,7,8,9,10/)
+  integer, dimension(20) :: ila2
+  integer, dimension(10), target :: ila3
+  integer, pointer :: ila3_ptr(:)
+  integer, parameter :: SHOULD_BE(10) = (/17,18,11,4,13,22,7,16,9,18/)
+  integer, parameter :: INDEX_VECTOR(10) = (/9,9,6,2,4,9,2,9,6,10/)
+
+  ila2(2:20:2) = ila1
+  ila3 = ila1
+
+  ! Argument is already packed.
+  call mvbits (ila1(INDEX_VECTOR), 2, 4, ila1, 3)
+  write (*,'(10(I3))') ila1
+  if (any (ila1 /= SHOULD_BE)) call abort ()
+
+  ! Argument is not packed.
+  call mvbits (ila2(2*INDEX_VECTOR), 2, 4, ila2(2:20:2), 3)
+  write (*,'(10(I3))') ila2(2:20:2)
+  if (any (ila2(2:20:2) /= SHOULD_BE)) call abort ()
+
+  ! Pointer and target
+  ila3_ptr => ila3
+  call mvbits (ila3(INDEX_VECTOR), 2, 4, ila3_ptr, 3)
+  write (*,'(10(I3))') ila3
+  if (any (ila3 /= SHOULD_BE)) call abort ()
+
+  end 
diff --git a/gcc/testsuite/gfortran.dg/mvbits_5.f90 b/gcc/testsuite/gfortran.dg/mvbits_5.f90
new file mode 100644
index 000000000..42d834668
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mvbits_5.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+
+! PR fortran/38887
+! This aborted at runtime for the runtime zero-sized array arguments.
+
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+
+program try_ya0013
+  integer ida(9)
+  call ya0013(ida,1,5,6)
+end program
+
+SUBROUTINE YA0013(IDA,nf1,nf5,nf6)
+  INTEGER IDA(9)
+  IDA = 1
+  CALL MVBITS(IDA(NF5:NF1), 0, 1, IDA(NF6:NF1),2)
+END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/mvbits_6.f90 b/gcc/testsuite/gfortran.dg/mvbits_6.f90
new file mode 100644
index 000000000..56ceacc5e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mvbits_6.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+
+! PR fortran/38883
+! This ICE'd because the temporary-creation in the MVBITS call was wrong.
+! This is the original test from the PR, the complicated version.
+
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+
+     module yg0009_stuff
+
+      type unseq
+         integer I
+      end type
+
+      contains
+
+      SUBROUTINE YG0009(TDA2L,NF4,NF3,NF1,MF1,MF4,MF3)
+        TYPE(UNSEQ) TDA2L(NF4,NF3)
+
+        CALL MVBITS (TDA2L(NF4:NF1:MF1,NF1:NF3)%I,2, &
+          4, TDA2L(-MF4:-MF1:-NF1,-MF1:-MF3)%I, 3)
+
+      END SUBROUTINE
+
+      end module yg0009_stuff
+
+      program try_yg0009
+      use yg0009_stuff
+      type(unseq)  tda2l(4,3)
+
+      call yg0009(tda2l,4,3,1,-1,-4,-3)
+
+      end
+! { dg-final { cleanup-modules "yg0009_stuff" } }
diff --git a/gcc/testsuite/gfortran.dg/mvbits_7.f90 b/gcc/testsuite/gfortran.dg/mvbits_7.f90
new file mode 100644
index 000000000..2c7cab8ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mvbits_7.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+
+! PR fortran/38883
+! This ICE'd because the temporary-creation in the MVBITS call was wrong.
+
+! Contributed by Paul Richard Thomas <paul.richard.thomas@gmail.com>
+
+  type t
+    integer  ::  I
+    character(9)  :: chr
+  end type
+  type(t) :: x(4,3)
+  type(t) :: y(4,3)
+  x = reshape ([((t (i*j, "a"),i = 1,4), j=1,3)], [4,3])
+  call foo (x)
+  y = reshape ([((t (i*j*2, "a"),i = 1,4), j=1,3)], [4,3])
+  call bar(y, 4, 3, 1, -1, -4, -3)
+  if (any (x%i .ne. y%i)) call abort
+contains
+  SUBROUTINE foo (x)
+    TYPE(t) x(4, 3)      ! No dependency at all
+    CALL MVBITS (x%i, 0, 6, x%i, 8)
+    x%i = x%i * 2
+  END SUBROUTINE
+  SUBROUTINE bar (x, NF4, NF3, NF1, MF1, MF4, MF3)
+    TYPE(t) x(NF4, NF3)  ! Dependency through variable indices
+    CALL MVBITS (x(NF4:NF1:MF1, NF1:NF3)%i, 1, &
+                 6, x(-MF4:-MF1:-NF1, -MF1:-MF3)%i, 9)
+  END SUBROUTINE
+end
diff --git a/gcc/testsuite/gfortran.dg/mvbits_8.f90 b/gcc/testsuite/gfortran.dg/mvbits_8.f90
new file mode 100644
index 000000000..f69d1e84f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mvbits_8.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+
+! PR fortran/38883
+! This ICE'd because the temporary-creation in the MVBITS call was wrong.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  TYPE inner
+    INTEGER :: i
+    INTEGER :: j
+  END TYPE inner
+
+  TYPE outer
+    TYPE(inner) :: comp(2)
+  END TYPE outer
+
+  TYPE(outer) :: var
+
+  var%comp%i = (/ 1, 2 /)
+  var%comp%j = (/ 3, 4 /)
+
+  CALL foobar (var, 1, 2)
+
+  IF (ANY (var%comp%i /= (/ 1, 2 /))) CALL abort ()
+  IF (ANY (var%comp%j /= (/ 3, 4 /))) CALL abort ()
+
+CONTAINS
+
+  SUBROUTINE foobar (x, lower, upper)
+    TYPE(outer), INTENT(INOUT) :: x
+    INTEGER, INTENT(IN) :: lower, upper
+    CALL MVBITS (x%comp%i, 1, 2, x%comp(lower:upper)%i, 1)
+  END SUBROUTINE foobar
+
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/mvbits_9.f90 b/gcc/testsuite/gfortran.dg/mvbits_9.f90
new file mode 100644
index 000000000..952286b09
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mvbits_9.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! PR fortran/44346
+! Original test sumbitted by Vittorio Zecca, zeccav at gmail dot com.
+! Modified by Steven G. Kargl for dejagnu testsuite.
+!
+program a
+   integer :: n = 42
+   ! 64 + 3 > bitsize(n) 
+   call mvbits(n, 64, 3, n, 1)   ! { dg-error "must be less than" }
+   ! 64 + 2 > bitsize(n)        
+   call mvbits(n, 30, 2, n, 64)  ! { dg-error "must be less than" }
+   ! LEN negative
+   call mvbits(n, 30, -2, n, 30) ! { dg-error "must be nonnegative" }
+   ! TOPOS negative
+   call mvbits(n, 30, 2, n, -3)  ! { dg-error "must be nonnegative" }
+   ! FROMPOS negative
+   call mvbits(n, -1, 2, n, 3)   ! { dg-error "must be nonnegative" }
+end program a
diff --git a/gcc/testsuite/gfortran.dg/named_interface.f90 b/gcc/testsuite/gfortran.dg/named_interface.f90
new file mode 100644
index 000000000..29cfae882
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/named_interface.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! PR 20363
+module snafu
+  interface foo
+    subroutine really_snafu (foo)        
+      integer, intent (inout)  :: foo
+    end subroutine really_snafu
+  end interface foo
+end module snafu
+
+! { dg-final { cleanup-modules "snafu" } }
diff --git a/gcc/testsuite/gfortran.dg/namelist_1.f90 b/gcc/testsuite/gfortran.dg/namelist_1.f90
new file mode 100644
index 000000000..e4154e918
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_1.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! Check that private entities in public namelists are rejected
+module namelist_1
+  public
+  integer,private :: x
+  namelist /n/ x ! { dg-error "cannot be member of PUBLIC namelist" "" }
+end module
+
+! { dg-final { cleanup-modules "namelist_1" } }
diff --git a/gcc/testsuite/gfortran.dg/namelist_11.f b/gcc/testsuite/gfortran.dg/namelist_11.f
new file mode 100644
index 000000000..672ee261c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_11.f
@@ -0,0 +1,55 @@
+c { dg-do run { target fd_truncate } }
+c This program tests: namelist comment, a blank line before the nameilist name, the namelist name,
+c a scalar qualifier, various combinations of space, comma and lf delimiters, f-formats, e-formats
+c a blank line within the data read, nulls, a range qualifier, a new object name before end of data
+c and an integer read.  It also tests that namelist output can be re-read by namelist input.
+c provided by Paul Thomas - pault@gcc.gnu.org
+
+      program namelist_1
+
+      REAL x(10)
+      REAL(kind=8) xx
+      integer ier
+      namelist /mynml/ x, xx
+
+      do i = 1 , 10
+        x(i) = -1
+      end do
+      x(6) = 6.0
+      x(10) = 10.0
+      xx = 0d0
+
+      open (10,status="scratch")
+      write (10, *) "!mynml"
+      write (10, *) ""
+      write (10, *) "&gf /"
+      write (10, *) "&mynml  x(7) =+99.0e0 x=1.0, 2.0 ,"
+      write (10, *) " 2*3.0, ,, 7.0e0,+0.08e+02 !comment"
+      write (10, *) ""
+      write (10, *) " 9000e-3 x(4:5)=4 ,5 "
+      write (10, *) " x=,,3.0, xx=10d0 /"
+      rewind (10)
+
+      read (10, nml=mynml, IOSTAT=ier)
+      if (ier.ne.0) call abort
+      rewind (10)
+
+      do i = 1 , 10
+        if ( abs( x(i) - real(i) ) .gt. 1e-8 ) call abort
+      end do
+      if ( abs( xx - 10d0 ) .gt. 1e-8 ) call abort
+
+      write (10, nml=mynml, iostat=ier)
+      if (ier.ne.0) call abort
+      rewind (10)
+
+      read (10, NML=mynml, IOSTAT=ier)
+      if (ier.ne.0) call abort
+      close (10)
+
+      do i = 1 , 10
+        if ( abs( x(i) - real(i) ) .gt. 1e-8 ) call abort
+      end do
+      if ( abs( xx - 10d0 ) .gt. 1e-8 ) call abort
+
+      end program
diff --git a/gcc/testsuite/gfortran.dg/namelist_12.f b/gcc/testsuite/gfortran.dg/namelist_12.f
new file mode 100644
index 000000000..1752bfa07
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_12.f
@@ -0,0 +1,57 @@
+c{ dg-do run { target fd_truncate } }
+c{ dg-options "-std=legacy" }
+c
+c This program repeats many of the same tests as test_nml_1 but for integer
+c instead of real. It also tests repeat nulls, comma delimited character read,
+c a triplet qualifier, a range with an assumed start, a quote delimited string,
+c a qualifier with an assumed end and a fully explicit range.  It also tests
+c that integers and characters are successfully read back by namelist.
+c Provided by Paul Thomas - pault@gcc.gnu.org
+
+      program namelist_12
+
+      integer x(10)
+      integer(kind=8) xx
+      integer ier
+      character*10 ch , check
+      namelist /mynml/ x, xx, ch
+ 
+c set debug = 0 or 1 in the namelist! (line 33)
+
+      do i = 1 , 10
+        x(i) = -1
+      end do
+      x(6) = 6
+      x(10) = 10
+      xx = 0
+      ch ="zzzzzzzzzz"
+      check="abcdefghij"
+
+      open (10,status="scratch", delim="apostrophe")
+      write (10, '(a)') "!mynml"
+      write (10, '(a)') " "
+      write (10, '(a)') "&mynml  x(7) =+99 x=1, 2 ,"
+      write (10, '(a)') " 2*3, ,, 2* !comment"
+      write (10, '(a)') " 9 ch='qqqdefghqq' , x(8:7:-1) = 8 , 7"
+      write (10, '(a)') " ch(:3) =""abc"","
+      write (10, '(a)') " ch(9:)='ij' x(4:5)=4 ,5 xx = 42/"
+      rewind (10)
+
+      read (10, nml=mynml, IOSTAT=ier)
+      if (ier.ne.0) call abort
+      rewind (10)
+
+      write (10, nml=mynml, iostat=ier)
+      if (ier.ne.0) call abort
+      rewind (10)
+
+      read (10, NML=mynml, IOSTAT=ier)
+      if (ier.ne.0) call abort
+      close (10)
+
+      do i = 1 , 10
+        if ( abs( x(i) - i ) .ne. 0 ) call abort ()
+        if ( ch(i:i).ne.check(I:I) ) call abort
+      end do
+      if (xx.ne.42) call abort ()
+      end program
diff --git a/gcc/testsuite/gfortran.dg/namelist_13.f90 b/gcc/testsuite/gfortran.dg/namelist_13.f90
new file mode 100644
index 000000000..185b522e7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_13.f90
@@ -0,0 +1,38 @@
+!{ dg-do run }
+! Tests simple derived types.
+! Provided by Paul Thomas - pault@gcc.gnu.org
+
+program namelist_13
+
+  type                        ::      yourtype
+    integer, dimension(2)     ::      yi = (/8,9/)
+    real, dimension(2)        ::      yx = (/80.,90./)
+    character(len=2)          ::      ych = "xx"
+  end type yourtype
+
+  type                        ::      mytype
+    integer, dimension(2)     ::      myi = (/800,900/)
+    real, dimension(2)        ::      myx = (/8000.,9000./)
+    character(len=2)          ::      mych = "zz"
+    type(yourtype)            ::      my_yourtype
+  end type mytype
+
+  type(mytype)                ::      z
+  integer                     ::      ier
+  integer                     ::      zeros(10)
+  namelist /mynml/ zeros, z
+
+  zeros = 0
+  zeros(5) = 1
+
+  open(10,status="scratch", delim="apostrophe")
+  write (10, nml=mynml, iostat=ier)
+  if (ier.ne.0) call abort
+
+  rewind (10)
+  read (10, NML=mynml, IOSTAT=ier)
+  if (ier.ne.0) call abort
+  close (10)
+
+end program namelist_13
+
diff --git a/gcc/testsuite/gfortran.dg/namelist_14.f90 b/gcc/testsuite/gfortran.dg/namelist_14.f90
new file mode 100644
index 000000000..478e07fe6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_14.f90
@@ -0,0 +1,99 @@
+!{ dg-do run }
+!{ dg-options "-std=legacy" }
+!
+! Tests various combinations of intrinsic types, derived types, arrays,
+! dummy arguments and common to check nml_get_addr_expr in trans-io.c.
+! See comments below for selection.
+! provided by Paul Thomas - pault@gcc.gnu.org
+
+module global
+  type             ::  mt
+    sequence
+    integer        ::  ii(4)
+  end type mt
+end module global
+
+program namelist_14
+  use global
+  common /myc/ cdt
+  integer          ::  i(2) = (/101,201/)
+  type(mt)         ::  dt(2)
+  type(mt)         ::  cdt
+  real(kind=8)           ::  pi = 3.14159_8
+  character*10     ::  chs="singleton"
+  character*10     ::  cha(2)=(/"first     ","second    "/)
+
+  dt = mt ((/99,999,9999,99999/))
+  cdt = mt ((/-99,-999,-9999,-99999/))
+  call foo (i,dt,pi,chs,cha)
+
+contains
+
+  logical function dttest (dt1, dt2)
+    use global
+    type(mt)       :: dt1
+    type(mt)       :: dt2
+    dttest = any(dt1%ii == dt2%ii)
+  end function dttest
+
+
+  subroutine foo (i, dt, pi, chs, cha)
+    use global
+    common /myc/ cdt
+    real(kind=8)        :: pi                   !local real scalar
+    integer        :: i(2)                 !dummy arg. array
+    integer        :: j(2) = (/21, 21/)    !equivalenced array
+    integer        :: jj                   !    -||-     scalar
+    integer        :: ier
+    type(mt)       :: dt(2)                !dummy arg., derived array
+    type(mt)       :: dtl(2)               !in-scope derived type array
+    type(mt)       :: dts                  !in-scope derived type
+    type(mt)       :: cdt                  !derived type in common block
+    character*10   :: chs                  !dummy arg. character var.
+    character*10   :: cha(:)               !dummy arg. character array
+    character*10   :: chl="abcdefg"        !in-scope character var.
+    equivalence (j,jj)
+    namelist /z/     dt, dtl, dts, cdt, j, jj, i, pi, chs, chl, cha
+
+    dts = mt ((/1, 2, 3, 4/))
+    dtl = mt ((/41, 42, 43, 44/))
+
+    open (10, status = "scratch", delim='apostrophe')
+    write (10, nml = z, iostat = ier)
+    if (ier /= 0 ) call abort()
+    rewind (10)
+
+    i = 0
+    j = 0
+    jj = 0
+    pi = 0
+    dt  = mt ((/0, 0, 0, 0/))
+    dtl = mt ((/0, 0, 0, 0/))
+    dts = mt ((/0, 0, 0, 0/))
+    cdt = mt ((/0, 0, 0, 0/))
+    chs = ""
+    cha = ""
+    chl = ""
+
+    read (10, nml = z, iostat = ier)
+    if (ier /= 0 ) call abort()
+    close (10)
+
+    if (.not.(dttest (dt(1),  mt ((/99,999,9999,99999/))) .and.  &
+          dttest (dt(2),  mt ((/99,999,9999,99999/))) .and.  &
+          dttest (dtl(1), mt ((/41, 42, 43, 44/))) .and.     &
+          dttest (dtl(2), mt ((/41, 42, 43, 44/))) .and.     &
+          dttest (dts, mt ((/1, 2, 3, 4/))) .and.            &
+          dttest (cdt, mt ((/-99,-999,-9999,-99999/))) .and. &
+          all (j ==(/21, 21/)) .and.                         &
+          all (i ==(/101, 201/)) .and.                       &
+          (pi == 3.14159_8) .and.                            &
+          (chs == "singleton") .and.                         &
+          (chl == "abcdefg") .and.                           &
+          (cha(1)(1:10) == "first    ") .and.                &
+          (cha(2)(1:10) == "second    "))) call abort ()
+
+    end subroutine foo
+end program namelist_14 
+
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/namelist_15.f90 b/gcc/testsuite/gfortran.dg/namelist_15.f90
new file mode 100644
index 000000000..e900e71d1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_15.f90
@@ -0,0 +1,65 @@
+!{ dg-do run }
+! Tests arrays of derived types containing derived type arrays whose
+! components are character arrays - exercises object name parser in
+! list_read.c. Checks that namelist output can be reread. 
+! provided by Paul Thomas - pault@gcc.gnu.org
+
+module global
+  type             ::  mt
+    character(len=2) ::  ch(2) = (/"aa","bb"/)
+  end type mt
+  type             ::  bt
+    integer        ::  i(2) = (/1,2/)
+    type(mt)       ::  m(2)
+  end type bt
+end module global
+
+program namelist_15
+  use global
+  type(bt)         ::  x(2)
+
+  namelist /mynml/ x
+
+  open (10, status = "scratch", delim='apostrophe')
+  write (10, '(A)') "&MYNML"
+  write (10, '(A)') " x = 3, 4, 'dd', 'ee', 'ff', 'gg',"
+  write (10, '(A)') "     4, 5, 'hh', 'ii', 'jj', 'kk',"
+  write (10, '(A)') " x(1)%i = , ,"
+  write (10, '(A)') " x(2)%i = -3, -4"
+  write (10, '(A)') " x(2)%m(1)%ch(2)(1:1) ='q',"
+  write (10, '(A)') " x(2)%m(2)%ch(1)(1:1) ='w',"
+  write (10, '(A)') " x(1)%m(1)%ch(1:2)(2:2) = 'z','z',"
+  write (10, '(A)') " x(2)%m(1)%ch(1:2)(2:2) = 'z','z',"
+  write (10, '(A)') " x(1)%m(2)%ch(1:2)(2:2) = 'z','z',"
+  write (10, '(A)') " x(2)%m(2)%ch(1:2)(2:2) = 'z','z',"
+  write (10, '(A)') "/"
+   
+  rewind (10)
+  read (10, nml = mynml, iostat = ier)
+  if (ier .ne. 0) call abort () 
+  close (10)
+
+  open (10, status = "scratch", delim='apostrophe')
+  write (10, nml = mynml)
+  rewind (10)
+
+  read (10, nml = mynml, iostat = ier)
+  if (ier .ne. 0) call abort () 
+  close(10)
+
+  if (.not. ((x(1)%i(1) == 3)          .and. &
+             (x(1)%i(2) == 4)          .and. &
+             (x(1)%m(1)%ch(1) == "dz") .and. &
+             (x(1)%m(1)%ch(2) == "ez") .and. &
+             (x(1)%m(2)%ch(1) == "fz") .and. &
+             (x(1)%m(2)%ch(2) == "gz") .and. &
+             (x(2)%i(1) == -3)         .and. &
+             (x(2)%i(2) == -4)         .and. &
+             (x(2)%m(1)%ch(1) == "hz") .and. &
+             (x(2)%m(1)%ch(2) == "qz") .and. &
+             (x(2)%m(2)%ch(1) == "wz") .and. &
+             (x(2)%m(2)%ch(2) == "kz"))) call abort ()
+
+end program namelist_15
+
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/namelist_16.f90 b/gcc/testsuite/gfortran.dg/namelist_16.f90
new file mode 100644
index 000000000..c6eb8f755
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_16.f90
@@ -0,0 +1,29 @@
+!{ dg-do run }
+! Tests namelist on complex variables
+! provided by Paul Thomas - pault@gcc.gnu.org
+program namelist_16
+  complex(kind=8), dimension(2)  ::   z
+  namelist /mynml/ z
+  z = (/(1.0,2.0), (3.0,4.0)/)
+
+  open (10, status = "scratch")
+  write (10, '(A)') "&mynml z(1)=(5.,6.) z(2)=(7.,8.) /"
+  rewind (10)
+
+  read (10, mynml, iostat = ier)
+  if (ier .ne. 0) call abort ()
+  close (10)
+
+  open (10, status = "scratch")
+  write (10, mynml, iostat = ier)
+  if (ier .ne. 0) call abort ()
+  rewind (10)
+
+  z = (/(1.0,2.0), (3.0,4.0)/)
+  read (10, mynml, iostat = ier)
+  if (ier .ne. 0) call abort ()
+  close (10)
+
+  if ((z(1) .ne. (5.0,6.0)) .or. (z(2) .ne. (7.0,8.0))) call abort ()
+
+end program namelist_16 
diff --git a/gcc/testsuite/gfortran.dg/namelist_17.f90 b/gcc/testsuite/gfortran.dg/namelist_17.f90
new file mode 100644
index 000000000..e3eac5210
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_17.f90
@@ -0,0 +1,30 @@
+!{ dg-do run }
+! Tests namelist on logical variables
+! provided by Paul Thomas - pault@gcc.gnu.org
+
+program namelist_17
+  logical, dimension(2)        ::   l
+  namelist /mynml/ l
+  l = (/.true., .false./)
+
+  open (10, status = "scratch")
+  write (10, '(A)') "&mynml l = F T /"
+  rewind (10)
+  
+  read (10, mynml, iostat = ier)
+  if (ier .ne. 0) call abort ()
+  close (10)
+
+  open (10, status = "scratch")
+  write (10, mynml, iostat = ier)
+  if (ier .ne. 0) call abort ()
+  rewind (10)
+
+  l = (/.true., .false./)
+  read (10, mynml, iostat = ier)
+  if (ier .ne. 0) call abort ()
+  close (10)
+
+  if (l(1) .or. (.not.l(2))) call abort ()
+
+end program namelist_17 
diff --git a/gcc/testsuite/gfortran.dg/namelist_18.f90 b/gcc/testsuite/gfortran.dg/namelist_18.f90
new file mode 100644
index 000000000..87b66012d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_18.f90
@@ -0,0 +1,39 @@
+!{ dg-do run }
+!{ dg-options "-std=legacy" }
+!
+! Tests character delimiters for namelist write 
+! provided by Paul Thomas - pault@gcc.gnu.org
+
+program namelist_18
+  character*3        ::   ch = "foo"
+  character*80       ::   buffer
+  namelist /mynml/ ch
+
+  open (10, status = "scratch")
+  write (10, mynml)
+  rewind (10)
+  read (10, '(a)', iostat = ier) buffer
+  read (10, '(a)', iostat = ier) buffer
+  if (ier .ne. 0) call abort ()
+  close (10)
+  If ((buffer(6:6) /= "f") .or. (buffer(9:9) /= """")) call abort () 
+
+  open (10, status = "scratch", delim ="quote")
+  write (10, mynml)
+  rewind (10)
+  read (10, '(a)', iostat = ier) buffer
+  read (10, '(a)', iostat = ier) buffer
+  if (ier .ne. 0) call abort ()
+  close (10)
+  If ((buffer(5:5) /= """") .or. (buffer(9:9) /= """")) call abort ()
+
+  open (10, status = "scratch", delim ="apostrophe")
+  write (10, mynml)
+  rewind (10)
+  read (10, '(a)', iostat = ier) buffer
+  read (10, '(a)', iostat = ier) buffer
+  if (ier .ne. 0) call abort ()
+  close (10)
+  If ((buffer(5:5) /= "'") .or. (buffer(9:9) /= "'")) call abort ()
+
+end program namelist_18
diff --git a/gcc/testsuite/gfortran.dg/namelist_19.f90 b/gcc/testsuite/gfortran.dg/namelist_19.f90
new file mode 100644
index 000000000..4821033ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_19.f90
@@ -0,0 +1,137 @@
+!{ dg-do run }
+!{ dg-options "-std=legacy" }
+!
+! Test namelist error trapping.
+! provided by Paul Thomas - pault@gcc.gnu.org
+
+program namelist_19
+  character*80 wrong, right
+  
+! "=" before any object name
+  wrong = "&z = i = 1,2 /"
+  right = "&z i = 1,2 /"
+  call test_err(wrong, right)
+  
+! &* instead of &end for termination 
+  wrong = "&z i = 1,2 &xxx"
+  right = "&z i = 1,2 &end"
+  call test_err(wrong, right)
+  
+! bad data 
+  wrong = "&z i = 1,q /"
+  right = "&z i = 1,2 /"
+  call test_err(wrong, right)
+  
+! object name not matched 
+  wrong = "&z j = 1,2 /"
+  right = "&z i = 1,2 /"
+  call test_err(wrong, right)
+
+! derived type component for intrinsic type
+  wrong = "&z i%j = 1,2 /"
+  right = "&z i = 1,2 /"
+  call test_err(wrong, right)
+
+! step other than 1 for substring qualifier
+  wrong = "&z ch(1:2:2) = 'a'/"
+  right = "&z ch(1:2) = 'ab' /"
+  call test_err(wrong, right)
+
+! qualifier for scalar 
+  wrong = "&z k(2) = 1 /"
+  right = "&z k    = 1 /"
+  call test_err(wrong, right)
+
+! no '=' after object name 
+  wrong = "&z i   1,2 /"
+  right = "&z i = 1,2 /"
+  call test_err(wrong, right)
+
+! repeat count too large 
+  wrong = "&z i = 3*2 /"
+  right = "&z i = 2*2 /"
+  call test_err(wrong, right)
+
+! too much data 
+  wrong = "&z i = 1 2 3 /"
+  right = "&z i = 1 2 /"
+  call test_err(wrong, right)
+
+! no '=' after object name 
+  wrong = "&z i   1,2 /"
+  right = "&z i = 1,2 /"
+  call test_err(wrong, right)
+
+! bad number of index fields
+  wrong = "&z i(1,2) = 1 /"
+  right = "&z i(1)   = 1 /"
+  call test_err(wrong, right)
+
+! bad character in index field 
+  wrong = "&z i(x) = 1 /"
+  right = "&z i(1) = 1 /"
+  call test_err(wrong, right)
+
+! null index field 
+  wrong = "&z i( ) = 1 /"
+  right = "&z i(1) = 1 /"
+  call test_err(wrong, right)
+
+! null index field 
+  wrong = "&z i(1::)   = 1 2/"
+  right = "&z i(1:2:1) = 1 2 /"
+  call test_err(wrong, right)
+
+! null index field 
+  wrong = "&z i(1:2:)  = 1 2/"
+  right = "&z i(1:2:1) = 1 2 /"
+  call test_err(wrong, right)
+
+! index out of range 
+  wrong = "&z i(10) = 1 /"
+  right = "&z i(1)  = 1 /"
+  call test_err(wrong, right)
+
+! index out of range 
+  wrong = "&z i(0:1) = 1 /"
+  right = "&z i(1:1) = 1 /"
+  call test_err(wrong, right)
+
+! bad range
+  wrong = "&z i(1:2:-1) = 1 2 /"
+  right = "&z i(1:2: 1) = 1 2 /"
+  call test_err(wrong, right)
+
+! bad range
+  wrong = "&z i(2:1: 1) = 1 2 /"
+  right = "&z i(2:1:-1) = 1 2 /"
+  call test_err(wrong, right)
+
+contains
+  subroutine test_err(wrong, right)
+    character*80 wrong, right
+    integer            :: i(2) = (/0, 0/)
+    integer            :: k =0
+    character*2        :: ch = "  "
+    namelist /z/ i, k, ch
+
+! Check that wrong namelist input gives an error
+
+    open (10, status = "scratch")
+    write (10, '(A)') wrong
+    rewind (10)
+    read (10, z, iostat = ier)
+    close(10)
+    if (ier == 0) call abort ()
+
+! Check that right namelist input gives no error
+
+    open (10, status = "scratch")
+    write (10, '(A)') right
+    rewind (10)
+    read (10, z, iostat = ier)
+    close(10)
+    if (ier /= 0) call abort ()
+  end subroutine test_err
+  
+end program namelist_19
diff --git a/gcc/testsuite/gfortran.dg/namelist_2.f90 b/gcc/testsuite/gfortran.dg/namelist_2.f90
new file mode 100644
index 000000000..b92e45941
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_2.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! Check that variable with intent(in) cannot be a member of a namelist
+subroutine namelist_2(x)
+  integer,intent(in) :: x
+  namelist /n/ x
+  read(*,n) ! { dg-error "is INTENT" "" }
+end subroutine namelist_2
diff --git a/gcc/testsuite/gfortran.dg/namelist_20.f90 b/gcc/testsuite/gfortran.dg/namelist_20.f90
new file mode 100644
index 000000000..155cf6f8e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_20.f90
@@ -0,0 +1,35 @@
+!{ dg-do run }
+! Tests namelist io for an explicit shape array with negative bounds
+! provided by Paul Thomas - pault@gcc.gnu.org
+
+program namelist_20
+  integer, dimension (-4:-2) :: x
+  integer                    :: i, ier
+  namelist /a/ x
+
+  open (10, status = "scratch")
+  write (10, '(A)') "&a x(-5)=0 /"            !-ve index below lbound
+  write (10, '(A)') "&a x(-1)=0 /"            !-ve index above ubound
+  write (10, '(A)') "&a x(1:2)=0 /"           !+ve indices
+  write (10, '(A)') "&a x(-4:-2)= -4,-3,-2 /" !correct
+  write (10, '(A)') " "
+  rewind (10)
+
+  ier=0
+  read(10, a, iostat=ier)
+  if (ier == 0) call abort ()
+  ier=0
+  read(10, a, iostat=ier)
+  if (ier == 0) call abort ()
+  ier=0
+  read(10, a, iostat=ier)
+  if (ier == 0) call abort ()
+
+  ier=0
+  read(10, a, iostat=ier)
+  if (ier /= 0) call abort ()
+  do i = -4,-2
+    if (x(i) /= i) call abort ()
+  end do
+
+end program namelist_20 
diff --git a/gcc/testsuite/gfortran.dg/namelist_21.f90 b/gcc/testsuite/gfortran.dg/namelist_21.f90
new file mode 100644
index 000000000..de88200c1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_21.f90
@@ -0,0 +1,43 @@
+!{ dg-do run { target fd_truncate } }
+!{ dg-options "-std=legacy" }
+!
+! Tests filling arrays from a namelist read when object list is not complete.
+! Developed from a test case provided by Christoph Jacob.
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org>.
+program pr24794
+
+   implicit none
+   integer, parameter :: maxop=15, iunit=7
+   character*8 namea(maxop), nameb(maxop)
+   integer i, ier
+
+   namelist/ccsopr/ namea,nameb
+   namea=""
+   nameb=""
+   open (12, status="scratch", delim="apostrophe")
+   write (12, '(a)') "&ccsopr"
+   write (12, '(a)') "    namea='spi01h','spi02o','spi03h','spi04o','spi05h',"
+   write (12, '(a)') "          'spi07o','spi08h','spi09h',"
+   write (12, '(a)') "    nameb='spi01h','spi03h','spi05h','spi06h','spi08h',"
+   write (12, '(a)') "&end"
+
+   rewind (12)
+   read (12, nml=ccsopr, iostat=ier)
+   if (ier.ne.0) call abort()
+   
+   rewind (12)
+   write(12,nml=ccsopr)
+   
+   rewind (12)
+   read (12, nml=ccsopr, iostat=ier)
+   if (ier.ne.0) call abort()
+   
+   if (namea(2).ne."spi02o  ") call abort()
+   if (namea(9).ne."        ") call abort()
+   if (namea(15).ne."        ") call abort()
+   if (nameb(1).ne."spi01h  ") call abort()
+   if (nameb(6).ne."        ") call abort()
+   if (nameb(15).ne."        ") call abort()
+   
+   close (12)
+end program pr24794
diff --git a/gcc/testsuite/gfortran.dg/namelist_22.f90 b/gcc/testsuite/gfortran.dg/namelist_22.f90
new file mode 100644
index 000000000..e877b5bee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_22.f90
@@ -0,0 +1,43 @@
+!{ dg-do run { target fd_truncate } }
+!{ dg-options "-std=legacy" }
+!
+! Tests filling arrays from a namelist read when object list is not complete.
+! This is the same as namelist_21.f90 except using spaces as seperators instead
+! of commas. Developed from a test case provided by Christoph Jacob.
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org>.
+program pr24794
+
+   implicit none
+   integer, parameter :: maxop=15, iunit=7
+   character*8 namea(maxop), nameb(maxop)
+   integer i, ier
+
+   namelist/ccsopr/ namea,nameb
+   namea=""
+   nameb=""
+   open (12, status="scratch", delim="apostrophe")
+   write (12, '(a)') "&ccsopr"
+   write (12, '(a)') "    namea='spi01h' 'spi02o' 'spi03h' 'spi04o' 'spi05h'"
+   write (12, '(a)') "          'spi07o' 'spi08h' 'spi09h'"
+   write (12, '(a)') "    nameb='spi01h' 'spi03h' 'spi05h' 'spi06h' 'spi08h'"
+   write (12, '(a)') "&end"
+
+   rewind (12)
+   read (12, nml=ccsopr, iostat=ier)
+   if (ier.ne.0) call abort()
+   
+   rewind (12)
+   write(12,nml=ccsopr)
+   
+   rewind (12)
+   read (12, nml=ccsopr, iostat=ier)
+   if (ier.ne.0) call abort()
+   if (namea(2).ne."spi02o  ") call abort()
+   if (namea(9).ne."        ") call abort()
+   if (namea(15).ne."        ") call abort()
+   if (nameb(1).ne."spi01h  ") call abort()
+   if (nameb(6).ne."        ") call abort()
+   if (nameb(15).ne."        ") call abort()
+   
+   close (12)
+end program pr24794
diff --git a/gcc/testsuite/gfortran.dg/namelist_23.f90 b/gcc/testsuite/gfortran.dg/namelist_23.f90
new file mode 100644
index 000000000..7d69ef62f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_23.f90
@@ -0,0 +1,53 @@
+!{ dg-do run { target fd_truncate } }
+! PR26136 Filling logical variables from namelist read when object list is not
+! complete.  Test case derived from PR.
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program read_logical
+   implicit none
+   logical, dimension(4) :: truely
+   integer, dimension(4) :: truely_a_very_long_variable_name
+   namelist /mynml/ truely
+   namelist /mynml/ truely_a_very_long_variable_name
+
+   truely = .false.
+   truely_a_very_long_variable_name = 0
+
+   open(10, status="scratch")
+   write(10,*) "&mynml"
+   write(10,*) "truely       = trouble,    traffic .true"
+   write(10,*) "truely_a_very_long_variable_name  = 4,      4,      4"
+   write(10,*) "/"
+   rewind(10)
+   read (10, nml=mynml, err = 1000)
+   if (.not.all(truely(1:3))) call abort()
+   if (.not.all(truely_a_very_long_variable_name(1:3).eq.4)) call abort()
+   
+   truely = .false.
+   truely_a_very_long_variable_name = 0
+
+   rewind(10)
+   write(10,*) "&mynml"
+   write(10,*) "truely       = .true., .true.,"
+   write(10,*) "truely_a_very_long_variable_name  = 4,      4,      4"
+   write(10,*) "/"
+   rewind(10)
+   read (10, nml=mynml, err = 1000)
+   if (.not.all(truely(1:2))) call abort()
+   if (.not.all(truely_a_very_long_variable_name(1:3).eq.4)) call abort()
+
+   truely = .true.
+   truely_a_very_long_variable_name = 0
+
+   rewind(10)
+   write(10,*) "&mynml"
+   write(10,*) "truely       = .false., .false.,"
+   write(10,*) "truely_a_very_long_variable_name  = 4,      4,      4"
+   write(10,*) "/"
+   rewind(10)
+   read (10, nml=mynml, err = 1000)
+   if (all(truely(1:2))) call abort()
+   if (.not.all(truely_a_very_long_variable_name(1:3).eq.4)) call abort()
+   close(10)
+   stop
+1000 call abort()
+end program read_logical
diff --git a/gcc/testsuite/gfortran.dg/namelist_24.f90 b/gcc/testsuite/gfortran.dg/namelist_24.f90
new file mode 100644
index 000000000..11cd2d0a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_24.f90
@@ -0,0 +1,42 @@
+!{ dg-do run }
+!{ dg-options -std=gnu }
+! Tests namelist read when more data is provided then specified by 
+! array qualifier in list.
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org>.
+      program pr24459
+      implicit none
+      integer nd, ier, i, j
+      parameter ( nd = 5 )
+      character*(8) names(nd,nd)
+      character*(8) names2(nd,nd)
+      character*(8) names3(nd,nd)
+      namelist / mynml /  names, names2, names3
+      open(unit=20,status='scratch', delim='apostrophe')
+      write (20, '(a)') "&MYNML"
+      write (20, '(a)') "NAMES = 25*'0'"
+      write (20, '(a)') "NAMES2 = 25*'0'"
+      write (20, '(a)') "NAMES3 = 25*'0'"
+      write (20, '(a)') "NAMES(2,2) = 'frogger'"
+      write (20, '(a)') "NAMES(1,1) = 'E123' 'E456' 'D789' 'P135' 'P246'"
+      write (20, '(a)') "NAMES2(1:5:2,2) = 'abcde' 'fghij' 'klmno'"
+      write (20, '(a)') "NAMES3 = 'E123' 'E456' 'D789' 'P135' 'P246' '0' 'frogger'"
+      write (20, '(a)') "/"
+      rewind(20)
+      read(20,nml=mynml, iostat=ier)
+      if (ier.ne.0) call abort()
+      if (any(names(:,3:5).ne."0")) call abort()
+      if (names(2,2).ne."frogger") call abort()
+      if (names(1,1).ne."E123") call abort()
+      if (names(2,1).ne."E456") call abort()
+      if (names(3,1).ne."D789") call abort()
+      if (names(4,1).ne."P135") call abort()
+      if (names(5,1).ne."P246") call abort()
+      if (any(names2(:,1).ne."0")) call abort()
+      if (any(names2(:,3:5).ne."0")) call abort()
+      if (names2(1,2).ne."abcde") call abort()
+      if (names2(2,2).ne."0") call abort()
+      if (names2(3,2).ne."fghij") call abort()
+      if (names2(4,2).ne."0") call abort()
+      if (names2(5,2).ne."klmno") call abort()
+      if (any(names3.ne.names)) call abort()
+      end
diff --git a/gcc/testsuite/gfortran.dg/namelist_25.f90 b/gcc/testsuite/gfortran.dg/namelist_25.f90
new file mode 100644
index 000000000..16bcee86c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_25.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! Tests patch for PR29407, in which the declaration of 'my' as
+! a local variable was ignored, so that the procedure and namelist
+! attributes for 'my' clashed..
+!
+! Contributed by Tobias Burnus  <tobias.burnus@physik.fu-berlin.de>
+!
+program main
+  implicit none
+contains
+  subroutine my
+  end subroutine my
+  subroutine bar
+    integer :: my
+    namelist /ops/ my
+  end subroutine bar
+end program main
+
diff --git a/gcc/testsuite/gfortran.dg/namelist_26.f90 b/gcc/testsuite/gfortran.dg/namelist_26.f90
new file mode 100644
index 000000000..2c1b26062
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_26.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+! PR30918 Failure to skip commented out NAMELIST
+! Before the patch, this read the commented out namelist and iuse would
+! equal 2 when done.  Test case from PR.
+program gfcbug58
+  implicit none
+  integer            :: iuse = 0, ios
+  integer, parameter :: nmlunit = 10    ! Namelist unit
+  !------------------
+  ! Namelist 'REPORT'
+  !------------------
+  character(len=12) :: type, use
+  integer           :: max_proc
+  namelist /REPORT/ type, use, max_proc
+  !------------------
+  ! Set up the test file
+  !------------------
+  open(unit=nmlunit, status="scratch")
+  write(nmlunit, '(a)') "!================"
+  write(nmlunit, '(a)') "! Namelist REPORT"
+  write(nmlunit, '(a)') "!================"
+  write(nmlunit, '(a)') "!      &REPORT use      = 'ignore'   / ! Comment"
+  write(nmlunit, '(a)') "!"
+  write(nmlunit, '(a)') " &REPORT type     = 'SYNOP'"
+  write(nmlunit, '(a)') "         use      = 'active'"
+  write(nmlunit, '(a)') "         max_proc = 20"
+  write(nmlunit, '(a)') " /"
+  rewind(nmlunit)
+  !-------------------------------------
+  ! Loop to read namelist multiple times
+  !-------------------------------------
+  do
+     !----------------------------------------
+     ! Preset namelist variables with defaults
+     !----------------------------------------
+     type      = ''
+     use       = ''
+     max_proc  = -1
+     !--------------
+     ! Read namelist
+     !--------------
+     read (nmlunit, nml=REPORT, iostat=ios)
+     if (ios /= 0) exit
+     iuse = iuse + 1
+  end do
+  if (iuse /= 1) call abort()
+
+end program gfcbug58
diff --git a/gcc/testsuite/gfortran.dg/namelist_27.f90 b/gcc/testsuite/gfortran.dg/namelist_27.f90
new file mode 100644
index 000000000..06381b116
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_27.f90
@@ -0,0 +1,106 @@
+! { dg-do run }
+! PR31052 Bad IOSTAT values when readings NAMELISTs past EOF.
+! Patch derived from PR, submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+program gfcbug61
+  implicit none
+  integer            :: stat
+
+  open (12, status="scratch")
+  write (12, '(a)')"!================"
+  write (12, '(a)')"! Namelist REPORT"
+  write (12, '(a)')"!================"
+  write (12, '(a)')" &REPORT type     = 'SYNOP' "
+  write (12, '(a)')"         use      = 'active'"
+  write (12, '(a)')"         max_proc = 20"
+  write (12, '(a)')" /"
+  write (12, '(a)')"! Other namelists..."
+  write (12, '(a)')" &OTHER  i = 1 /"
+  rewind (12)
+
+  ! Read /REPORT/ the first time
+  rewind (12)
+  call position_nml (12, "REPORT", stat)
+  if (stat.ne.0) call abort()
+  if (stat == 0)  call read_report (12, stat)
+
+  ! Comment out the following lines to hide the bug
+  rewind (12)
+  call position_nml (12, "MISSING", stat)
+  if (stat.ne.-1)  call abort ()
+
+  ! Read /REPORT/ again
+  rewind (12)
+  call position_nml (12, "REPORT", stat)
+  if (stat.ne.0)  call abort()
+
+contains
+
+  subroutine position_nml (unit, name, status)
+    ! Check for presence of namelist 'name'
+    integer                      :: unit, status
+    character(len=*), intent(in) :: name
+
+    character(len=255) :: line
+    integer            :: ios, idx, k
+    logical            :: first
+
+    first = .true.
+    status = 0
+    ios = 0
+    line = ""
+    do k=1,10
+       read (unit,'(a)',iostat=ios) line
+       if (first) then
+          first = .false.
+       end if
+       if (ios < 0) then
+          ! EOF encountered!
+          backspace (unit)
+          status = -1
+          return
+       else if (ios > 0) then
+          ! Error encountered!
+          status = +1
+          return
+       end if
+       idx = index (line, "&"//trim (name))
+       if (idx > 0) then
+          backspace (unit)
+          return
+       end if
+    end do
+  end subroutine position_nml
+
+  subroutine read_report (unit, status)
+    integer :: unit, status
+
+    integer            :: iuse, ios, k
+    !------------------
+    ! Namelist 'REPORT'
+    !------------------
+    character(len=12) :: type, use
+    integer           :: max_proc
+    namelist /REPORT/ type, use, max_proc
+    !-------------------------------------
+    ! Loop to read namelist multiple times
+    !-------------------------------------
+    iuse = 0
+    do k=1,5
+       !----------------------------------------
+       ! Preset namelist variables with defaults
+       !----------------------------------------
+       type      = ''
+       use       = ''
+       max_proc  = -1
+       !--------------
+       ! Read namelist
+       !--------------
+       read (unit, nml=REPORT, iostat=ios)
+       if (ios /= 0) exit
+       iuse = iuse + 1
+    end do
+    if (iuse.ne.1) call abort()
+    status = ios
+  end subroutine read_report
+
+end program gfcbug61
diff --git a/gcc/testsuite/gfortran.dg/namelist_28.f90 b/gcc/testsuite/gfortran.dg/namelist_28.f90
new file mode 100644
index 000000000..22bddf662
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_28.f90
@@ -0,0 +1,92 @@
+! { dg-do run }
+! PR31052 Bad IOSTAT values when readings NAMELISTs past EOF.
+! Patch derived from PR, submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+program gfcbug61
+  implicit none
+  integer, parameter :: nmlunit = 12    ! Namelist unit
+  integer            :: stat
+
+  open (nmlunit, status="scratch")
+  write(nmlunit, '(a)') "&REPORT type='report1' /"
+  write(nmlunit, '(a)') "&REPORT type='report2' /"
+  write(nmlunit, '(a)') "!"
+  rewind (nmlunit)
+
+! The call to position_nml is contained in the subroutine
+  call read_report (nmlunit, stat)
+  rewind (nmlunit)
+  call position_nml (nmlunit, 'MISSING', stat)
+  rewind (nmlunit)
+  call read_report (nmlunit, stat)              ! gfortran fails here
+  
+contains
+
+  subroutine position_nml (unit, name, status)
+    ! Check for presence of namelist 'name'
+    integer                      :: unit, status
+    character(len=*), intent(in) :: name
+
+    character(len=255) :: line
+    integer            :: ios, idx, k
+    logical            :: first
+
+    first = .true.
+    status = 0
+    do k=1,25
+       line = ""
+       read (unit,'(a)',iostat=ios) line
+       if (ios < 0) then
+          ! EOF encountered!
+          backspace (unit)
+          status = -1
+          return
+       else if (ios > 0) then
+          ! Error encountered!
+          status = +1
+          return
+       end if
+       idx = index (line, "&"//trim (name))
+       if (idx > 0) then
+          backspace (unit)
+          return
+       end if
+    end do
+    if (k.gt.10) call abort
+  end subroutine position_nml
+
+  subroutine read_report (unit, status)
+    integer :: unit, status
+
+    integer            :: iuse, ios, k
+    !------------------
+    ! Namelist 'REPORT'
+    !------------------
+    character(len=12) :: type
+    namelist /REPORT/ type
+    !-------------------------------------
+    ! Loop to read namelist multiple times
+    !-------------------------------------
+    iuse = 0
+    do k=1,25
+       !----------------------------------------
+       ! Preset namelist variables with defaults
+       !----------------------------------------
+       type      = ''
+       !--------------
+       ! Read namelist
+       !--------------
+       call position_nml (unit, "REPORT", status)
+       if (stat /= 0) then
+          ios = status
+          if (iuse /= 2) call abort()
+          return
+       end if
+       read (unit, nml=REPORT, iostat=ios)
+       if (ios /= 0) exit
+       iuse = iuse + 1
+    end do
+    if (k.gt.10) call abort
+    status = ios
+  end subroutine read_report
+
+end program gfcbug61
diff --git a/gcc/testsuite/gfortran.dg/namelist_29.f90 b/gcc/testsuite/gfortran.dg/namelist_29.f90
new file mode 100644
index 000000000..55bff0c90
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_29.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! Checks the fix for PR30878, in which the inclusion
+! of an implicit function result variable in a namelist
+! would cause an error.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+  character(80) :: buffer
+  if (f1 (buffer) .ne. 42) call abort ()
+CONTAINS
+   INTEGER FUNCTION F1 (buffer)
+     NAMELIST /mynml/ F1
+     integer :: check
+     character(80) :: buffer
+     F1 = 42
+     write (buffer, nml = mynml)
+     F1 = 0
+     READ (buffer, nml = mynml)
+   end function
+END
diff --git a/gcc/testsuite/gfortran.dg/namelist_3.f90 b/gcc/testsuite/gfortran.dg/namelist_3.f90
new file mode 100644
index 000000000..722b94027
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_3.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! Check that a pointer cannot be a member of a namelist
+program namelist_3
+  integer,pointer :: x
+  allocate (x)
+  namelist /n/ x ! { dg-error "NAMELIST attribute with POINTER attribute" "" }
+end program namelist_3
diff --git a/gcc/testsuite/gfortran.dg/namelist_30.f90 b/gcc/testsuite/gfortran.dg/namelist_30.f90
new file mode 100644
index 000000000..1e7cb9ed1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_30.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! PR fortran/32710 - ICE: namelist and subroutine with the same name
+!
+! Contributed by Janus Weil <jaydub66 AT gmail DOT com>
+!
+
+program x
+contains
+  subroutine readInput
+    integer:: a
+    NAMELIST /foo/ a
+    read(5,nml=foo)
+  end subroutine readInput
+
+  subroutine foo()
+  end subroutine
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/namelist_31.f90 b/gcc/testsuite/gfortran.dg/namelist_31.f90
new file mode 100644
index 000000000..b7aba98b4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_31.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! One of two tests for the fix of PR23152 - There used to be
+! no warning for assumed shape arrays in namelists.
+!
+! Conributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+program assumed_shape_nml
+  real, dimension (10) :: z
+  z = 42.0
+  call foo (z)
+contains
+  subroutine foo (y)
+    real, DIMENSION (:) :: y
+    namelist /mynml/ y
+    write (*, mynml)
+  end subroutine foo
+end program assumed_shape_nml
diff --git a/gcc/testsuite/gfortran.dg/namelist_32.f90 b/gcc/testsuite/gfortran.dg/namelist_32.f90
new file mode 100644
index 000000000..76d514833
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_32.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! One of two tests for the fix of PR23152 - An ICE would
+! ensue from assumed shape arrays in namelists.
+!
+! Conributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+program assumed_size_nml
+  real, dimension (10) :: z
+  z = 42.0
+  call foo (z)
+contains
+  subroutine foo (y)
+    real, DIMENSION (*) :: y
+    namelist /mynml/ y     ! { dg-error "is not allowed" }
+    write (6, mynml)
+  end subroutine foo
+end program assumed_size_nml
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/namelist_33.f90 b/gcc/testsuite/gfortran.dg/namelist_33.f90
new file mode 100644
index 000000000..8bbe59715
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_33.f90
@@ -0,0 +1,70 @@
+! { dg-do compile }
+!
+! PR fortran/32876 - accepts private items in public NAMELISTs
+!
+! USE-associated types with private components may
+! not be used in namelists -- anywhere.
+!
+MODULE types
+  type :: tp4
+    PRIVATE
+    real :: x
+    integer :: i
+  end type
+
+  ! nested type
+  type :: tp3
+    real :: x
+    integer, private :: i
+  end type
+
+  type :: tp2
+    type(tp3) :: t
+  end type
+
+  type :: tp1
+    integer :: i
+    type(tp2) :: t
+  end type
+END MODULE
+
+MODULE nml
+  USE types
+
+  type(tp1) :: t1
+  type(tp4) :: t4
+
+  namelist /a/ t1          ! { dg-error "use-associated PRIVATE components" }
+  namelist /b/ t4          ! { dg-error "use-associated PRIVATE components" }
+
+  integer, private :: i
+  namelist /c/ i           ! { dg-error "was declared PRIVATE and cannot be member of PUBLIC namelist" }
+
+contains
+  subroutine y()
+   type(tp2) :: y2
+   type(tp3) :: y3
+
+    namelist /nml2/ y2     ! { dg-error "has use-associated PRIVATE components " }
+    namelist /nml3/ y3     ! { dg-error "has use-associated PRIVATE components " }
+  end subroutine
+END MODULE
+
+
+program xxx
+  use types
+
+  type :: tp5
+    TYPE(tp4) :: t        ! nested private components
+  end type
+  type(tp5) :: t5
+
+  namelist /nml/ t5       ! { dg-error "has use-associated PRIVATE components" }
+
+contains
+  subroutine z()
+    namelist /nml2/ t5    ! { dg-error "has use-associated PRIVATE components" }
+  end subroutine
+end program
+
+! { dg-final { cleanup-modules "types nml" } }
diff --git a/gcc/testsuite/gfortran.dg/namelist_34.f90 b/gcc/testsuite/gfortran.dg/namelist_34.f90
new file mode 100644
index 000000000..f7c5e1cf6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_34.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+!
+! PR fortran/32905 - accepts types with ultimate POINTER components
+!
+MODULE types
+  type :: tp3
+    real :: x
+    integer, pointer :: i
+  end type
+
+  type :: tp2
+    type(tp3) :: t
+  end type
+
+  type :: tp1
+    integer :: i
+    type(tp2) :: t
+  end type
+END MODULE
+
+MODULE nml
+USE types
+   type(tp1) :: t1
+   type(tp3) :: t3
+
+   namelist /a/ t1    ! { dg-error "has ALLOCATABLE or POINTER components and thus requires a defined input/output" }
+   namelist /b/ t3    ! { dg-error "has ALLOCATABLE or POINTER components and thus requires a defined input/output" }
+END MODULE
+
+! { dg-final { cleanup-modules "types nml" } }
diff --git a/gcc/testsuite/gfortran.dg/namelist_35.f90 b/gcc/testsuite/gfortran.dg/namelist_35.f90
new file mode 100644
index 000000000..9a2972de8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_35.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/31818 - accepts namelists with assumed-shape arrays
+!
+
+subroutine test(cha)
+  implicit none
+  character(len=10) :: cha(:)
+  namelist /z/  cha             ! { dg-error "with assumed shape in namelist" }
+end subroutine test
diff --git a/gcc/testsuite/gfortran.dg/namelist_36.f90 b/gcc/testsuite/gfortran.dg/namelist_36.f90
new file mode 100644
index 000000000..b6a14e36b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_36.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+!
+! Private types and types with private components
+! are acceptable in local namelists.
+!
+
+MODULE nml
+  type :: tp1
+    integer :: i
+  end type
+
+  type :: tp2
+    private
+    integer :: i
+  end type
+
+  private :: tp1
+contains
+  subroutine x()
+   type(tp1) :: t1
+   type(tp2) :: t2
+
+    namelist /nml1/ i        ! ok, private variable
+    namelist /nml2/ t1       ! ok, private type
+    namelist /nml3/ t2       ! ok, private components
+  end subroutine
+END MODULE
+
+! { dg-final { cleanup-modules "nml" } }
diff --git a/gcc/testsuite/gfortran.dg/namelist_37.f90 b/gcc/testsuite/gfortran.dg/namelist_37.f90
new file mode 100644
index 000000000..4a46b534f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_37.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR33039 Read NAMELIST:  reads wrong namelist name
+! Test case from PR modified by Jerry DeLisle <jvdelisle@gcc.gnu.org>

+PROGRAM namelist

+CHARACTER*25 CHAR

+NAMELIST /CODE/ CHAR, X

+NAMELIST /CODEtwo/ X

+

+OPEN(10, status="scratch")
+write(10,'(a)') "File with test NAMELIST inputs"
+write(10,'(a)') " &CODVJS  char='VJS-Not a proper nml name', X=-0.5/"
+write(10,'(a)') " &CODEone char='CODEone input', X=-1.0 /"
+write(10,'(a)') " &CODEtwo char='CODEtwo inputs', X=-2.0/"
+write(10,'(a)') " &code    char='Lower case name',X=-3.0/"
+write(10,'(a)') " &CODE    char='Desired namelist sel', X=44./"
+write(10,'(a)') " &CODEx   char='Should not read CODEx nml', X=-5./"
+write(10,'(a)') " $CODE    char='Second desired nml', X=66.0 /"
+write(10,'(a)') " $CODE    X=77.0, char='Reordered desired nml'/"
+rewind(10)

+CHAR = 'Initialize string ***'

+X    = -777.

+READ(10, nml=CODE, END=999)
+if (x.ne.-3.0) call abort
+READ(10, nml=CODE, END=999)
+if (x.ne.44.0) call abort
+READ(10, nml=CODE, END=999)
+if (x.ne.66.0) call abort
+READ(10, nml=CODE, END=999)
+ 999 if (x.ne.77.0) call abort

+END PROGRAM namelist

diff --git a/gcc/testsuite/gfortran.dg/namelist_38.f90 b/gcc/testsuite/gfortran.dg/namelist_38.f90
new file mode 100644
index 000000000..5578654ee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_38.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! PR33253 namelist: reading back a string, also fixed writing with delimiters.
+! Test case modified from that of the PR by
+! Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program main
+  implicit none
+  character(len=3) :: a
+  namelist /foo/ a
+
+  open(10, status="scratch", delim="quote")
+  a = 'a"a'
+  write(10,foo) 
+  rewind 10
+  a = ""
+  read (10,foo) ! This gave a runtime error before the patch.
+  if (a.ne.'a"a') call abort
+  close (10)
+
+  open(10, status="scratch", delim="apostrophe")
+  a = "a'a"
+  write(10,foo) 
+  rewind 10
+  a = ""
+  read (10,foo)
+  if (a.ne."a'a") call abort
+  close (10)
+
+  open(10, status="scratch", delim="none")
+  a = "a'a"
+  write(10,foo) 
+  rewind 10
+  a = ""
+  read (10,foo)
+  if (a.ne."a'a") call abort
+  close (10)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/namelist_39.f90 b/gcc/testsuite/gfortran.dg/namelist_39.f90
new file mode 100644
index 000000000..427ba6dc2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_39.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! PR33421 and PR33253 Weird quotation of namelist output of character arrays
+! Test case from Toon Moone, adapted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+! Long names used to test line_buffer feature is working.
+
+program test
+implicit none
+character(len=45) :: b01234567890123456789012345678901234567890123456789012345678901(3)
+namelist /nam/ b01234567890123456789012345678901234567890123456789012345678901
+b01234567890123456789012345678901234567890123456789012345678901 = 'x'
+open(99, status="scratch")
+write(99,'(4(a,/),a)') "&NAM", &
+      " b01234567890123456789012345678901234567890123456789012345678901(1)=' AAP NOOT MIES WIM ZUS JET',", &
+      " b01234567890123456789012345678901234567890123456789012345678901(2)='SURF.PRESSURE',", &
+      " b01234567890123456789012345678901234567890123456789012345678901(3)='APEKOOL',", &
+      " /"
+rewind(99)
+read(99,nml=nam)
+close(99)
+
+if (b01234567890123456789012345678901234567890123456789012345678901(1).ne.&
+    " AAP NOOT MIES WIM ZUS JET                   ") call abort
+if (b01234567890123456789012345678901234567890123456789012345678901(2).ne.&
+    "SURF.PRESSURE                                ") call abort
+if (b01234567890123456789012345678901234567890123456789012345678901(3).ne.&
+    "APEKOOL                                      ") call abort
+end program test
+
diff --git a/gcc/testsuite/gfortran.dg/namelist_4.f90 b/gcc/testsuite/gfortran.dg/namelist_4.f90
new file mode 100644
index 000000000..52a5bc993
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_4.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }

+! This tests the fix for PR25089 in which it was noted that a

+! NAMELIST member that is an internal(or module) procedure gave

+! no error if the NAMELIST declaration appeared before the

+! procedure declaration. Not mentioned in the PR is that any

+! reference to the NAMELIST object would cause a segfault.

+!

+! Based on the contribution from Joost VanderVondele

+!

+module M1

+CONTAINS

+! This is the original PR

+  INTEGER FUNCTION G1()

+    NAMELIST /NML1/ G2 ! { dg-error "PROCEDURE attribute conflicts" }

+    G1=1

+  END FUNCTION

+  INTEGER FUNCTION G2()

+    G2=1

+  END FUNCTION

+! This has always been picked up - namelist after function

+  INTEGER FUNCTION G3()

+    NAMELIST /NML2/ G1 ! { dg-error "PROCEDURE attribute conflicts" }

+    G3=1

+  END FUNCTION

+END module M1

+ 
+program P1

+CONTAINS

+! This has the additional wrinkle of a reference to the object.

+  INTEGER FUNCTION F1()

+    NAMELIST /NML3/ F2 ! { dg-error "PROCEDURE attribute conflicts" }
+! Used to ICE here

+    f2 = 1             ! { dg-error "is not a VALUE" }

+    F1=1

+  END FUNCTION

+  INTEGER FUNCTION F2()

+    F2=1

+  END FUNCTION

+END
+

+! { dg-final { cleanup-modules "M1" } }
diff --git a/gcc/testsuite/gfortran.dg/namelist_40.f90 b/gcc/testsuite/gfortran.dg/namelist_40.f90
new file mode 100644
index 000000000..d6f896a39
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_40.f90
@@ -0,0 +1,54 @@
+! { dg-do run }
+! PR33672 Additional runtime checks needed for namelist reads
+! Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+module global
+  type             ::  mt
+    character(len=2) ::  ch(2) = (/"aa","bb"/)
+  end type mt
+  type             ::  bt
+    integer        ::  i(2) = (/1,2/)
+    type(mt)       ::  m(2)
+  end type bt
+end module global
+
+program namelist_40
+  use global
+  type(bt)         ::  x(2)
+  character(40)    ::  teststring 
+  namelist /mynml/ x
+
+  teststring = " x(2)%m%ch(:)(2:2) = 'z','z',"
+  call writenml (teststring)
+  teststring = " x(2)%m(2)%ch(:)(2) = 'z','z',"
+  call writenml (teststring)
+  teststring = " x(2)%m(2)%ch(:)(:3) = 'z','z',"
+  call writenml (teststring)
+  teststring = " x(2)%m(2)%ch(1:2)(k:) = 'z','z',"
+  call writenml (teststring)
+  
+contains
+
+subroutine writenml (astring)
+  character(40), intent(in)  :: astring
+  character(300)   :: errmessage
+  integer          :: ierror
+
+  open (10, status="scratch", delim='apostrophe')
+  write (10, '(A)') "&MYNML"
+  write (10, '(A)') astring
+  write (10, '(A)') "/"
+  rewind (10)
+  read (10, nml = mynml, iostat=ierror, iomsg=errmessage)
+  if (ierror == 0) call abort
+  print '(a)', trim(errmessage)
+  close (10)
+
+end subroutine writenml
+
+end program namelist_40
+! { dg-output "Multiple sub-objects with non-zero rank in namelist object x%m%ch(\n|\r\n|\r)" }
+! { dg-output "Missing colon in substring qualifier for namelist variable x%m%ch(\n|\r\n|\r)" }
+! { dg-output "Substring out of range for namelist variable x%m%ch(\n|\r\n|\r)" }
+! { dg-output "Bad character in substring qualifier for namelist variable x%m%ch(\n|\r\n|\r)" }
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/namelist_41.f90 b/gcc/testsuite/gfortran.dg/namelist_41.f90
new file mode 100644
index 000000000..16e0d42b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_41.f90
@@ -0,0 +1,22 @@
+! { dg-do run { target fd_truncate } }
+! PR34291 Segfault on &end in namelist expanded read of character
+  implicit none
+  character(len=10), dimension(2)  :: var
+  namelist /inx/ var
+  var = "goodbye"
+  open(unit=11, status='scratch')
+  write (11, *) "&inx"
+  write (11, *) "var(1)='hello'" 
+  write (11, *) "&end"
+  rewind (11)
+  read(11,nml=inx)
+  if (var(1) /= 'hello' .and. var(2) /= 'goodbye') call abort
+  var = "goodbye"
+  rewind (11)
+  write (11, *) "$inx"
+  write (11, *) "var(1)='hello'" 
+  write (11, *) "$end"
+  rewind (11)
+  read(11,nml=inx)
+  if (var(1) /= 'hello' .and. var(2) /= 'goodbye') call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/namelist_42.f90 b/gcc/testsuite/gfortran.dg/namelist_42.f90
new file mode 100644
index 000000000..f15914ff1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_42.f90
@@ -0,0 +1,48 @@
+! { dg-do run { target fd_truncate } }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+!
+! PR fortran/34427
+!
+! Check that namelists and the real values Inf, NaN, Infinity
+! properly coexist.
+!
+ PROGRAM TEST
+  IMPLICIT NONE
+  real , DIMENSION(11) ::foo 
+  integer :: infinity
+  NAMELIST /nl/ foo
+  NAMELIST /nl/ infinity
+  foo = -1.0
+  infinity = -1
+
+  open (10, status="scratch")
+! Works:
+  write (10,*) " &nl foo = 5, 5, 5, nan, infinity, infinity "
+  write (10,*)
+  write (10,*) "      = 1, /"
+  rewind (10)
+  READ (10, NML = nl)
+  close (10)
+
+  if(infinity /= 1) call abort()
+  if(any(foo(1:3) /= [5.0, 5.0, 5.0]) .or. .not.isnan(foo(4)) &
+     .or. foo(5) <= huge(foo) .or. any(foo(6:11) /= -1.0)) &
+    call abort()
+! Works too:
+  foo = -1.0
+  infinity = -1
+
+  open (10, status="scratch")
+  rewind (10)
+  write (10,'(a)') "&nl foo = 5, 5, 5, nan, infinity, infinity"
+  write (10,'(a)') "=1,/"
+  rewind (10)
+  READ (10, NML = nl)
+  CLOSE (10)
+
+  if(infinity /= 1) call abort()
+  if(any(foo(1:3) /= [5.0, 5.0, 5.0]) .or. .not.isnan(foo(4)) &
+     .or. foo(5) <= huge(foo) .or. any(foo(6:11) /= -1.0)) &
+    call abort()
+ END PROGRAM TEST
diff --git a/gcc/testsuite/gfortran.dg/namelist_43.f90 b/gcc/testsuite/gfortran.dg/namelist_43.f90
new file mode 100644
index 000000000..d2f077e9c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_43.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+!
+! PR fortran/34427
+!
+! Check that namelists and the real values Inf, NaN, Infinity
+! properly coexist with interceding line ends and spaces.
+!
+PROGRAM TEST
+  IMPLICIT NONE
+  real , DIMENSION(10) ::foo 
+  integer :: infinity
+  integer :: numb
+  NAMELIST /nl/ foo
+  NAMELIST /nl/ infinity
+  foo = -1.0
+  infinity = -1
+
+  open (10, status="scratch")
+
+  write (10,'(a)') " &nl foo(1:6) = 5, 5, 5, nan, infinity"
+  write (10,'(a)')
+  write (10,'(a)')
+  write (10,'(a)')
+  write (10,'(a)')
+  write (10,'(a)') "infinity"
+  write (10,'(a)')
+  write (10,'(a)')
+  write (10,'(a)') "         "
+  write (10,'(a)')
+  write (10,'(a)')
+  write (10,'(a)')
+  write (10,'(a)')
+  write (10,'(a)')
+  write (10,'(a)')
+  write (10,'(a)')
+  write (10,'(a)')
+  write (10,'(a)') "=1/"
+  rewind (10)
+  READ (10, NML = nl)
+  CLOSE (10)
+  if(infinity /= 1) call abort
+  if(any(foo(1:3) /= [5.0, 5.0, 5.0]) .or. .not.isnan(foo(4)) &
+     .or. (foo(5) <= huge(foo)) .or. any(foo(6:10) /= -1.0)) &
+    call abort
+END PROGRAM TEST
diff --git a/gcc/testsuite/gfortran.dg/namelist_44.f90 b/gcc/testsuite/gfortran.dg/namelist_44.f90
new file mode 100644
index 000000000..143990261
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_44.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+!
+! PR fortran/34530
+!
+! Skipping over comment line was not working
+!
+! Test case contributed by Harald Anlauf.
+!
+program gfcbug77
+  implicit none
+
+  character(len=128) :: file = ""
+  logical            :: default
+  namelist /BLACKLIST/ file, default
+  integer, parameter :: nnml = 10
+  default = .true.
+
+  open (nnml, file='gfcbug77.nml')
+  write(nnml,*) "&blacklist "           ! The trailing space breaks gfortran
+  write(nnml,*) "  ! This is a comment within the namelist"
+  write(nnml,*) "  file    = 'myfile'"
+  write(nnml,*) "  default = F"
+  write(nnml,*) "/"
+  rewind(nnml)
+  read (nnml, nml=BLACKLIST)
+  close(nnml,status="delete")
+  if(file /= "myfile" .or. default) call abort()
+!  write (*,nml=BLACKLIST)
+end program gfcbug77
diff --git a/gcc/testsuite/gfortran.dg/namelist_45.f90 b/gcc/testsuite/gfortran.dg/namelist_45.f90
new file mode 100644
index 000000000..3512d08b7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_45.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR35617 read namelist error with '!'
+program test
+  character(len=128) :: mhdpath
+  namelist /nbdrive_naml/ mhdpath
+  open(10, file='test.nml')
+  
+  write(10,'(a)') "&nbdrive_naml"
+  write(10,'(a)') 
+  write(10,'(a)') "!nstep_stop = 2  ! uncomment to bar"
+  write(10,'(a)') "!nstep_start = 2 ! uncomment to foo"
+  write(10,'(a)') " mhdpath = 'mypath.dat'"
+  write(10,'(a)') "/"
+
+  rewind(10)
+  read(10, nbdrive_naml)
+  close(10,status="delete")
+end program test
diff --git a/gcc/testsuite/gfortran.dg/namelist_46.f90 b/gcc/testsuite/gfortran.dg/namelist_46.f90
new file mode 100644
index 000000000..0f048cf21
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_46.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! PR35627 Namelist read problem with short logical followed by read real
+program test
+  implicit none
+    LOGICAL :: nlco(200)  ! (1:nbeam)
+    REAL(kind=8):: xlbtna(200)  ! (1:nbeam)
+  NAMELIST/nbdrive_naml/ nlco, xlbtna
+    INTEGER :: nbshapa(200)  ! (1:nbeam)
+  NAMELIST/nbdrive_naml/ nbshapa
+  nlco = .false.
+  xlbtna = 0.0_8
+  nbshapa = 0
+  open(10, file='t.nml')
+  write(10,'(a)') "&nbdrive_naml"
+  write(10,'(a)') "nlco = 4*T,"
+  write(10,'(a)') "xlbtna = 802.8, 802.8, 802.8, 802.8"
+  write(10,'(a)') "nbshapa = 4*1"
+  write(10,'(a)') "/"
+  rewind(10)
+  read(10, nbdrive_naml)
+  !write(*,nbdrive_naml)
+  close(10, status="delete")
+end program test
diff --git a/gcc/testsuite/gfortran.dg/namelist_47.f90 b/gcc/testsuite/gfortran.dg/namelist_47.f90
new file mode 100644
index 000000000..581924720
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_47.f90
@@ -0,0 +1,52 @@
+! { dg-do run }
+
+module nml_47
+  type             ::  mt
+    character(len=2) ::  c012345678901234567890123456789012345678901234567890123456789h(2) = (/"aa","bb"/)
+  end type mt
+  type             ::  bt
+    integer        ::  i(2) = (/1,2/)
+    type(mt)       ::  m(2)
+  end type bt
+end module nml_47
+
+program namelist_47
+  use nml_47
+  type(bt)         ::  x(2)
+  character(140)    ::  teststring
+  namelist /mynml/ x
+
+  teststring = " x(2)%m%c012345678901234567890123456789012345678901234567890123456789h(:)(2:2) = 'z','z',"
+  call writenml (teststring)
+  teststring = " x(2)%m(2)%c012345678901234567890123456789012345678901234567890123456789h(:)(2) = 'z','z',"
+  call writenml (teststring)
+  teststring = " x(2)%m(2)%c012345678901234567890123456789012345678901234567890123456789h(:)(:3) = 'z','z',"
+  call writenml (teststring)
+  teststring = " x(2)%m(2)%c012345678901234567890123456789012345678901234567890123456789h(1:2)(k:) = 'z','z',"
+  call writenml (teststring)
+
+contains
+
+subroutine writenml (astring)
+  character(140), intent(in)  :: astring
+  character(300)   :: errmessage
+  integer          :: ierror
+
+  open (10, status="scratch", delim='apostrophe')
+  write (10, '(A)') "&MYNML"
+  write (10, '(A)') astring
+  write (10, '(A)') "/"
+  rewind (10)
+  read (10, nml = mynml, iostat=ierror, iomsg=errmessage)
+  if (ierror == 0) call abort
+  print '(a)', trim(errmessage)
+  close (10)
+
+end subroutine writenml
+
+end program namelist_47
+! { dg-output "Multiple sub-objects with non-zero rank in namelist object x%m%c012345678901234567890123456789012345678901234567890123456789h(\n|\r\n|\r)" }
+! { dg-output "Missing colon in substring qualifier for namelist variable x%m%c012345678901234567890123456789012345678901234567890123456789h(\n|\r\n|\r)" }
+! { dg-output "Substring out of range for namelist variable x%m%c012345678901234567890123456789012345678901234567890123456789h(\n|\r\n|\r)" }
+! { dg-output "Bad character in substring qualifier for namelist variable x%m%c012345678901234567890123456789012345678901234567890123456789h(\n|\r\n|\r)" }
+! { dg-final { cleanup-modules "nml_47" } }
diff --git a/gcc/testsuite/gfortran.dg/namelist_48.f90 b/gcc/testsuite/gfortran.dg/namelist_48.f90
new file mode 100644
index 000000000..e9a29285b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_48.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+! PR36538 namelist failure with tabs preceding object name
+      program check1
+      integer x
+      namelist/casein/x
+      open(1, status="scratch")
+      write(1,'(a)') "&CASEIN"	
+      write(1,'(a)') "\t\tx = 1"
+      write(1,'(a)') "/"
+      rewind(1)
+      x = 0
+      read(1,casein)
+      if (x.ne.1) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/namelist_49.f90 b/gcc/testsuite/gfortran.dg/namelist_49.f90
new file mode 100644
index 000000000..aec83eea9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_49.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+! PR36546 Namelist error with tab following a comma and newline
+      program check1
+      real a,b,c
+      namelist/CASEDAT/A,B,C
+      open(1, status="scratch")
+      write(1,'(a)') "&CASEDAT"
+      write(1,'(a)') "\t\tA = 1.0,\t\tB = 2.0,"
+      write(1,'(a)') "\t\tC = 3.0,"
+      write(1,'(a)') " /"
+      rewind(1)
+      a = 0.0
+      b = 0.0
+      c = 0.0
+      read(1,casedat)
+      if ((a.ne.1.0) .or. (b.ne.2.0) .or. (c.ne.3.0)) call abort
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/namelist_5.f90 b/gcc/testsuite/gfortran.dg/namelist_5.f90
new file mode 100644
index 000000000..4fcf9ae66
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_5.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! Tests the fix for PR25054 in which namelist objects with non-constant
+! shape were allowed.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+SUBROUTINE S1(I)
+ integer :: a,b(I)
+ NAMELIST /NLIST/ a,b ! { dg-error "with nonconstant shape" }
+ a=1 ; b=2
+ write(6,NML=NLIST)
+END SUBROUTINE S1
+END
diff --git a/gcc/testsuite/gfortran.dg/namelist_50.f90 b/gcc/testsuite/gfortran.dg/namelist_50.f90
new file mode 100644
index 000000000..57e93fcbf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_50.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! PR36657 Namelist string constant immediately followed by comment
+program gfcbug79
+  implicit none
+  integer, parameter :: nnml = 10
+  character(len=8)  :: model = ""
+  namelist /NML/       model
+  open (nnml, status="scratch")
+  write(nnml,*) "&nml! This is a just comment"
+  write(nnml,*) "  model='foo'! This is a just comment"
+  write(nnml,*) "/"
+  rewind(nnml)
+  read (nnml, nml=NML)
+  if (model /= 'foo') call abort
+  close(nnml)
+end program gfcbug79
diff --git a/gcc/testsuite/gfortran.dg/namelist_51.f90 b/gcc/testsuite/gfortran.dg/namelist_51.f90
new file mode 100644
index 000000000..9663bd68d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_51.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! PR36676 Namelist comment problems
+! test case from PR, reduced by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program mem_nml
+    implicit none
+    integer, save :: nxc
+    nxc = 0
+    call readNamelist()
+contains
+subroutine readNamelist()
+implicit none
+namelist /INPUT/    nxc
+open(unit = 101, status="scratch")
+write(101,'(a)')"&INPUT"
+write(101,'(a)')""
+write(101,'(a)')"!"
+write(101,'(a)')"!"
+write(101,'(a)')"!"
+write(101,'(a)')"nxc = 100"
+write(101,'(a)')"&END"
+rewind(101)
+read(unit = 101, nml = INPUT)
+if (nxc /= 100) call abort
+close(unit = 101)
+endsubroutine
+end program mem_nml
+
diff --git a/gcc/testsuite/gfortran.dg/namelist_52.f90 b/gcc/testsuite/gfortran.dg/namelist_52.f90
new file mode 100644
index 000000000..6e3138292
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_52.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! PR36582 Namelist I/O error: Bogus "Cannot match namelist object"
+! Test case derived from PR.
+module mod1
+
+type screen_io_type
+integer :: begin
+end type screen_io_type
+
+type adjoint_type
+type(screen_io_type) :: screen_io_fs_ntime
+character(12) :: solver_type
+end type adjoint_type
+
+type(adjoint_type) :: adjoint
+namelist/info_adjoint/adjoint
+
+end module mod1
+
+program gfortran_error_2
+use mod1
+adjoint%solver_type = "abcdefghijkl"
+open(31,status='scratch')
+write(31, '(a)') "&info_adjoint"
+write(31, '(a)') "adjoint%solver_type = 'direct'"
+write(31, '(a)') "adjoint%screen_io_fs_ntime%begin = 42"
+write(31, '(a)') "/"
+rewind(31)
+read(31,nml=info_adjoint)
+if (adjoint%solver_type /= 'direct') call abort
+if (adjoint%screen_io_fs_ntime%begin /= 42) call abort
+end program gfortran_error_2
diff --git a/gcc/testsuite/gfortran.dg/namelist_53.f90 b/gcc/testsuite/gfortran.dg/namelist_53.f90
new file mode 100644
index 000000000..d4fdf574e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_53.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! PR36895 Namelist writing to internal files
+  character(30) :: line
+  namelist /stuff/ n
+  n = 123
+  line = ""
+  write(line,nml=stuff)
+  if (line.ne."&STUFF  N=        123,  /") call abort
+  end 
diff --git a/gcc/testsuite/gfortran.dg/namelist_54.f90 b/gcc/testsuite/gfortran.dg/namelist_54.f90
new file mode 100644
index 000000000..013326893
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_54.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR37707 Namelist read of array of derived type incorrect.
+type s
+   integer m
+   integer n
+end type s
+type(s) :: a(3)
+character*80 :: l = ' &namlis a%m=1,2, a%n=5,6, /'
+namelist /namlis/ a
+a%m=[87,88,89]
+a%n=[97,98,99]
+read(l,namlis)
+if (a(1)%m /= 1 .or. a(2)%m /= 2 .or. a(1)%n /= 5 .or. a(2)%n /= 6 .or. &
+  & a(3)%m /= 89 .or. a(3)%n /= 99) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/namelist_55.f90 b/gcc/testsuite/gfortran.dg/namelist_55.f90
new file mode 100644
index 000000000..9690d858d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_55.f90
@@ -0,0 +1,52 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR37707 Namelist read of array of derived type incorrect
+! Test case from PR, prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+TYPE geometry
+   INTEGER :: nlon,nlat,nlev,projection
+   INTEGER :: center,subcenter,process
+   REAL    :: west,south,east,north
+   REAL    :: dlon,dlat
+   REAL    :: polat,polon
+   REAL    :: lonc,latc
+   REAL    :: projlat,projlat2,projlon
+   CHARACTER(LEN=1) :: arakawa ='#'
+   INTEGER :: truncx,truncy   ! Spectral truncation
+   INTEGER :: cie             ! Flag fort CI (0), CIE gridpoint (1)
+                              ! or CIE spectral (-1)
+   INTEGER :: nlat_i,nlon_i   ! I length in Y and X direction
+   INTEGER :: nlat_e ,nlon_e  ! E length in Y and X direction
+   LOGICAL :: do_geo = .true.
+END TYPE geometry
+
+TYPE shortkey
+   INTEGER           :: PPP !  2. Parameter
+   INTEGER           :: NNN ! 12. Gridpoint or spectral field 0 = gridpoint, 1 = spectral
+   INTEGER           :: INTPM
+   CHARACTER(LEN=16) :: name
+END TYPE shortkey
+INTEGER, PARAMETER :: maxl       = 200  ! Maximum number of levels to be read from namelist
+INTEGER, PARAMETER :: max_atmkey = 10   ! Maximum number of extra fields in the
+
+REAL    :: ahalf(maxl),bhalf(maxl)
+TYPE (geometry) :: outgeo ; SAVE outgeo  ! Output geometry
+
+TYPE (shortkey) ::  atmkey(max_atmkey) ; SAVE atmkey
+TYPE (shortkey) :: mlevkey(max_atmkey) ; SAVE mlevkey
+
+character*600 :: l = " &NAMINTERP atmkey%ppp = 076,058,062,079, atmkey%nnn = 000,000,000,000, &
+                     & atmkey%name ='LIQUID_WATER','SOLID_WATER','SNOW','RAIN', OUTGEO%NLEV=10, &
+                     & AHALF=0.,1.,2.,3.,4.,5.,6.,7.,8.,9., BHALF=0.,1.,2.,3.,4.,5.,6.,7.,8.,9., /"
+
+namelist /naminterp/outgeo,ahalf,bhalf,atmkey
+print *, outgeo%nlev
+read(l,nml=naminterp)
+if (outgeo%nlev /= 10) call abort
+if (any(ahalf(1:10) .ne. [0.,1.,2.,3.,4.,5.,6.,7.,8.,9.])) call abort
+if (any(bhalf(1:10) .ne. [0.,1.,2.,3.,4.,5.,6.,7.,8.,9.])) call abort
+if (any(atmkey(1:4)%ppp .ne. [076,058,062,079])) call abort
+if (any(atmkey(1:4)%nnn .ne. [0,0,0,0])) call abort
+if (any(atmkey(1:4)%name .ne. ['LIQUID_WATER','SOLID_WATER ','SNOW        ',&
+                              &'RAIN        '])) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/namelist_56.f90 b/gcc/testsuite/gfortran.dg/namelist_56.f90
new file mode 100644
index 000000000..658d12f6f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_56.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! PR37707 Namelist read of array of derived type incorrect
+! Test case from Tobias Burnus
+  IMPLICIT NONE
+  integer :: j
+  character(len=5) :: str(4)
+  character(len=900) :: nlstr
+  namelist /nml/ str, j
+  str = ''
+  j = -42
+  nlstr = '&nml str = "a", "b", "cde", j = 5 /'
+  read(nlstr,nml)
+  open(99, status="scratch")
+  write(99,nml)
+  rewind(99)
+  j = -54
+  str = 'XXXX'
+  read(99,nml)
+  if (j.ne.5) call abort
+  if (any(str.ne.["a    ","b    ","cde  ","     "])) call abort
+  close(99)
+end
diff --git a/gcc/testsuite/gfortran.dg/namelist_57.f90 b/gcc/testsuite/gfortran.dg/namelist_57.f90
new file mode 100644
index 000000000..7db4c4bb8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_57.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! PR37294 Namelist I/O to array character internal units.
+! Test case from adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+  character(30) :: line(3)
+  namelist /stuff/ n
+  n = 123
+  line = ""
+  write(line,nml=stuff)
+  if (line(1) .ne. "&STUFF") call abort
+  if (line(2) .ne. " N=        123,") call abort
+  if (line(3) .ne. " /") call abort
+  end 
diff --git a/gcc/testsuite/gfortran.dg/namelist_58.f90 b/gcc/testsuite/gfortran.dg/namelist_58.f90
new file mode 100644
index 000000000..fcce01653
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_58.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! PR40853 Error in namelist IO.
+! Test case derived from example given in PR. < jvdelisle@gcc.gnu.org >
+program test
+  implicit none
+  type tao_title_struct
+    character(2) justify   
+  end type
+  type tao_plot_page_struct
+    real shape_height_max 
+    type (tao_title_struct) title ! Comment this line out and the bug goes away.
+    real size(2)
+  end type
+  type (tao_plot_page_struct) plot_page
+  namelist / params / plot_page
+  open (10, status="scratch")
+  write(10,'(a)')"  &params"
+  write(10,'(a)')"  plot_page%size=5 , 2,"
+  write(10,'(a)')"/"
+  rewind(10)
+  read (10, nml = params)
+  if (any(plot_page%size .ne. (/ 5, 2 /))) call abort
+  close (10)
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/namelist_59.f90 b/gcc/testsuite/gfortran.dg/namelist_59.f90
new file mode 100644
index 000000000..bb68b9beb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_59.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! PR41192 NAMELIST input with just a comment ("&NAME ! comment \") error 
+program cmdline
+! comment by itself causes error in gfortran
+   call process(' ')
+   call process('i=10 , j=20 k=30 ! change all three values')
+   call process(' ')
+   call process('! change no values')! before patch this failed.
+end program cmdline
+
+subroutine process(string)
+ implicit none
+ character(len=*) :: string
+ character(len=132) :: lines(3)
+ character(len=255) :: message
+ integer :: i=1,j=2,k=3
+ integer ios
+ namelist /cmd/ i,j,k
+ save cmd
+ lines(1)='&cmd'
+ lines(2)=string
+ lines(3)='/'
+
+ read(lines,nml=cmd,iostat=ios,iomsg=message)
+ if (ios.ne.0) call abort
+end subroutine process
diff --git a/gcc/testsuite/gfortran.dg/namelist_60.f90 b/gcc/testsuite/gfortran.dg/namelist_60.f90
new file mode 100644
index 000000000..5cab78b8c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_60.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! PR42901  Reading array of structures from namelist
+! Test case derived from the reporters test case.
+program test_nml
+type field_descr
+  integer number
+end type
+type fsetup
+  type (field_descr), dimension(3) :: vel ! 3 velocity components
+end type
+type (fsetup) field_setup
+namelist /nl_setup/ field_setup
+field_setup%vel%number = 0
+! write(*,nml=nl_setup)
+open(10, status="scratch")
+write(10,'(a)') "&nl_setup"
+write(10,'(a)') " field_setup%vel(1)%number=  3,"
+write(10,'(a)') " field_setup%vel(2)%number=  9,"
+write(10,'(a)') " field_setup%vel(3)%number=  27,"
+write(10,'(a)') "/"
+rewind(10)
+read(10,nml=nl_setup)
+if (field_setup%vel(1)%number .ne. 3) call abort
+if (field_setup%vel(2)%number .ne. 9) call abort
+if (field_setup%vel(3)%number .ne. 27) call abort
+! write(*,nml=nl_setup)
+end program test_nml
diff --git a/gcc/testsuite/gfortran.dg/namelist_61.f90 b/gcc/testsuite/gfortran.dg/namelist_61.f90
new file mode 100644
index 000000000..c7214dd2b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_61.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+!
+! PR fortran/43228
+!
+integer :: a(3,3)
+character(len=100) :: str
+namelist /nml/a
+
+a = -1
+str = '&nml a(1,:) = 1 2 3 /'
+read(str, nml=nml)
+if (any (a(1,:) /= [1, 2, 3])) call abort ()
+if (any (a([2,3],:) /= -1)) call abort ()
+
+a = -1
+str = '&nml a(1,1) = 1 2 3 4 /'
+read(str, nml=nml)
+if (any (a(:,1) /= [1, 2, 3])) call abort ()
+if (any (a(:,2) /= [4, -1, -1])) call abort ()
+if (any (a(:,3) /= -1)) call abort ()
+
+str = '&nml a(1,:) = 1 2 3 , &
+       &    a(2,:) = 4,5,6 &
+       &    a(3,:) = 7 8 9/'
+read(str, nml=nml)
+if (any (a(1,:) /= [1, 2, 3])) call abort ()
+if (any (a(2,:) /= [4, 5, 6])) call abort ()
+if (any (a(3,:) /= [7, 8, 9])) call abort ()
+
+!print *, a(:,1)
+!print *, a(:,2)
+!print *, a(:,3)
+end
+
+
diff --git a/gcc/testsuite/gfortran.dg/namelist_62.f90 b/gcc/testsuite/gfortran.dg/namelist_62.f90
new file mode 100644
index 000000000..23e256207
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_62.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+!
+! PR fortran/45066
+!
+! Contributed by Michael Richmond.
+!
+! Was failing due to a -fwhole-file bug.
+!
+
+MODULE GA_commons
+  INTEGER :: nichflg(2)
+END MODULE GA_commons
+
+PROGRAM gafortran
+  USE GA_commons
+  NAMELIST /ga/ nichflg
+  READ (23, nml=ga)
+END PROGRAM gafortran
+
+! { dg-final { cleanup-modules "ga_commons" } }
diff --git a/gcc/testsuite/gfortran.dg/namelist_63.f90 b/gcc/testsuite/gfortran.dg/namelist_63.f90
new file mode 100644
index 000000000..021017403
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_63.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR fortran/45530
+!
+! Contributed by david.sagan@gmail.com
+!
+program test
+implicit none
+
+type c_struct
+  type (g_struct), pointer :: g
+end type
+
+type g_struct
+  type (p_struct), pointer :: p
+end type
+
+type p_struct
+  type (region_struct), pointer :: r
+end type
+
+type region_struct
+  type (p_struct) plot
+end type
+
+type (c_struct) curve(10)
+namelist / params / curve ! { dg-error "ALLOCATABLE or POINTER components and thus requires a defined input/output" }
+end program
diff --git a/gcc/testsuite/gfortran.dg/namelist_64.f90 b/gcc/testsuite/gfortran.dg/namelist_64.f90
new file mode 100644
index 000000000..b5084e0f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_64.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! PR45532 gfortran namelist read error.
+! Derived from the original test case by David Sagan.
+program test
+implicit none
+type line_struct
+  integer :: width = 10
+end type
+type symbol_struct
+  integer :: typee = 313233
+end type
+type curve_struct
+  type (line_struct) line
+  type (symbol_struct) symbol
+end type
+type (curve_struct) curve(10)
+namelist / params / curve
+!
+open (10, status="scratch")
+write(10,*) "&params"
+write(10,*) " curve(1)%symbol%typee = 1234"
+write(10,*) "/"
+rewind(10)
+read (10, nml = params)
+if (curve(1)%symbol%typee /= 1234) call abort
+close(10)
+end program
diff --git a/gcc/testsuite/gfortran.dg/namelist_65.f90 b/gcc/testsuite/gfortran.dg/namelist_65.f90
new file mode 100644
index 000000000..6ef8ca493
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_65.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+! PR45710 Adjust format/padding for WRITE of NAMELIST group to internal file
+program oneline
+real :: a=1,b=2,c=3,d=4
+namelist /nl1/ a,b,c
+parameter(ilines=5)
+character(len=80) :: out(ilines)
+
+! fill array out with @
+do i=1,len(out)
+   out(:)(i:i)='@'
+enddo
+
+write(out,nl1)
+if (out(1).ne."&NL1") call abort
+if (out(2).ne." A=  1.0000000    ,") call abort
+if (out(3).ne." B=  2.0000000    ,") call abort
+if (out(4).ne." C=  3.0000000    ,") call abort
+if (out(5).ne." /") call abort
+
+end program oneline
diff --git a/gcc/testsuite/gfortran.dg/namelist_66.f90 b/gcc/testsuite/gfortran.dg/namelist_66.f90
new file mode 100644
index 000000000..912261b4d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_66.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! PR46010 Failure to read these two examples of namelists
+type ptracer
+   character(len = 2)  :: sname
+   logical              :: lini
+end type ptracer
+type(ptracer) , dimension(3) :: tracer
+namelist/naml1/  tracer
+
+type qptracer
+   character(len = 20)  :: sname  = ""!: short name
+   character(len = 45 ) :: lname  = ""!: long name
+   character(len = 20 ) :: sunit  = "" !: unit
+   logical              :: lini   !: read in a file or not
+   logical              :: lsav   !: ouput the tracer or not 
+end type qptracer
+type(qptracer) , dimension(3) :: qtracer
+namelist/naml2/  qtracer
+
+open (99, file='nml.dat', status="replace")
+write(99,*) "&naml1"
+write(99,*) "   tracer(1)   = 'aa', .true."
+write(99,*) "   tracer(2)   = 'bb', .true."
+write(99,*) "   tracer(3)   = 'cc', .true."
+write(99,*) "/"
+rewind(99)
+read (99, nml=naml1)
+write (*, nml=naml1)
+rewind(99)
+write(99,*) "&naml2     !   just some stuff"
+write(99,*) "   qtracer(1)   = 'dic     ' , 'dissolved inorganic concentration      ',  'mol-c/l' ,  .true.     ,  .true.,"
+write(99,*) "   qtracer(2)   = 'alkalini' , 'total alkalinity concentration         ',  'eq/l '   ,  .true.     ,  .true.,"
+write(99,*) "/"
+rewind(99)
+read (99, nml=naml2)
+write (*, nml=naml2)
+rewind(99)
+
+close (99, status="delete")
+end
diff --git a/gcc/testsuite/gfortran.dg/namelist_67.f90 b/gcc/testsuite/gfortran.dg/namelist_67.f90
new file mode 100644
index 000000000..6adbd93a0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_67.f90
@@ -0,0 +1,10 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+
+  character(35) :: nml_contents = "&NMLIST NML_STRING='123456789' /"
+  character(4)  :: nml_string
+  namelist /nmlist/ nml_string
+  nml_string = "abcd"
+  read(nml_contents,nml=nmlist)
+end program 
+! { dg-output "Fortran runtime warning: Namelist object 'nml_string' truncated on read." }
diff --git a/gcc/testsuite/gfortran.dg/namelist_68.f90 b/gcc/testsuite/gfortran.dg/namelist_68.f90
new file mode 100644
index 000000000..903f9fbbc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_68.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! PR47154 END= does not work in namelist read
+      program foo
+      real :: a
+      namelist /b/a
+      open(10,status="scratch")
+      read (10,nml=b,end=100)
+ 100  continue
+      end
diff --git a/gcc/testsuite/gfortran.dg/namelist_69.f90 b/gcc/testsuite/gfortran.dg/namelist_69.f90
new file mode 100644
index 000000000..6261aabcf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_69.f90
@@ -0,0 +1,233 @@
+! { dg-do run }
+!
+! PR fortran/47339
+! PR fortran/43062
+!
+! Run-time test for Fortran 2003 NAMELISTS
+! Version for non-strings
+!
+program nml_test
+  implicit none
+
+  character(len=1000) :: str
+
+  integer, allocatable :: a(:)
+  integer, allocatable :: b
+  integer, pointer :: ap(:)
+  integer, pointer :: bp
+  integer :: c
+  integer :: d(3)
+
+  type t
+    integer :: c1
+    integer :: c2(3)
+  end type t
+  type(t) :: e,f(2)
+  type(t),allocatable :: g,h(:)
+  type(t),pointer :: i,j(:)
+
+  namelist /nml/ a, b, c, d, ap, bp,e,f,g,h,i,j
+
+  a = [1,2]
+  allocate(b,ap(2),bp)
+  ap = [98, 99]
+  b = 7
+  bp = 101
+  c = 8
+  d = [-1, -2, -3]
+
+  e%c1 = -701
+  e%c2 = [-702,-703,-704]
+  f(1)%c1 = 33001
+  f(2)%c1 = 33002
+  f(1)%c2 = [44001,44002,44003]
+  f(2)%c2 = [44011,44012,44013]
+
+  allocate(g,h(2),i,j(2))
+
+  g%c1 = -601
+  g%c2 = [-602,6703,-604]
+  h(1)%c1 = 35001
+  h(2)%c1 = 35002
+  h(1)%c2 = [45001,45002,45003]
+  h(2)%c2 = [45011,45012,45013]
+
+  i%c1 = -501
+  i%c2 = [-502,-503,-504]
+  j(1)%c1 = 36001
+  j(2)%c1 = 36002
+  j(1)%c2 = [46001,46002,46003]
+  j(2)%c2 = [46011,46012,46013]
+
+  ! SAVE NAMELIST
+  str = repeat('X', len(str))
+  write(str,nml=nml)
+
+  ! RESET NAMELIST
+  a = [-1,-1]
+  ap = [-1, -1]
+  b = -1
+  bp = -1
+  c = -1
+  d = [-1, -1, -1]
+
+  e%c1 = -1
+  e%c2 = [-1,-1,-1]
+  f(1)%c1 = -1
+  f(2)%c1 = -1
+  f(1)%c2 = [-1,-1,-1]
+  f(2)%c2 = [-1,-1,-1]
+
+  g%c1 = -1
+  g%c2 = [-1,-1,-1]
+  h(1)%c1 = -1
+  h(2)%c1 = -1
+  h(1)%c2 = [-1,-1,-1]
+  h(2)%c2 = [-1,-1,-1]
+
+  i%c1 = -1
+  i%c2 = [-1,-1,-1]
+  j(1)%c1 = -1
+  j(2)%c1 = -1
+  j(1)%c2 = [-1,-1,-1]
+  j(2)%c2 = [-1,-1,-1]
+
+  ! Read back
+  read(str,nml=nml)
+
+  ! Check result
+  if (any (a /= [1,2])) call abort()
+  if (any (ap /= [98, 99])) call abort()
+  if (b /= 7) call abort()
+  if (bp /= 101) call abort()
+  if (c /= 8) call abort()
+  if (any (d /= [-1, -2, -3])) call abort()
+
+  if (e%c1 /= -701) call abort()
+  if (any (e%c2 /= [-702,-703,-704])) call abort()
+  if (f(1)%c1 /= 33001) call abort()
+  if (f(2)%c1 /= 33002) call abort()
+  if (any (f(1)%c2 /= [44001,44002,44003])) call abort()
+  if (any (f(2)%c2 /= [44011,44012,44013])) call abort()
+
+  if (g%c1 /= -601) call abort()
+  if (any(g%c2 /= [-602,6703,-604])) call abort()
+  if (h(1)%c1 /= 35001) call abort()
+  if (h(2)%c1 /= 35002) call abort()
+  if (any (h(1)%c2 /= [45001,45002,45003])) call abort()
+  if (any (h(2)%c2 /= [45011,45012,45013])) call abort()
+
+  if (i%c1 /= -501) call abort()
+  if (any (i%c2 /= [-502,-503,-504])) call abort()
+  if (j(1)%c1 /= 36001) call abort()
+  if (j(2)%c1 /= 36002) call abort()
+  if (any (j(1)%c2 /= [46001,46002,46003])) call abort()
+  if (any (j(2)%c2 /= [46011,46012,46013])) call abort()
+
+  ! Check argument passing (dummy processing)
+  call test2(a,b,c,d,ap,bp,e,f,g,h,i,j,2) 
+
+contains
+  subroutine test2(x1,x2,x3,x4,x1p,x2p,x6,x7,x8,x9,x10,x11,n)
+    integer, allocatable :: x1(:)
+    integer, allocatable :: x2
+    integer, pointer :: x1p(:)
+    integer, pointer :: x2p
+    integer :: x3
+    integer :: x4(3)
+    integer :: n
+    integer :: x5(n)
+    type(t) :: x6,x7(2)
+    type(t),allocatable :: x8,x9(:)
+    type(t),pointer :: x10,x11(:)
+    type(t) :: x12(n)
+
+    namelist /nml2/ x1, x2, x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12
+
+    x5 = [ 42, 53 ]
+
+    x12(1)%c1 = 37001
+    x12(2)%c1 = 37002
+    x12(1)%c2 = [47001,47002,47003]
+    x12(2)%c2 = [47011,47012,47013]
+
+    ! SAVE NAMELIST
+    str = repeat('X', len(str))
+    write(str,nml=nml2)
+
+    ! RESET NAMELIST
+    x1 = [-1,-1]
+    x1p = [-1, -1]
+    x2 = -1
+    x2p = -1
+    x3 = -1
+    x4 = [-1, -1, -1]
+
+    x6%c1 = -1
+    x6%c2 = [-1,-1,-1]
+    x7(1)%c1 = -1
+    x7(2)%c1 = -1
+    x7(1)%c2 = [-1,-1,-1]
+    x7(2)%c2 = [-1,-1,-1]
+
+    x8%c1 = -1
+    x8%c2 = [-1,-1,-1]
+    x9(1)%c1 = -1
+    x9(2)%c1 = -1
+    x9(1)%c2 = [-1,-1,-1]
+    x9(2)%c2 = [-1,-1,-1]
+
+    x10%c1 = -1
+    x10%c2 = [-1,-1,-1]
+    x11(1)%c1 = -1
+    x11(2)%c1 = -1
+    x11(1)%c2 = [-1,-1,-1]
+    x11(2)%c2 = [-1,-1,-1]
+
+    x5 = [ -1, -1 ]
+
+    x12(1)%c1 = -1
+    x12(2)%c1 = -1
+    x12(1)%c2 = [-1,-1,-1]
+    x12(2)%c2 = [-1,-1,-1]
+
+    ! Read back
+    read(str,nml=nml2)
+
+    ! Check result
+    if (any (x1 /= [1,2])) call abort()
+    if (any (x1p /= [98, 99])) call abort()
+    if (x2 /= 7) call abort()
+    if (x2p /= 101) call abort()
+    if (x3 /= 8) call abort()
+    if (any (x4 /= [-1, -2, -3])) call abort()
+
+    if (x6%c1 /= -701) call abort()
+    if (any (x6%c2 /= [-702,-703,-704])) call abort()
+    if (x7(1)%c1 /= 33001) call abort()
+    if (x7(2)%c1 /= 33002) call abort()
+    if (any (x7(1)%c2 /= [44001,44002,44003])) call abort()
+    if (any (x7(2)%c2 /= [44011,44012,44013])) call abort()
+
+    if (x8%c1 /= -601) call abort()
+    if (any(x8%c2 /= [-602,6703,-604])) call abort()
+    if (x9(1)%c1 /= 35001) call abort()
+    if (x9(2)%c1 /= 35002) call abort()
+    if (any (x9(1)%c2 /= [45001,45002,45003])) call abort()
+    if (any (x9(2)%c2 /= [45011,45012,45013])) call abort()
+
+    if (x10%c1 /= -501) call abort()
+    if (any (x10%c2 /= [-502,-503,-504])) call abort()
+    if (x11(1)%c1 /= 36001) call abort()
+    if (x11(2)%c1 /= 36002) call abort()
+    if (any (x11(1)%c2 /= [46001,46002,46003])) call abort()
+    if (any (x11(2)%c2 /= [46011,46012,46013])) call abort()
+
+    if (any (x5 /= [ 42, 53 ])) call abort()
+
+    if (x12(1)%c1 /= 37001) call abort()
+    if (x12(2)%c1 /= 37002) call abort()
+    if (any (x12(1)%c2 /= [47001,47002,47003])) call abort()
+    if (any (x12(2)%c2 /= [47011,47012,47013])) call abort()
+  end subroutine test2
+end program nml_test
diff --git a/gcc/testsuite/gfortran.dg/namelist_70.f90 b/gcc/testsuite/gfortran.dg/namelist_70.f90
new file mode 100644
index 000000000..f3edfc50c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_70.f90
@@ -0,0 +1,442 @@
+! { dg-do run }
+!
+! PR fortran/47339
+! PR fortran/43062
+!
+! Run-time test for Fortran 2003 NAMELISTS
+! Version for non-strings
+!
+program nml_test
+  implicit none
+
+  character(len=1000) :: str
+
+  character(len=5), allocatable :: a(:)
+  character(len=5), allocatable :: b
+  character(len=5), pointer :: ap(:)
+  character(len=5), pointer :: bp
+  character(len=5) :: c
+  character(len=5) :: d(3)
+
+  type t
+    character(len=5) :: c1
+    character(len=5) :: c2(3)
+  end type t
+  type(t) :: e,f(2)
+  type(t),allocatable :: g,h(:)
+  type(t),pointer :: i,j(:)
+
+  namelist /nml/ a, b, c, d, ap, bp,e,f,g,h,i,j
+
+  a = ["aa01", "aa02"]
+  allocate(b,ap(2),bp)
+  ap = ['98', '99']
+  b = '7'
+  bp = '101'
+  c = '8'
+  d = ['-1', '-2', '-3']
+
+  e%c1 = '-701'
+  e%c2 = ['-702','-703','-704']
+  f(1)%c1 = '33001'
+  f(2)%c1 = '33002'
+  f(1)%c2 = ['44001','44002','44003']
+  f(2)%c2 = ['44011','44012','44013']
+
+  allocate(g,h(2),i,j(2))
+
+  g%c1 = '-601'
+  g%c2 = ['-602','6703','-604']
+  h(1)%c1 = '35001'
+  h(2)%c1 = '35002'
+  h(1)%c2 = ['45001','45002','45003']
+  h(2)%c2 = ['45011','45012','45013']
+
+  i%c1 = '-501'
+  i%c2 = ['-502','-503','-504']
+  j(1)%c1 = '36001'
+  j(2)%c1 = '36002'
+  j(1)%c2 = ['46001','46002','46003']
+  j(2)%c2 = ['46011','46012','46013']
+
+  ! SAVE NAMELIST
+  str = repeat('X', len(str))
+  write(str,nml=nml)
+
+  ! RESET NAMELIST
+  a = repeat('X', len(a))
+  ap = repeat('X', len(ap))
+  b = repeat('X', len(b))
+  bp = repeat('X', len(bp))
+  c = repeat('X', len(c))
+  d = repeat('X', len(d))
+
+  e%c1 = repeat('X', len(e%c1))
+  e%c2 = repeat('X', len(e%c2))
+  f(1)%c1 = repeat('X', len(f(1)%c1))
+  f(2)%c1 = repeat('X', len(f(2)%c1))
+  f(1)%c2 = repeat('X', len(f(1)%c2))
+  f(2)%c2 = repeat('X', len(f(2)%c2))
+
+  g%c1 = repeat('X', len(g%c1))
+  g%c2 = repeat('X', len(g%c1))
+  h(1)%c1 = repeat('X', len(h(1)%c1))
+  h(2)%c1 = repeat('X', len(h(1)%c1))
+  h(1)%c2 = repeat('X', len(h(1)%c1))
+  h(2)%c2 = repeat('X', len(h(1)%c1))
+
+  i%c1 = repeat('X', len(i%c1))
+  i%c2 = repeat('X', len(i%c1))
+  j(1)%c1 = repeat('X', len(j(1)%c1))
+  j(2)%c1 = repeat('X', len(j(2)%c1))
+  j(1)%c2 = repeat('X', len(j(1)%c2))
+  j(2)%c2 = repeat('X', len(j(2)%c2))
+
+  ! Read back
+  read(str,nml=nml)
+
+  ! Check result
+  if (any (a /= ['aa01','aa02'])) call abort()
+  if (any (ap /= ['98', '99'])) call abort()
+  if (b /= '7') call abort()
+  if (bp /= '101') call abort()
+  if (c /= '8') call abort()
+  if (any (d /= ['-1', '-2', '-3'])) call abort()
+
+  if (e%c1 /= '-701') call abort()
+  if (any (e%c2 /= ['-702','-703','-704'])) call abort()
+  if (f(1)%c1 /= '33001') call abort()
+  if (f(2)%c1 /= '33002') call abort()
+  if (any (f(1)%c2 /= ['44001','44002','44003'])) call abort()
+  if (any (f(2)%c2 /= ['44011','44012','44013'])) call abort()
+
+  if (g%c1 /= '-601') call abort()
+  if (any(g%c2 /= ['-602','6703','-604'])) call abort()
+  if (h(1)%c1 /= '35001') call abort()
+  if (h(2)%c1 /= '35002') call abort()
+  if (any (h(1)%c2 /= ['45001','45002','45003'])) call abort()
+  if (any (h(2)%c2 /= ['45011','45012','45013'])) call abort()
+
+  if (i%c1 /= '-501') call abort()
+  if (any (i%c2 /= ['-502','-503','-504'])) call abort()
+  if (j(1)%c1 /= '36001') call abort()
+  if (j(2)%c1 /= '36002') call abort()
+  if (any (j(1)%c2 /= ['46001','46002','46003'])) call abort()
+  if (any (j(2)%c2 /= ['46011','46012','46013'])) call abort()
+
+  ! Check argument passing (dummy processing)
+  call test2(a,b,c,d,ap,bp,e,f,g,h,i,j,2) 
+  call test3(a,b,c,d,ap,bp,e,f,g,h,i,j,2,len(a)) 
+  call test4(a,b,c,d,ap,bp,e,f,g,h,i,j,2)
+
+contains
+  subroutine test2(x1,x2,x3,x4,x1p,x2p,x6,x7,x8,x9,x10,x11,n)
+    character(len=5), allocatable :: x1(:)
+    character(len=5), allocatable :: x2
+    character(len=5), pointer :: x1p(:)
+    character(len=5), pointer :: x2p
+    character(len=5) :: x3
+    character(len=5) :: x4(3)
+    integer :: n
+    character(len=5) :: x5(n)
+    type(t) :: x6,x7(2)
+    type(t),allocatable :: x8,x9(:)
+    type(t),pointer :: x10,x11(:)
+    type(t) :: x12(n)
+
+    namelist /nml2/ x1, x2, x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12
+
+    x5 = [ 'x5-42', 'x5-53' ]
+
+    x12(1)%c1 = '37001'
+    x12(2)%c1 = '37002'
+    x12(1)%c2 = ['47001','47002','47003']
+    x12(2)%c2 = ['47011','47012','47013']
+ 
+    ! SAVE NAMELIST
+    str = repeat('X', len(str))
+    write(str,nml=nml2)
+
+    ! RESET NAMELIST
+    x1 = repeat('X', len(x1))
+    x1p = repeat('X', len(x1p))
+    x2 = repeat('X', len(x2))
+    x2p = repeat('X', len(x2p))
+    x3 = repeat('X', len(x3))
+    x4 = repeat('X', len(x4))
+
+    x6%c1 = repeat('X', len(x6%c1))
+    x6%c2 = repeat('X', len(x6%c2))
+    x7(1)%c1 = repeat('X', len(x7(1)%c1))
+    x7(2)%c1 = repeat('X', len(x7(2)%c1))
+    x7(1)%c2 = repeat('X', len(x7(1)%c2))
+    x7(2)%c2 = repeat('X', len(x7(2)%c2))
+
+    x8%c1 = repeat('X', len(x8%c1))
+    x8%c2 = repeat('X', len(x8%c1))
+    x9(1)%c1 = repeat('X', len(x9(1)%c1))
+    x9(2)%c1 = repeat('X', len(x9(1)%c1))
+    x9(1)%c2 = repeat('X', len(x9(1)%c1))
+    x9(2)%c2 = repeat('X', len(x9(1)%c1))
+
+    x10%c1 = repeat('X', len(x10%c1))
+    x10%c2 = repeat('X', len(x10%c1))
+    x11(1)%c1 = repeat('X', len(x11(1)%c1))
+    x11(2)%c1 = repeat('X', len(x11(2)%c1))
+    x11(1)%c2 = repeat('X', len(x11(1)%c2))
+    x11(2)%c2 = repeat('X', len(x11(2)%c2))
+
+    x5 = repeat('X', len(x5))
+
+    x12(1)%c1 = repeat('X', len(x12(2)%c2))
+    x12(2)%c1 = repeat('X', len(x12(2)%c2))
+    x12(1)%c2 = repeat('X', len(x12(2)%c2))
+    x12(2)%c2 = repeat('X', len(x12(2)%c2))
+
+    ! Read back
+    read(str,nml=nml2)
+
+    ! Check result
+    if (any (x1 /= ['aa01','aa02'])) call abort()
+    if (any (x1p /= ['98', '99'])) call abort()
+    if (x2 /= '7') call abort()
+    if (x2p /= '101') call abort()
+    if (x3 /= '8') call abort()
+    if (any (x4 /= ['-1', '-2', '-3'])) call abort()
+
+    if (x6%c1 /= '-701') call abort()
+    if (any (x6%c2 /= ['-702','-703','-704'])) call abort()
+    if (x7(1)%c1 /= '33001') call abort()
+    if (x7(2)%c1 /= '33002') call abort()
+    if (any (x7(1)%c2 /= ['44001','44002','44003'])) call abort()
+    if (any (x7(2)%c2 /= ['44011','44012','44013'])) call abort()
+
+    if (x8%c1 /= '-601') call abort()
+    if (any(x8%c2 /= ['-602','6703','-604'])) call abort()
+    if (x9(1)%c1 /= '35001') call abort()
+    if (x9(2)%c1 /= '35002') call abort()
+    if (any (x9(1)%c2 /= ['45001','45002','45003'])) call abort()
+    if (any (x9(2)%c2 /= ['45011','45012','45013'])) call abort()
+ 
+    if (x10%c1 /= '-501') call abort()
+    if (any (x10%c2 /= ['-502','-503','-504'])) call abort()
+    if (x11(1)%c1 /= '36001') call abort()
+    if (x11(2)%c1 /= '36002') call abort()
+    if (any (x11(1)%c2 /= ['46001','46002','46003'])) call abort()
+    if (any (x11(2)%c2 /= ['46011','46012','46013'])) call abort()
+
+    if (any (x5 /= [ 'x5-42', 'x5-53' ])) call abort()
+
+    if (x12(1)%c1 /= '37001') call abort()
+    if (x12(2)%c1 /= '37002') call abort()
+    if (any (x12(1)%c2 /= ['47001','47002','47003'])) call abort()
+    if (any (x12(2)%c2 /= ['47011','47012','47013'])) call abort()
+  end subroutine test2
+
+  subroutine test3(x1,x2,x3,x4,x1p,x2p,x6,x7,x8,x9,x10,x11,n,ll)
+    integer :: n, ll
+    character(len=ll), allocatable :: x1(:)
+    character(len=ll), allocatable :: x2
+    character(len=ll), pointer :: x1p(:)
+    character(len=ll), pointer :: x2p
+    character(len=ll) :: x3
+    character(len=ll) :: x4(3)
+    character(len=ll) :: x5(n)
+    type(t) :: x6,x7(2)
+    type(t),allocatable :: x8,x9(:)
+    type(t),pointer :: x10,x11(:)
+    type(t) :: x12(n)
+
+   namelist /nml2/ x1, x2, x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12
+
+    x5 = [ 'x5-42', 'x5-53' ]
+
+    x12(1)%c1 = '37001'
+    x12(2)%c1 = '37002'
+    x12(1)%c2 = ['47001','47002','47003']
+    x12(2)%c2 = ['47011','47012','47013']
+ 
+    ! SAVE NAMELIST
+    str = repeat('X', len(str))
+    write(str,nml=nml2)
+
+    ! RESET NAMELIST
+    x1 = repeat('X', len(x1))
+    x1p = repeat('X', len(x1p))
+
+    x2 = repeat('X', len(x2))
+    x2p = repeat('X', len(x2p))
+    x3 = repeat('X', len(x3))
+    x4 = repeat('X', len(x4))
+
+    x6%c1 = repeat('X', len(x6%c1))
+    x6%c2 = repeat('X', len(x6%c2))
+    x7(1)%c1 = repeat('X', len(x7(1)%c1))
+    x7(2)%c1 = repeat('X', len(x7(2)%c1))
+    x7(1)%c2 = repeat('X', len(x7(1)%c2))
+    x7(2)%c2 = repeat('X', len(x7(2)%c2))
+
+    x8%c1 = repeat('X', len(x8%c1))
+    x8%c2 = repeat('X', len(x8%c1))
+    x9(1)%c1 = repeat('X', len(x9(1)%c1))
+    x9(2)%c1 = repeat('X', len(x9(1)%c1))
+    x9(1)%c2 = repeat('X', len(x9(1)%c1))
+    x9(2)%c2 = repeat('X', len(x9(1)%c1))
+
+    x10%c1 = repeat('X', len(x10%c1))
+    x10%c2 = repeat('X', len(x10%c1))
+    x11(1)%c1 = repeat('X', len(x11(1)%c1))
+    x11(2)%c1 = repeat('X', len(x11(2)%c1))
+    x11(1)%c2 = repeat('X', len(x11(1)%c2))
+    x11(2)%c2 = repeat('X', len(x11(2)%c2))
+
+    x5 = repeat('X', len(x5))
+
+    x12(1)%c1 = repeat('X', len(x12(2)%c2))
+    x12(2)%c1 = repeat('X', len(x12(2)%c2))
+    x12(1)%c2 = repeat('X', len(x12(2)%c2))
+    x12(2)%c2 = repeat('X', len(x12(2)%c2))
+
+    ! Read back
+    read(str,nml=nml2)
+
+    ! Check result
+    if (any (x1 /= ['aa01','aa02'])) call abort()
+    if (any (x1p /= ['98', '99'])) call abort()
+    if (x2 /= '7') call abort()
+    if (x2p /= '101') call abort()
+    if (x3 /= '8') call abort()
+    if (any (x4 /= ['-1', '-2', '-3'])) call abort()
+
+    if (x6%c1 /= '-701') call abort()
+    if (any (x6%c2 /= ['-702','-703','-704'])) call abort()
+    if (x7(1)%c1 /= '33001') call abort()
+    if (x7(2)%c1 /= '33002') call abort()
+    if (any (x7(1)%c2 /= ['44001','44002','44003'])) call abort()
+    if (any (x7(2)%c2 /= ['44011','44012','44013'])) call abort()
+
+    if (x8%c1 /= '-601') call abort()
+    if (any(x8%c2 /= ['-602','6703','-604'])) call abort()
+    if (x9(1)%c1 /= '35001') call abort()
+    if (x9(2)%c1 /= '35002') call abort()
+    if (any (x9(1)%c2 /= ['45001','45002','45003'])) call abort()
+    if (any (x9(2)%c2 /= ['45011','45012','45013'])) call abort()
+ 
+    if (x10%c1 /= '-501') call abort()
+    if (any (x10%c2 /= ['-502','-503','-504'])) call abort()
+    if (x11(1)%c1 /= '36001') call abort()
+    if (x11(2)%c1 /= '36002') call abort()
+    if (any (x11(1)%c2 /= ['46001','46002','46003'])) call abort()
+    if (any (x11(2)%c2 /= ['46011','46012','46013'])) call abort()
+
+    if (any (x5 /= [ 'x5-42', 'x5-53' ])) call abort()
+
+    if (x12(1)%c1 /= '37001') call abort()
+    if (x12(2)%c1 /= '37002') call abort()
+    if (any (x12(1)%c2 /= ['47001','47002','47003'])) call abort()
+    if (any (x12(2)%c2 /= ['47011','47012','47013'])) call abort()
+  end subroutine test3
+
+  subroutine test4(x1,x2,x3,x4,x1p,x2p,x6,x7,x8,x9,x10,x11,n)
+    character(len=*), allocatable :: x1(:)
+    character(len=*), allocatable :: x2
+    character(len=*), pointer :: x1p(:)
+    character(len=*), pointer :: x2p
+    character(len=*) :: x3
+    character(len=*) :: x4(3)
+    integer :: n
+    character(len=5) :: x5(n)
+    type(t) :: x6,x7(2)
+    type(t),allocatable :: x8,x9(:)
+    type(t),pointer :: x10,x11(:)
+    type(t) :: x12(n)
+
+    namelist /nml2/ x1, x2, x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12
+
+    x5 = [ 'x5-42', 'x5-53' ]
+
+    x12(1)%c1 = '37001'
+    x12(2)%c1 = '37002'
+    x12(1)%c2 = ['47001','47002','47003']
+    x12(2)%c2 = ['47011','47012','47013']
+ 
+    ! SAVE NAMELIST
+    str = repeat('X', len(str))
+    write(str,nml=nml2)
+
+    ! RESET NAMELIST
+    x1 = repeat('X', len(x1))
+    x1p = repeat('X', len(x1p))
+    x2 = repeat('X', len(x2))
+    x2p = repeat('X', len(x2p))
+    x3 = repeat('X', len(x3))
+    x4 = repeat('X', len(x4))
+
+    x6%c1 = repeat('X', len(x6%c1))
+    x6%c2 = repeat('X', len(x6%c2))
+    x7(1)%c1 = repeat('X', len(x7(1)%c1))
+    x7(2)%c1 = repeat('X', len(x7(2)%c1))
+    x7(1)%c2 = repeat('X', len(x7(1)%c2))
+    x7(2)%c2 = repeat('X', len(x7(2)%c2))
+
+    x8%c1 = repeat('X', len(x8%c1))
+    x8%c2 = repeat('X', len(x8%c1))
+    x9(1)%c1 = repeat('X', len(x9(1)%c1))
+    x9(2)%c1 = repeat('X', len(x9(1)%c1))
+    x9(1)%c2 = repeat('X', len(x9(1)%c1))
+    x9(2)%c2 = repeat('X', len(x9(1)%c1))
+
+    x10%c1 = repeat('X', len(x10%c1))
+    x10%c2 = repeat('X', len(x10%c1))
+    x11(1)%c1 = repeat('X', len(x11(1)%c1))
+    x11(2)%c1 = repeat('X', len(x11(2)%c1))
+    x11(1)%c2 = repeat('X', len(x11(1)%c2))
+    x11(2)%c2 = repeat('X', len(x11(2)%c2))
+
+    x5 = repeat('X', len(x5))
+
+    x12(1)%c1 = repeat('X', len(x12(2)%c2))
+    x12(2)%c1 = repeat('X', len(x12(2)%c2))
+    x12(1)%c2 = repeat('X', len(x12(2)%c2))
+    x12(2)%c2 = repeat('X', len(x12(2)%c2))
+
+    ! Read back
+    read(str,nml=nml2)
+
+    ! Check result
+    if (any (x1 /= ['aa01','aa02'])) call abort()
+    if (any (x1p /= ['98', '99'])) call abort()
+    if (x2 /= '7') call abort()
+    if (x2p /= '101') call abort()
+    if (x3 /= '8') call abort()
+    if (any (x4 /= ['-1', '-2', '-3'])) call abort()
+
+    if (x6%c1 /= '-701') call abort()
+    if (any (x6%c2 /= ['-702','-703','-704'])) call abort()
+    if (x7(1)%c1 /= '33001') call abort()
+    if (x7(2)%c1 /= '33002') call abort()
+    if (any (x7(1)%c2 /= ['44001','44002','44003'])) call abort()
+    if (any (x7(2)%c2 /= ['44011','44012','44013'])) call abort()
+
+    if (x8%c1 /= '-601') call abort()
+    if (any(x8%c2 /= ['-602','6703','-604'])) call abort()
+    if (x9(1)%c1 /= '35001') call abort()
+    if (x9(2)%c1 /= '35002') call abort()
+    if (any (x9(1)%c2 /= ['45001','45002','45003'])) call abort()
+    if (any (x9(2)%c2 /= ['45011','45012','45013'])) call abort()
+ 
+    if (x10%c1 /= '-501') call abort()
+    if (any (x10%c2 /= ['-502','-503','-504'])) call abort()
+    if (x11(1)%c1 /= '36001') call abort()
+    if (x11(2)%c1 /= '36002') call abort()
+    if (any (x11(1)%c2 /= ['46001','46002','46003'])) call abort()
+    if (any (x11(2)%c2 /= ['46011','46012','46013'])) call abort()
+
+    if (any (x5 /= [ 'x5-42', 'x5-53' ])) call abort()
+
+    if (x12(1)%c1 /= '37001') call abort()
+    if (x12(2)%c1 /= '37002') call abort()
+    if (any (x12(1)%c2 /= ['47001','47002','47003'])) call abort()
+    if (any (x12(2)%c2 /= ['47011','47012','47013'])) call abort()
+  end subroutine test4
+end program nml_test
diff --git a/gcc/testsuite/gfortran.dg/namelist_71.f90 b/gcc/testsuite/gfortran.dg/namelist_71.f90
new file mode 100644
index 000000000..c0428d905
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_71.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! PR47778 Reading array of structures from namelist
+! Test case derived from the reporters test case.
+program test_nml
+type field_descr
+  integer number
+end type
+type fsetup
+  type (field_descr), dimension(3) :: vel ! 3 velocity components
+  type (field_descr), dimension(3) :: scal ! 3 scalars
+end type
+type (fsetup) field_setup
+namelist /nl_setup/ field_setup
+field_setup%vel%number = 0
+field_setup%scal%number = 0
+! write(*,nml=nl_setup)
+open(10, status="scratch")
+write(10,'(a)') "&nl_setup"
+write(10,'(a)') " field_setup%vel(1)%number=  3,"
+write(10,'(a)') " field_setup%vel(2)%number=  9,"
+write(10,'(a)') " field_setup%vel(3)%number=  27,"
+write(10,'(a)') " field_setup%scal(1)%number=  2,"
+write(10,'(a)') " field_setup%scal(2)%number=  4,"
+write(10,'(a)') " field_setup%scal(3)%number=  8,"
+write(10,'(a)') "/"
+rewind(10)
+read(10,nml=nl_setup)
+if (field_setup%vel(1)%number .ne. 3) call abort
+if (field_setup%vel(2)%number .ne. 9) call abort
+if (field_setup%vel(3)%number .ne. 27) call abort
+if (field_setup%scal(1)%number .ne. 2) call abort
+if (field_setup%scal(2)%number .ne. 4) call abort
+if (field_setup%scal(3)%number .ne. 8) call abort
+!write(*,nml=nl_setup)
+end program test_nml
+
diff --git a/gcc/testsuite/gfortran.dg/namelist_72.f b/gcc/testsuite/gfortran.dg/namelist_72.f
new file mode 100644
index 000000000..22c088076
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_72.f
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! PR fortran/49791
+!
+! Contributed by Elliott Sales de Andrade
+!
+      program namelist_test
+
+      dimension xpos(5000), ypos(5000)
+      namelist /geometry/ xpos, ypos
+
+      xpos = -huge(xpos)
+      ypos = -huge(ypos)
+
+      open(unit=4,file='geometry.in')
+      write(4,'(a)') '$geometry'
+      write(4,'(a)') ' xpos(1)= 0.00, 0.10, 0.20, 0.30, 0.40,'
+      write(4,'(a)') ' ypos(1)= 0.50, 0.60, 0.70, 0.80, 0.90,'
+      write(4,'(a)') '$end'
+
+      close(4)
+
+      open (unit=4,file='geometry.in',status='old',form='formatted')
+      read (4,geometry)
+      close(4, status='delete')
+
+      !print *, 'xpos', xpos(1:10), 'ypos', ypos(1:10)
+
+      if (any (xpos(1:5) /= [0.00, 0.10, 0.20, 0.30, 0.40]))call abort()
+      if (any (ypos(1:5) /= [0.50, 0.60, 0.70, 0.80, 0.90]))call abort()
+      if (any (xpos(6:) /= -huge(xpos))) call abort ()
+      if (any (ypos(6:) /= -huge(ypos))) call abort ()
+      end
diff --git a/gcc/testsuite/gfortran.dg/namelist_73.f90 b/gcc/testsuite/gfortran.dg/namelist_73.f90
new file mode 100644
index 000000000..8fc88aa1e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_73.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! PR fortran/50109
+!
+! Contributed by Jim Hanson
+!
+      program namelist_test
+
+      integer nfp
+      namelist /indata/ nfp
+
+      nfp = 99
+      open(unit=4, status='scratch')
+      write(4,'(a)') '$indata'
+      write(4,'(a)') 'NFP = 5,'
+      write(4,'(a)') "!  "
+      write(4,'(a)') "! "
+      write(4,'(a)') "!  "
+      write(4,'(a)') '/'
+
+      rewind(4)
+      read (4,nml=indata)
+      close(4)
+
+!      write(*,*) nfp
+      if (nfp /= 5) call abort()
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/namelist_80.f90 b/gcc/testsuite/gfortran.dg/namelist_80.f90
new file mode 100644
index 000000000..1961b11b1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_80.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+!
+! PR fortran/56735
+!
+! Contributed by Adam Williams
+!
+        PROGRAM TEST
+        INTEGER int1,int2,int3
+        NAMELIST /temp/ int1,int2,int3
+
+        int1 = -1; int2 = -2; int3 = -3
+
+        OPEN (53, STATUS='scratch')
+        WRITE (53, '(a)') ' ?'
+        WRITE (53, '(a)')
+        WRITE (53, '(a)') '$temp'
+        WRITE (53, '(a)') ' int1=1'
+        WRITE (53, '(a)') ' int2=2'
+        WRITE (53, '(a)') ' int3=3'
+        WRITE (53, '(a)') '$END'
+        REWIND(53)
+
+        READ (53, temp)
+        CLOSE (53)
+
+        if (int1 /= 1 .or. int2 /= 2 .or. int3 /= 3) call abort()
+        END PROGRAM
diff --git a/gcc/testsuite/gfortran.dg/namelist_assumed_char.f90 b/gcc/testsuite/gfortran.dg/namelist_assumed_char.f90
new file mode 100644
index 000000000..b7d063c78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_assumed_char.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! PR30481 Assumed size character is not allowed in namelist.
+! Test case from PR, submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+!
+! Modifications for PR fortran/47339 / PR fortran/43062:
+! Add -std=f95, add bar()
+!
+subroutine foo(c)
+  character*(*) c
+  namelist /abc/ c  ! { dg-error "nonconstant character length in namelist" }
+end subroutine
+
+subroutine bar(d,n)
+  integer :: n
+  character(len=n) d
+  namelist /abcd/ d  ! { dg-error "nonconstant character length in namelist" }
+end subroutine bar
+
diff --git a/gcc/testsuite/gfortran.dg/namelist_blockdata.f b/gcc/testsuite/gfortran.dg/namelist_blockdata.f
new file mode 100644
index 000000000..c1a7a5b4e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_blockdata.f
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! Tests fix for PR21565 - object cannot be in namelist and block data.
+      block data
+      common /foo/ a
+      namelist /foo_n/ a ! { dg-error "not allowed in BLOCK DATA" }
+      data a /1.0/
+      end
diff --git a/gcc/testsuite/gfortran.dg/namelist_char_only.f90 b/gcc/testsuite/gfortran.dg/namelist_char_only.f90
new file mode 100644
index 000000000..9993669b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_char_only.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-options "-O0" }
+! Test patch for PR24416.f90 - a used to come back from the read with var
+! prepended.
+!
+  IMPLICIT NONE
+  CHARACTER(len=10)  :: var = "hello"
+  character(len=10)  :: a = ""
+  NAMELIST /inx/ var
+
+  OPEN(unit=11, status='scratch')
+  write (11, *) "&INX"
+  write (11, *) "  var = 'goodbye'"
+  write (11, *) "&END"
+  rewind (11)
+
+  READ(11,NML=inx)
+  CLOSE(11)
+
+  OPEN(unit=11, status='scratch')
+  write (11, *) "alls_well"
+  rewind (11)
+
+  READ(11,*) a
+  CLOSE(11)
+
+  if (a /= "alls_well") call abort ()
+
+END
diff --git a/gcc/testsuite/gfortran.dg/namelist_empty.f90 b/gcc/testsuite/gfortran.dg/namelist_empty.f90
new file mode 100644
index 000000000..89493a84b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_empty.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! pr24584, segfault on namelist reading an empty string
+! Contributed by Jerry DeLisle  <jvdelisle@verizon.net> 
+      implicit none 
+      character*20   temp
+      character(len=10) var
+      namelist /input/ var
+      var = 'Howdy'
+      open(unit=7, status="scratch")
+      temp = '   var='''''  ! var='' in the file
+      write(7,'(A6)') '&INPUT'
+      write(7,'(A10)') temp
+      write(7,'(A1)') '/'
+      rewind(7)
+      read(7,NML=input)
+      close(7)
+      if (var.ne.'') call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/namelist_internal.f90 b/gcc/testsuite/gfortran.dg/namelist_internal.f90
new file mode 100644
index 000000000..4f8aeb227
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_internal.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-fall-intrinsics -std=f2003" }
+! Checks internal file read/write of namelists
+! (Fortran 2003 feature)
+! PR fortran/28224
+program nml_internal
+  integer   :: i, j
+  real      :: r
+  namelist /nam/ i, j, r
+  character(len=250) :: str
+
+  i = 42
+  j = -718
+  r = exp(1.0)
+  write(str,nml=nam)
+  i = -33
+  j = 10
+  r = sin(1.0)
+  read(str,nml=nam)
+  if(i /= 42 .or. j /= -718 .or. abs(r-exp(1.0)) > 1e-5) call abort()
+end program nml_internal
diff --git a/gcc/testsuite/gfortran.dg/namelist_print_1.f b/gcc/testsuite/gfortran.dg/namelist_print_1.f
new file mode 100644
index 000000000..abc8aec6c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_print_1.f
@@ -0,0 +1,13 @@
+! Test Non standard PRINT namelist - PR21432
+!
+! Contributor Paul Thomas  <pault@gcc.gnu.org>
+!
+! { dg-do run }
+! { dg-options "-std=gnu" }
+
+      real  x
+      namelist /mynml/ x
+      x = 1
+! ( dg-output "^" }
+      print mynml ! { dg-output "&MYNML(\n|\r\n|\r) X=  1.0000000    ,(\n|\r\n|\r) /(\n|\r\n|\r)" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/namelist_print_2.f b/gcc/testsuite/gfortran.dg/namelist_print_2.f
new file mode 100644
index 000000000..c37e3591d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_print_2.f
@@ -0,0 +1,13 @@
+! Test Non standard PRINT namelist - PR21432 is
+! not accepted by -std=f95
+!
+! Contributor Paul Thomas  <pault@gcc.gnu.org>
+!
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+      real  x
+      namelist /mynml/ x
+      x = 1
+      print mynml  ! { dg-error "PRINT namelist.*extension" "" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/namelist_use.f90 b/gcc/testsuite/gfortran.dg/namelist_use.f90
new file mode 100644
index 000000000..d550e00aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_use.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! This tests the fix for PR22010, where namelists were not being written to
+! and read back from modules.  It has two namelists: one that is USE
+! associated and another that is concatenated by USE and host association.
+!
+! Contributed by Paul Thomas  pault@gcc.gnu.org
+!
+module global
+  character(4) :: aa
+  integer :: ii
+  real    :: rr
+  namelist /nml1/ aa, ii, rr
+  namelist /nml2/ aa
+end module global
+program namelist_use
+  use global
+  real    :: rrr
+! Concatenate use and host associated variables - an extension.
+  namelist /nml2/ ii, rrr    ! { dg-warning "already is USE associated" }
+  open (10, status="scratch")
+  write (10,*) "&NML1 aa='lmno' ii=1 rr=2.5 /"
+  write (10,*) "&NML2 aa='pqrs' ii=2 rrr=3.5 /"
+  rewind (10)
+  read (10,nml=nml1,iostat=i)
+  if ((i.ne.0).or.(aa.ne."lmno").or.(ii.ne.1).or.(rr.ne.2.5)) call abort ()
+
+  read (10,nml=nml2,iostat=i) 
+  if ((i.ne.0).or.(aa.ne."pqrs").or.(ii.ne.2).or.(rrr.ne.3.5)) call abort ()
+
+  close (10)
+end program namelist_use
+
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/namelist_use_only.f90 b/gcc/testsuite/gfortran.dg/namelist_use_only.f90
new file mode 100644
index 000000000..d9a28a856
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_use_only.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! This tests the fix for PR22010, where namelists were not being written to
+! and read back from modules.  It checks that namelists from modules that are
+! selected by an ONLY declaration work correctly, even when the variables in
+! the namelist are not host associated. Note that renaming a namelist by USE
+! association is not allowed by the standard and this is trapped in module.c.
+!
+! Contributed by Paul Thomas  pault@gcc.gnu.org
+!
+module global
+  character*4 :: aa, aaa
+  integer :: ii, iii
+  real    :: rr, rrr
+  namelist /nml1/ aa, ii, rr
+  namelist /nml2/ aaa, iii, rrr
+contains
+  logical function foo()
+    foo = (aaa.ne."pqrs").or.(iii.ne.2).or.(rrr.ne.3.5)
+  end function foo
+end module global
+program namelist_use_only
+  use global, only : nml1, aa, ii, rr
+  use global, only : nml2, rrrr=>rrr, foo
+  open (10, status="scratch")
+  write (10,'(a)') "&NML1 aa='lmno' ii=1 rr=2.5 /"
+  write (10,'(a)') "&NML2 aaa='pqrs' iii=2 rrr=3.5 /"
+  rewind (10)
+  read (10,nml=nml1,iostat=i)
+  if ((i.ne.0).or.(aa.ne."lmno").or.(ii.ne.1).or.(rr.ne.2.5)) call abort ()
+
+  read (10,nml=nml2,iostat=i) 
+  if ((i.ne.0).or.(rrrr.ne.3.5).or.foo()) call abort ()
+  close (10)
+end program namelist_use_only
+
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/nan_1.f90 b/gcc/testsuite/gfortran.dg/nan_1.f90
new file mode 100644
index 000000000..609780d69
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nan_1.f90
@@ -0,0 +1,126 @@
+! Test if MIN and MAX intrinsics behave correctly when passed NaNs
+! as arguments
+!
+! { dg-do run }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+!
+module aux2
+  interface isnan
+    module procedure isnan_r
+    module procedure isnan_d
+  end interface isnan
+
+  interface isinf
+    module procedure isinf_r
+    module procedure isinf_d
+  end interface isinf
+contains
+
+  pure function isnan_r(x) result (isnan)
+    logical :: isnan
+    real, intent(in) :: x
+
+    isnan = (.not.(x == x))
+  end function isnan_r
+
+  pure function isnan_d(x) result (isnan)
+    logical :: isnan
+    double precision, intent(in) :: x
+
+    isnan = (.not.(x == x))
+  end function isnan_d
+
+  pure function isinf_r(x) result (isinf)
+    logical :: isinf
+    real, intent(in) :: x
+
+    isinf = (x > huge(x)) .or. (x < -huge(x))
+  end function isinf_r
+
+  pure function isinf_d(x) result (isinf)
+    logical :: isinf
+    double precision, intent(in) :: x
+
+    isinf = (x > huge(x)) .or. (x < -huge(x))
+  end function isinf_d
+end module aux2
+
+program test
+  use aux2
+  implicit none
+  real :: nan, large, inf
+
+  ! Create a NaN and check it
+  nan = 0
+  nan = nan / nan
+  if (nan == nan .or. nan > nan .or. nan < nan .or. nan >= nan &
+      .or. nan <= nan) call abort
+  if (isnan (2.d0) .or. (.not. isnan(nan)) .or. &
+      (.not. isnan(real(nan,kind=kind(2.d0))))) call abort
+
+  ! Create an INF and check it
+  large = huge(large)
+  inf = 2 * large
+  if (isinf(nan) .or. isinf(large) .or. .not. isinf(inf)) call abort
+  if (isinf(-nan) .or. isinf(-large) .or. .not. isinf(-inf)) call abort
+
+  ! Check that MIN and MAX behave correctly
+  if (max(2.0, nan) /= 2.0) call abort
+  if (min(2.0, nan) /= 2.0) call abort
+  if (max(nan, 2.0) /= 2.0) call abort
+  if (min(nan, 2.0) /= 2.0) call abort
+
+  if (max(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+  if (min(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+  if (max(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+  if (min(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+
+  if (.not. isnan(min(nan,nan))) call abort
+  if (.not. isnan(max(nan,nan))) call abort
+
+  ! Same thing, with more arguments
+
+  if (max(3.0, 2.0, nan) /= 3.0) call abort
+  if (min(3.0, 2.0, nan) /= 2.0) call abort
+  if (max(3.0, nan, 2.0) /= 3.0) call abort
+  if (min(3.0, nan, 2.0) /= 2.0) call abort
+  if (max(nan, 3.0, 2.0) /= 3.0) call abort
+  if (min(nan, 3.0, 2.0) /= 2.0) call abort
+
+  if (max(3.d0, 2.d0, nan) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+  if (min(3.d0, 2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+  if (max(3.d0, nan, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+  if (min(3.d0, nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+  if (max(nan, 3.d0, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+  if (min(nan, 3.d0, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+
+  if (.not. isnan(min(nan,nan,nan))) call abort
+  if (.not. isnan(max(nan,nan,nan))) call abort
+  if (.not. isnan(min(nan,nan,nan,nan))) call abort
+  if (.not. isnan(max(nan,nan,nan,nan))) call abort
+  if (.not. isnan(min(nan,nan,nan,nan,nan))) call abort
+  if (.not. isnan(max(nan,nan,nan,nan,nan))) call abort
+
+  ! Large values, INF and NaNs
+  if (.not. isinf(max(large, inf))) call abort
+  if (isinf(min(large, inf))) call abort
+  if (.not. isinf(max(nan, large, inf))) call abort
+  if (isinf(min(nan, large, inf))) call abort
+  if (.not. isinf(max(large, nan, inf))) call abort
+  if (isinf(min(large, nan, inf))) call abort
+  if (.not. isinf(max(large, inf, nan))) call abort
+  if (isinf(min(large, inf, nan))) call abort
+
+  if (.not. isinf(min(-large, -inf))) call abort
+  if (isinf(max(-large, -inf))) call abort
+  if (.not. isinf(min(nan, -large, -inf))) call abort
+  if (isinf(max(nan, -large, -inf))) call abort
+  if (.not. isinf(min(-large, nan, -inf))) call abort
+  if (isinf(max(-large, nan, -inf))) call abort
+  if (.not. isinf(min(-large, -inf, nan))) call abort
+  if (isinf(max(-large, -inf, nan))) call abort
+
+end program test
+
+! { dg-final { cleanup-modules "aux2" } }
diff --git a/gcc/testsuite/gfortran.dg/nan_2.f90 b/gcc/testsuite/gfortran.dg/nan_2.f90
new file mode 100644
index 000000000..5c821d651
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nan_2.f90
@@ -0,0 +1,108 @@
+! { dg-do run }
+! { dg-options "-fno-range-check -pedantic" }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+!
+! PR fortran/34333
+!
+! Check that (NaN /= NaN) == .TRUE.
+! and some other NaN options.
+!
+! Contrary to nan_1.f90, PARAMETERs are used and thus
+! the front end resolves the min, max and binary operators at
+! compile time.
+!
+
+module aux2
+  interface isinf
+    module procedure isinf_r
+    module procedure isinf_d
+  end interface isinf
+contains
+  pure function isinf_r(x) result (isinf)
+    logical :: isinf
+    real, intent(in) :: x
+
+    isinf = (x > huge(x)) .or. (x < -huge(x))
+  end function isinf_r
+
+  pure function isinf_d(x) result (isinf)
+    logical :: isinf
+    double precision, intent(in) :: x
+
+    isinf = (x > huge(x)) .or. (x < -huge(x))
+  end function isinf_d
+end module aux2
+
+program test
+  use aux2
+  implicit none
+  real, parameter :: nan = 0.0/0.0, large = huge(large), inf = 1.0/0.0
+
+  if (nan == nan .or. nan > nan .or. nan < nan .or. nan >= nan &
+      .or. nan <= nan) call abort
+  if (isnan (2.d0) .or. (.not. isnan(nan)) .or. &
+      (.not. isnan(real(nan,kind=kind(2.d0))))) call abort
+
+  ! Create an INF and check it
+  if (isinf(nan) .or. isinf(large) .or. .not. isinf(inf)) call abort
+  if (isinf(-nan) .or. isinf(-large) .or. .not. isinf(-inf)) call abort
+
+  ! Check that MIN and MAX behave correctly
+  if (max(2.0, nan) /= 2.0) call abort
+  if (min(2.0, nan) /= 2.0) call abort
+  if (max(nan, 2.0) /= 2.0) call abort
+  if (min(nan, 2.0) /= 2.0) call abort
+
+  if (max(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+  if (min(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+  if (max(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+  if (min(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+
+  if (.not. isnan(min(nan,nan))) call abort
+  if (.not. isnan(max(nan,nan))) call abort
+
+  ! Same thing, with more arguments
+
+  if (max(3.0, 2.0, nan) /= 3.0) call abort
+  if (min(3.0, 2.0, nan) /= 2.0) call abort
+  if (max(3.0, nan, 2.0) /= 3.0) call abort
+  if (min(3.0, nan, 2.0) /= 2.0) call abort
+  if (max(nan, 3.0, 2.0) /= 3.0) call abort
+  if (min(nan, 3.0, 2.0) /= 2.0) call abort
+
+  if (max(3.d0, 2.d0, nan) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+  if (min(3.d0, 2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+  if (max(3.d0, nan, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+  if (min(3.d0, nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+  if (max(nan, 3.d0, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+  if (min(nan, 3.d0, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
+
+  if (.not. isnan(min(nan,nan,nan))) call abort
+  if (.not. isnan(max(nan,nan,nan))) call abort
+  if (.not. isnan(min(nan,nan,nan,nan))) call abort
+  if (.not. isnan(max(nan,nan,nan,nan))) call abort
+  if (.not. isnan(min(nan,nan,nan,nan,nan))) call abort
+  if (.not. isnan(max(nan,nan,nan,nan,nan))) call abort
+
+  ! Large values, INF and NaNs
+  if (.not. isinf(max(large, inf))) call abort
+  if (isinf(min(large, inf))) call abort
+  if (.not. isinf(max(nan, large, inf))) call abort
+  if (isinf(min(nan, large, inf))) call abort
+  if (.not. isinf(max(large, nan, inf))) call abort
+  if (isinf(min(large, nan, inf))) call abort
+  if (.not. isinf(max(large, inf, nan))) call abort
+  if (isinf(min(large, inf, nan))) call abort
+
+  if (.not. isinf(min(-large, -inf))) call abort
+  if (isinf(max(-large, -inf))) call abort
+  if (.not. isinf(min(nan, -large, -inf))) call abort
+  if (isinf(max(nan, -large, -inf))) call abort
+  if (.not. isinf(min(-large, nan, -inf))) call abort
+  if (isinf(max(-large, nan, -inf))) call abort
+  if (.not. isinf(min(-large, -inf, nan))) call abort
+  if (isinf(max(-large, -inf, nan))) call abort
+
+end program test
+! { dg-final { cleanup-modules "aux2" } }
diff --git a/gcc/testsuite/gfortran.dg/nan_3.f90 b/gcc/testsuite/gfortran.dg/nan_3.f90
new file mode 100644
index 000000000..0a46fdb6c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nan_3.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+! { dg-options "-fno-range-check" }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+!
+! PR fortran/34319
+!
+! Check support of INF/NaN for I/O.
+!
+program main
+  implicit none
+  real :: r
+  complex :: z
+  character(len=30) :: str
+
+  str = "nan"
+  read(str,*) r
+  if (.not.isnan(r)) call abort()
+  str = "(nan,4.0)"
+  read(str,*) z
+  if (.not.isnan(real(z)) .or. aimag(z) /= 4.0) call abort()
+  str = "(7.0,nan)"
+  read(str,*) z
+  if (.not.isnan(aimag(z)) .or. real(z) /= 7.0) call abort()
+
+  str = "inFinity"
+  read(str,*) r
+  if (r <= huge(r)) call abort()
+  str = "(+inFinity,4.0)"
+  read(str,*) z
+  if ((real(z) <= huge(r)) .or. aimag(z) /= 4.0) call abort()
+  str = "(7.0,-inFinity)"
+  read(str,*) z
+  if ((aimag(z) >= -huge(r)) .or. real(z) /= 7.0) call abort()
+
+  str = "inf"
+  read(str,*) r
+  if (r <= huge(r)) call abort()
+  str = "(+inf,4.0)"
+  read(str,*) z
+  if ((real(z) <= huge(r)) .or. aimag(z) /= 4.0) call abort()
+  str = "(7.0,-inf)"
+  read(str,*) z
+  if ((aimag(z) >= -huge(r)) .or. real(z) /= 7.0) call abort()
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/nan_4.f90 b/gcc/testsuite/gfortran.dg/nan_4.f90
new file mode 100644
index 000000000..30e2a4948
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nan_4.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-std=gnu" } 
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+!
+! PR fortran/34398.
+!
+! Check for invalid numbers in bit-wise BOZ transfers
+!
+program test
+  implicit none
+  real(4), parameter :: r0 = z'FFFFFFFF' ! { dg-error "Arithmetic NaN" }
+  real(4) r
+  data r/z'FFFFFFFF'/ ! { dg-error "Arithmetic NaN" }
+  r = z'FFFFFFFF' ! { dg-error "Arithmetic NaN" }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/nan_5.f90 b/gcc/testsuite/gfortran.dg/nan_5.f90
new file mode 100644
index 000000000..be1169d93
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nan_5.f90
@@ -0,0 +1,28 @@
+! Check that we correctly simplify ISNAN
+!
+! { dg-do compile }
+!
+! { dg-options "-fno-range-check" }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+
+  implicit none
+  real, parameter :: inf = 2 * huge(inf)
+  real, parameter :: nan1 = 0. / 0.
+  real, parameter :: nan2 = 1.5 * nan1
+  real, parameter :: nan3 = inf / inf
+  real, parameter :: nan4 = inf - inf
+  real, parameter :: nan5 = 0. * inf
+  real, parameter :: normal = 42.
+
+  integer(kind=merge(4, 0, isnan(nan1))) :: a
+  integer(kind=merge(4, 0, isnan(nan2))) :: b
+  integer(kind=merge(4, 0, isnan(nan3))) :: c
+  integer(kind=merge(4, 0, isnan(nan4))) :: d
+  integer(kind=merge(4, 0, isnan(nan5))) :: e
+
+  integer(kind=merge(0, 4, isnan(inf))) :: f
+  integer(kind=merge(0, 4, isnan(-inf))) :: g
+  integer(kind=merge(0, 4, isnan(normal))) :: h
+
+  end
diff --git a/gcc/testsuite/gfortran.dg/nan_6.f90 b/gcc/testsuite/gfortran.dg/nan_6.f90
new file mode 100644
index 000000000..8f0af2944
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nan_6.f90
@@ -0,0 +1,99 @@
+! { dg-do run }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+!
+! List-directed part of PR fortran/43298
+! and follow up to PR fortran/34319.
+!
+! Check handling of "NAN(alphanum)"
+!
+character(len=200) :: str
+real :: r
+complex :: z
+
+! read_real:
+
+r = 1.0
+str = 'INfinity' ; read(str,*) r
+if (r < 0 .or. r /= r*1.1) call abort()
+
+r = 1.0
+str = '-INF' ; read(str,*) r
+if (r > 0 .or. r /= r*1.1) call abort()
+
+r = 1.0
+str = '+INF' ; read(str,*) r
+if (r < 0 .or. r /= r*1.1) call abort()
+
+r = 1.0
+str = '-inFiniTY' ; read(str,*) r
+if (r > 0 .or. r /= r*1.1) call abort()
+
+r = 1.0
+str = 'NAN' ; read(str,*) r
+if (.not. isnan(r)) call abort()
+
+r = 1.0
+str = '-NAN' ; read(str,*) r
+if (.not. isnan(r)) call abort()
+
+r = 1.0
+str = '+NAN' ; read(str,*) r
+if (.not. isnan(r)) call abort()
+
+r = 1.0
+str = 'NAN(0x111)' ; read(str,*) r
+if (.not. isnan(r)) call abort()
+
+r = 1.0
+str = '-NAN(123)' ; read(str,*) r
+if (.not. isnan(r)) call abort()
+
+r = 1.0
+str = '+NAN(0xFFE)' ; read(str,*) r
+if (.not. isnan(r)) call abort()
+
+
+! parse_real
+
+z = cmplx(-2.0,-4.0)
+str = '(0.0,INfinity)' ; read(str,*) z
+if (aimag(z) < 0 .or. aimag(z) /= aimag(z)*1.1) call abort()
+
+z = cmplx(-2.0,-4.0)
+str = '(-INF,0.0)' ; read(str,*) z
+if (real(z) > 0 .or. real(z) /= real(z)*1.1) call abort()
+
+z = cmplx(-2.0,-4.0)
+str = '(0.0,+INF)' ; read(str,*) z
+if (aimag(z) < 0 .or. aimag(z) /= aimag(z)*1.1) call abort()
+
+z = cmplx(-2.0,-4.0)
+str = '(-inFiniTY,0.0)' ; read(str,*) z
+if (real(z) > 0 .or. real(z) /= real(z)*1.1) call abort()
+
+z = cmplx(-2.0,-4.0)
+str = '(NAN,0.0)' ; read(str,*) z
+if (.not. isnan(real(z))) call abort()
+
+z = cmplx(-2.0,-4.0)
+str = '(0.0,-NAN)' ; read(str,*) z
+if (.not. isnan(aimag(z))) call abort()
+
+z = cmplx(-2.0,-4.0)
+str = '(+NAN,0.0)' ; read(str,*) z
+if (.not. isnan(real(z))) call abort()
+
+z = cmplx(-2.0,-4.0)
+str = '(NAN(0x111),0.0)' ; read(str,*) z
+if (.not. isnan(real(z))) call abort()
+
+z = cmplx(-2.0,-4.0)
+str = '(0.0,-NaN(123))' ; read(str,*) z
+if (.not. isnan(aimag(z))) call abort()
+
+z = cmplx(-2.0,-4.0)
+str = '(+nan(0xFFE),0.0)' ; read(str,*) z
+if (.not. isnan(real(z))) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/nan_7.f90 b/gcc/testsuite/gfortran.dg/nan_7.f90
new file mode 100644
index 000000000..12c7b3ce4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nan_7.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-fno-range-check" }
+! { dg-require-effective-target fortran_real_16 }
+! { dg-require-effective-target fortran_integer_16 }
+! PR47293 NAN not correctly read
+character(len=200) :: str
+real(16) :: r
+integer(16) :: k2
+integer(16), parameter :: quietnan = 170099645085600953110659059745250344960
+r = 1.0
+str = 'NAN' ; read(str,*) r
+k2 = transfer(r,k2)
+k2 = iand(k2, z'fff80000000000000000000000000000')
+if (k2.ne.quietnan) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/nearest_1.f90 b/gcc/testsuite/gfortran.dg/nearest_1.f90
new file mode 100644
index 000000000..ae9e75f1e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nearest_1.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-options "-O0 -ffloat-store" }
+! { dg-add-options ieee }
+! { dg-skip-if "Denormals not supported" { spu-*-* } { "*" } { "" } }
+! PR fortran/27021
+! Original code submitted by Dominique d'Humieres
+! Converted to Dejagnu for the testsuite by Steven G. Kargl
+program chop
+  integer ix, iy
+  real o, t, td, tu, x, y
+  o = 1.
+  t = tiny(o)
+  td = nearest(t,-1.0)
+  x = td/2.0
+  y = nearest(tiny(o),-1.0)/2.0
+  ix = transfer(x,ix)
+  iy = transfer(y,iy)
+  if (ix /= iy) call abort
+end program chop
+
diff --git a/gcc/testsuite/gfortran.dg/nearest_2.f90 b/gcc/testsuite/gfortran.dg/nearest_2.f90
new file mode 100644
index 000000000..c5977415b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nearest_2.f90
@@ -0,0 +1,167 @@
+! { dg-do run }
+! { dg-options "-fno-range-check" }
+! { dg-add-options ieee }
+!
+! PR fortran/34192
+!
+! Test compile-time implementation of NEAREST
+!
+program test
+  implicit none
+
+! Single precision
+
+  ! 0+ > 0
+  if (nearest(0.0, 1.0) &
+      <= 0.0) &
+    call abort()
+  ! 0++ > 0+
+  if (nearest(nearest(0.0, 1.0), 1.0) &
+      <= nearest(0.0, 1.0)) &
+    call abort()
+  ! 0+++ > 0++
+  if (nearest(nearest(nearest(0.0, 1.0), 1.0), 1.0) &
+      <= nearest(nearest(0.0, 1.0), 1.0)) &
+    call abort()
+  ! 0+- = 0
+  if (nearest(nearest(0.0, 1.0), -1.0) &
+      /= 0.0) &
+    call abort()
+  ! 0++- = 0+
+  if (nearest(nearest(nearest(0.0, 1.0), 1.0), -1.0) &
+      /= nearest(0.0, 1.0)) &
+    call abort()
+  ! 0++-- = 0
+  if (nearest(nearest(nearest(nearest(0.0, 1.0), 1.0), -1.0), -1.0) &
+      /= 0.0) &
+    call abort()
+
+  ! 0- < 0
+  if (nearest(0.0, -1.0) &
+      >= 0.0) &
+    call abort()
+  ! 0-- < 0+
+  if (nearest(nearest(0.0, -1.0), -1.0) &
+      >= nearest(0.0, -1.0)) &
+    call abort()
+  ! 0--- < 0--
+  if (nearest(nearest(nearest(0.0, -1.0), -1.0), -1.0) &
+      >= nearest(nearest(0.0, -1.0), -1.0)) &
+    call abort()
+  ! 0-+ = 0
+  if (nearest(nearest(0.0, -1.0), 1.0) &
+      /= 0.0) &
+    call abort()
+  ! 0--+ = 0-
+  if (nearest(nearest(nearest(0.0, -1.0), -1.0), 1.0) &
+      /= nearest(0.0, -1.0)) &
+    call abort()
+  ! 0--++ = 0
+  if (nearest(nearest(nearest(nearest(0.0, -1.0), -1.0), 1.0), 1.0) &
+      /= 0.0) &
+    call abort()
+
+  ! 42++ > 42+
+  if (nearest(nearest(42.0, 1.0), 1.0) &
+      <= nearest(42.0, 1.0)) &
+    call abort()
+  ! 42-- < 42-
+  if (nearest(nearest(42.0, -1.0), -1.0) &
+      >= nearest(42.0, -1.0)) &
+    call abort()
+  ! 42-+ = 42
+  if (nearest(nearest(42.0, -1.0), 1.0) &
+      /= 42.0) &
+    call abort()
+  ! 42+- = 42
+  if (nearest(nearest(42.0, 1.0), -1.0) &
+      /= 42.0) &
+    call abort()
+
+  ! INF+ = INF
+  if (nearest(1.0/0.0, 1.0) /= 1.0/0.0) call abort()
+  ! -INF- = -INF
+  if (nearest(-1.0/0.0, -1.0) /= -1.0/0.0) call abort()
+  ! NAN- = NAN
+  if (.not.isnan(nearest(0.0d0/0.0,  1.0))) call abort()
+  ! NAN+ = NAN
+  if (.not.isnan(nearest(0.0d0/0.0, -1.0))) call abort()
+
+! Double precision
+
+  ! 0+ > 0
+  if (nearest(0.0d0, 1.0) &
+      <= 0.0d0) &
+    call abort()
+  ! 0++ > 0+
+  if (nearest(nearest(0.0d0, 1.0), 1.0) &
+      <= nearest(0.0d0, 1.0)) &
+    call abort()
+  ! 0+++ > 0++
+  if (nearest(nearest(nearest(0.0d0, 1.0), 1.0), 1.0) &
+      <= nearest(nearest(0.0d0, 1.0), 1.0)) &
+    call abort()
+  ! 0+- = 0
+  if (nearest(nearest(0.0d0, 1.0), -1.0) &
+      /= 0.0d0) &
+    call abort()
+  ! 0++- = 0+
+  if (nearest(nearest(nearest(0.0d0, 1.0), 1.0), -1.0) &
+      /= nearest(0.0d0, 1.0)) &
+    call abort()
+  ! 0++-- = 0
+  if (nearest(nearest(nearest(nearest(0.0d0, 1.0), 1.0), -1.0), -1.0) &
+      /= 0.0d0) &
+    call abort()
+
+  ! 0- < 0
+  if (nearest(0.0d0, -1.0) &
+      >= 0.0d0) &
+    call abort()
+  ! 0-- < 0+
+  if (nearest(nearest(0.0d0, -1.0), -1.0) &
+      >= nearest(0.0d0, -1.0)) &
+    call abort()
+  ! 0--- < 0--
+  if (nearest(nearest(nearest(0.0d0, -1.0), -1.0), -1.0) &
+      >= nearest(nearest(0.0d0, -1.0), -1.0)) &
+    call abort()
+  ! 0-+ = 0
+  if (nearest(nearest(0.0d0, -1.0), 1.0) &
+      /= 0.0d0) &
+    call abort()
+  ! 0--+ = 0-
+  if (nearest(nearest(nearest(0.0d0, -1.0), -1.0), 1.0) &
+      /= nearest(0.0d0, -1.0)) &
+    call abort()
+  ! 0--++ = 0
+  if (nearest(nearest(nearest(nearest(0.0d0, -1.0), -1.0), 1.0), 1.0) &
+      /= 0.0d0) &
+    call abort()
+
+  ! 42++ > 42+
+  if (nearest(nearest(42.0d0, 1.0), 1.0) &
+      <= nearest(42.0d0, 1.0)) &
+    call abort()
+  ! 42-- < 42-
+  if (nearest(nearest(42.0d0, -1.0), -1.0) &
+      >= nearest(42.0d0, -1.0)) &
+    call abort()
+  ! 42-+ = 42
+  if (nearest(nearest(42.0d0, -1.0), 1.0) &
+      /= 42.0d0) &
+    call abort()
+  ! 42+- = 42
+  if (nearest(nearest(42.0d0, 1.0), -1.0) &
+      /= 42.0d0) &
+    call abort()
+
+  ! INF+ = INF
+  if (nearest(1.0d0/0.0d0, 1.0) /= 1.0d0/0.0d0) call abort()
+  ! -INF- = -INF
+  if (nearest(-1.0d0/0.0d0, -1.0) /= -1.0d0/0.0d0) call abort()
+  ! NAN- = NAN
+  if (.not.isnan(nearest(0.0d0/0.0,  1.0))) call abort()
+  ! NAN+ = NAN
+  if (.not.isnan(nearest(0.0d0/0.0, -1.0))) call abort()
+end program test
diff --git a/gcc/testsuite/gfortran.dg/nearest_3.f90 b/gcc/testsuite/gfortran.dg/nearest_3.f90
new file mode 100644
index 000000000..7d6831670
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nearest_3.f90
@@ -0,0 +1,339 @@
+! { dg-do run }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+!
+! PR fortran/34209
+!
+! Test run-time implementation of NEAREST
+!
+program test
+  implicit none
+  real(4), volatile :: r4
+  real(8), volatile :: r8
+
+! Single precision with single-precision sign
+
+  r4 = 0.0_4
+  ! 0+ > 0
+  if (nearest(r4, 1.0) &
+      <= r4) &
+    call abort()
+  ! 0++ > 0+
+  if (nearest(nearest(r4, 1.0), 1.0) &
+      <= nearest(r4, 1.0)) &
+    call abort()
+  ! 0+++ > 0++
+  if (nearest(nearest(nearest(r4, 1.0), 1.0), 1.0) &
+      <= nearest(nearest(r4, 1.0), 1.0)) &
+    call abort()
+  ! 0+- = 0
+  if (nearest(nearest(r4, 1.0), -1.0) &
+      /= r4) &
+    call abort()
+  ! 0++- = 0+
+  if (nearest(nearest(nearest(r4, 1.0), 1.0), -1.0) &
+      /= nearest(r4, 1.0)) &
+    call abort()
+  ! 0++-- = 0
+  if (nearest(nearest(nearest(nearest(r4, 1.0), 1.0), -1.0), -1.0) &
+      /= r4) &
+    call abort()
+
+  ! 0- < 0
+  if (nearest(r4, -1.0) &
+      >= r4) &
+    call abort()
+  ! 0-- < 0+
+  if (nearest(nearest(r4, -1.0), -1.0) &
+      >= nearest(r4, -1.0)) &
+    call abort()
+  ! 0--- < 0--
+  if (nearest(nearest(nearest(r4, -1.0), -1.0), -1.0) &
+      >= nearest(nearest(r4, -1.0), -1.0)) &
+    call abort()
+  ! 0-+ = 0
+  if (nearest(nearest(r4, -1.0), 1.0) &
+      /= r4) &
+    call abort()
+  ! 0--+ = 0-
+  if (nearest(nearest(nearest(r4, -1.0), -1.0), 1.0) &
+      /= nearest(r4, -1.0)) &
+    call abort()
+  ! 0--++ = 0
+  if (nearest(nearest(nearest(nearest(r4, -1.0), -1.0), 1.0), 1.0) &
+      /= r4) &
+    call abort()
+
+  r4 = 42.0_4
+  ! 42++ > 42+
+  if (nearest(nearest(r4, 1.0), 1.0) &
+      <= nearest(r4, 1.0)) &
+    call abort()
+  ! 42-- < 42-
+  if (nearest(nearest(r4, -1.0), -1.0) &
+      >= nearest(r4, -1.0)) &
+    call abort()
+  ! 42-+ = 42
+  if (nearest(nearest(r4, -1.0), 1.0) &
+      /= r4) &
+    call abort()
+  ! 42+- = 42
+  if (nearest(nearest(r4, 1.0), -1.0) &
+      /= r4) &
+    call abort()
+
+  r4 = 0.0
+  ! INF+ = INF
+  if (nearest(1.0/r4, 1.0) /= 1.0/r4) call abort()
+  ! -INF- = -INF
+  if (nearest(-1.0/r4, -1.0) /= -1.0/r4) call abort()
+  ! NAN- = NAN
+  if (.not.isnan(nearest(0.0/r4,  1.0))) call abort()
+  ! NAN+ = NAN
+  if (.not.isnan(nearest(0.0/r4, -1.0))) call abort()
+
+! Double precision with single-precision sign
+
+  r8 = 0.0_8
+  ! 0+ > 0
+  if (nearest(r8, 1.0) &
+      <= r8) &
+    call abort()
+  ! 0++ > 0+
+  if (nearest(nearest(r8, 1.0), 1.0) &
+      <= nearest(r8, 1.0)) &
+    call abort()
+  ! 0+++ > 0++
+  if (nearest(nearest(nearest(r8, 1.0), 1.0), 1.0) &
+      <= nearest(nearest(r8, 1.0), 1.0)) &
+    call abort()
+  ! 0+- = 0
+  if (nearest(nearest(r8, 1.0), -1.0) &
+      /= r8) &
+    call abort()
+  ! 0++- = 0+
+  if (nearest(nearest(nearest(r8, 1.0), 1.0), -1.0) &
+      /= nearest(r8, 1.0)) &
+    call abort()
+  ! 0++-- = 0
+  if (nearest(nearest(nearest(nearest(r8, 1.0), 1.0), -1.0), -1.0) &
+      /= r8) &
+    call abort()
+
+  ! 0- < 0
+  if (nearest(r8, -1.0) &
+      >= r8) &
+    call abort()
+  ! 0-- < 0+
+  if (nearest(nearest(r8, -1.0), -1.0) &
+      >= nearest(r8, -1.0)) &
+    call abort()
+  ! 0--- < 0--
+  if (nearest(nearest(nearest(r8, -1.0), -1.0), -1.0) &
+      >= nearest(nearest(r8, -1.0), -1.0)) &
+    call abort()
+  ! 0-+ = 0
+  if (nearest(nearest(r8, -1.0), 1.0) &
+      /= r8) &
+    call abort()
+  ! 0--+ = 0-
+  if (nearest(nearest(nearest(r8, -1.0), -1.0), 1.0) &
+      /= nearest(r8, -1.0)) &
+    call abort()
+  ! 0--++ = 0
+  if (nearest(nearest(nearest(nearest(r8, -1.0), -1.0), 1.0), 1.0) &
+      /= r8) &
+    call abort()
+
+  r8 = 42.0_8
+  ! 42++ > 42+
+  if (nearest(nearest(r8, 1.0), 1.0) &
+      <= nearest(r8, 1.0)) &
+    call abort()
+  ! 42-- < 42-
+  if (nearest(nearest(r8, -1.0), -1.0) &
+      >= nearest(r8, -1.0)) &
+    call abort()
+  ! 42-+ = 42
+  if (nearest(nearest(r8, -1.0), 1.0) &
+      /= r8) &
+    call abort()
+  ! 42+- = 42
+  if (nearest(nearest(r8, 1.0), -1.0) &
+      /= r8) &
+    call abort()
+
+  r4 = 0.0
+  ! INF+ = INF
+  if (nearest(1.0/r4, 1.0) /= 1.0/r4) call abort()
+  ! -INF- = -INF
+  if (nearest(-1.0/r4, -1.0) /= -1.0/r4) call abort()
+  ! NAN- = NAN
+  if (.not.isnan(nearest(0.0/r4,  1.0))) call abort()
+  ! NAN+ = NAN
+  if (.not.isnan(nearest(0.0/r4, -1.0))) call abort()
+
+
+! Single precision with double-precision sign
+
+  r4 = 0.0_4
+  ! 0+ > 0
+  if (nearest(r4, 1.0d0) &
+      <= r4) &
+    call abort()
+  ! 0++ > 0+
+  if (nearest(nearest(r4, 1.0d0), 1.0d0) &
+      <= nearest(r4, 1.0d0)) &
+    call abort()
+  ! 0+++ > 0++
+  if (nearest(nearest(nearest(r4, 1.0d0), 1.0d0), 1.0d0) &
+      <= nearest(nearest(r4, 1.0d0), 1.0d0)) &
+    call abort()
+  ! 0+- = 0
+  if (nearest(nearest(r4, 1.0d0), -1.0d0) &
+      /= r4) &
+    call abort()
+  ! 0++- = 0+
+  if (nearest(nearest(nearest(r4, 1.0d0), 1.0d0), -1.0d0) &
+      /= nearest(r4, 1.0d0)) &
+    call abort()
+  ! 0++-- = 0
+  if (nearest(nearest(nearest(nearest(r4, 1.0d0), 1.0d0), -1.0d0), -1.0d0) &
+      /= r4) &
+    call abort()
+
+  ! 0- < 0
+  if (nearest(r4, -1.0d0) &
+      >= r4) &
+    call abort()
+  ! 0-- < 0+
+  if (nearest(nearest(r4, -1.0d0), -1.0d0) &
+      >= nearest(r4, -1.0d0)) &
+    call abort()
+  ! 0--- < 0--
+  if (nearest(nearest(nearest(r4, -1.0d0), -1.0d0), -1.0d0) &
+      >= nearest(nearest(r4, -1.0d0), -1.0d0)) &
+    call abort()
+  ! 0-+ = 0
+  if (nearest(nearest(r4, -1.0d0), 1.0d0) &
+      /= r4) &
+    call abort()
+  ! 0--+ = 0-
+  if (nearest(nearest(nearest(r4, -1.0d0), -1.0d0), 1.0d0) &
+      /= nearest(r4, -1.0d0)) &
+    call abort()
+  ! 0--++ = 0
+  if (nearest(nearest(nearest(nearest(r4, -1.0d0), -1.0d0), 1.0d0), 1.0d0) &
+      /= r4) &
+    call abort()
+
+  r4 = 42.0_4
+  ! 42++ > 42+
+  if (nearest(nearest(r4, 1.0d0), 1.0d0) &
+      <= nearest(r4, 1.0d0)) &
+    call abort()
+  ! 42-- < 42-
+  if (nearest(nearest(r4, -1.0d0), -1.0d0) &
+      >= nearest(r4, -1.0d0)) &
+    call abort()
+  ! 42-+ = 42
+  if (nearest(nearest(r4, -1.0d0), 1.0d0) &
+      /= r4) &
+    call abort()
+  ! 42+- = 42
+  if (nearest(nearest(r4, 1.0d0), -1.0d0) &
+      /= r4) &
+    call abort()
+
+  r4 = 0.0
+  ! INF+ = INF
+  if (nearest(1.0d0/r4, 1.0d0) /= 1.0d0/r4) call abort()
+  ! -INF- = -INF
+  if (nearest(-1.0d0/r4, -1.0d0) /= -1.0d0/r4) call abort()
+  ! NAN- = NAN
+  if (.not.isnan(nearest(0.0/r4,  1.0d0))) call abort()
+  ! NAN+ = NAN
+  if (.not.isnan(nearest(0.0/r4, -1.0d0))) call abort()
+
+! Double precision with double-precision sign
+
+  r8 = 0.0_8
+  ! 0+ > 0
+  if (nearest(r8, 1.0d0) &
+      <= r8) &
+    call abort()
+  ! 0++ > 0+
+  if (nearest(nearest(r8, 1.0d0), 1.0d0) &
+      <= nearest(r8, 1.0d0)) &
+    call abort()
+  ! 0+++ > 0++
+  if (nearest(nearest(nearest(r8, 1.0d0), 1.0d0), 1.0d0) &
+      <= nearest(nearest(r8, 1.0d0), 1.0d0)) &
+    call abort()
+  ! 0+- = 0
+  if (nearest(nearest(r8, 1.0d0), -1.0d0) &
+      /= r8) &
+    call abort()
+  ! 0++- = 0+
+  if (nearest(nearest(nearest(r8, 1.0d0), 1.0d0), -1.0d0) &
+      /= nearest(r8, 1.0d0)) &
+    call abort()
+  ! 0++-- = 0
+  if (nearest(nearest(nearest(nearest(r8, 1.0d0), 1.0d0), -1.0d0), -1.0d0) &
+      /= r8) &
+    call abort()
+
+  ! 0- < 0
+  if (nearest(r8, -1.0d0) &
+      >= r8) &
+    call abort()
+  ! 0-- < 0+
+  if (nearest(nearest(r8, -1.0d0), -1.0d0) &
+      >= nearest(r8, -1.0d0)) &
+    call abort()
+  ! 0--- < 0--
+  if (nearest(nearest(nearest(r8, -1.0d0), -1.0d0), -1.0d0) &
+      >= nearest(nearest(r8, -1.0d0), -1.0d0)) &
+    call abort()
+  ! 0-+ = 0
+  if (nearest(nearest(r8, -1.0d0), 1.0d0) &
+      /= r8) &
+    call abort()
+  ! 0--+ = 0-
+  if (nearest(nearest(nearest(r8, -1.0d0), -1.0d0), 1.0d0) &
+      /= nearest(r8, -1.0d0)) &
+    call abort()
+  ! 0--++ = 0
+  if (nearest(nearest(nearest(nearest(r8, -1.0d0), -1.0d0), 1.0d0), 1.0d0) &
+      /= r8) &
+    call abort()
+
+  r8 = 42.0_8
+  ! 42++ > 42+
+  if (nearest(nearest(r8, 1.0d0), 1.0d0) &
+      <= nearest(r8, 1.0d0)) &
+    call abort()
+  ! 42-- < 42-
+  if (nearest(nearest(r8, -1.0d0), -1.0d0) &
+      >= nearest(r8, -1.0d0)) &
+    call abort()
+  ! 42-+ = 42
+  if (nearest(nearest(r8, -1.0d0), 1.0d0) &
+      /= r8) &
+    call abort()
+  ! 42+- = 42
+  if (nearest(nearest(r8, 1.0d0), -1.0d0) &
+      /= r8) &
+    call abort()
+
+  r4 = 0.0
+  ! INF+ = INF
+  if (nearest(1.0d0/r4, 1.0d0) /= 1.0d0/r4) call abort()
+  ! -INF- = -INF
+  if (nearest(-1.0d0/r4, -1.0d0) /= -1.0d0/r4) call abort()
+  ! NAN- = NAN
+  if (.not.isnan(nearest(0.0/r4,  1.0d0))) call abort()
+  ! NAN+ = NAN
+  if (.not.isnan(nearest(0.0/r4, -1.0d0))) call abort()
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/nearest_4.f90 b/gcc/testsuite/gfortran.dg/nearest_4.f90
new file mode 100644
index 000000000..51ee35f9a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nearest_4.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! PR33296 nearest(huge(1.0),1.0) gives an error
+real x
+x = nearest(-huge(1.0),-1.0)
+print *, x
+end
diff --git a/gcc/testsuite/gfortran.dg/negative-z-descriptor.f90 b/gcc/testsuite/gfortran.dg/negative-z-descriptor.f90
new file mode 100644
index 000000000..1ad3a32b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/negative-z-descriptor.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! PR 22217:  Z edit descriptor with negative numbers used to give lots of *
+
+program main
+  character(len=70) line
+  character(len=20) fmt
+  write(unit=line,fmt='(Z4)') -1_1
+  if (line(1:4) .ne. '  FF') call abort
+  write(unit=line,fmt='(Z5)') -1_2
+  if (line(1:5) .ne. ' FFFF') call abort
+  write(unit=line,fmt='(Z9)') -1_4
+  if (line(1:9) .ne. ' FFFFFFFF') call abort
+  write(unit=line,fmt='(Z17)') -2_8
+  if (line(1:17) .ne. ' FFFFFFFFFFFFFFFE') call abort
+  write(unit=line,fmt='(Z2)') 10_8
+  if (line(1:2) .ne. ' A') call abort
+
+  write(unit=line,fmt='(Z8)') -43_8
+  if (line(1:1) .ne. '*') call abort
+
+  write(unit=line,fmt='(B65)') -1_8
+  if (line(1:2) .ne. ' 1') call abort
+  if (line(64:66) .ne. '11 ') call abort
+
+  write(unit=line,fmt='(O4)') -2_1
+  if (line(1:4) .ne. ' 376') call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/negative_automatic_size.f90 b/gcc/testsuite/gfortran.dg/negative_automatic_size.f90
new file mode 100644
index 000000000..322eafe9f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/negative_automatic_size.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-options "-O2" }
+! Tests the fix PR29451, in which the negative size of the
+! automatic array 'jello' was not detected and the
+! runtime error: Attempt to allocate a negative amount of memory
+! resulted.
+!
+! Contributed by Philip Mason  <pmason@ricardo.com> 
+!
+program fred
+  call jackal (1, 0)
+  call jackal (2, 1)
+  call jackal (3, 0)
+end
+
+subroutine jackal (b, c)
+  integer :: b, c
+  integer :: jello(b:c), cake(1:2, b:c), soda(b:c, 1:2)
+  if (lbound (jello, 1) <= ubound (jello, 1)) call abort ()
+  if (size (jello) /= 0) call abort ()
+
+  if (.not.any(lbound (cake) <= ubound (cake))) call abort ()
+  if (size (cake) /= 0) call abort ()
+
+  if ((lbound (soda, 1) > ubound (soda, 1)) .and. &
+      (lbound (soda, 2) > ubound (soda, 2))) call abort ()
+  if (size (soda) /= 0) call abort ()
+
+end subroutine jackal
diff --git a/gcc/testsuite/gfortran.dg/negative_unit.f b/gcc/testsuite/gfortran.dg/negative_unit.f
new file mode 100644
index 000000000..f1733a888
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/negative_unit.f
@@ -0,0 +1,24 @@
+! { dg-do run }
+!
+! PR libfortran/20660 and other bugs (not filed in bugzilla) relating
+! to negative units
+! PR 33055 Runtime error in INQUIRE unit existance with -fdefault-integer-8
+! Test case update by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+!
+! Bugs submitted by Walt Brainerd
+      integer i,j
+      logical l
+      
+      i = -1
+! gfortran created a 'fort.-1' file and wrote "Hello" in it
+      write (unit=i, fmt=*, iostat=j) "Hello"
+      if (j <= 0) call abort
+      
+      i = -11
+      open (unit=i, file="xxx", iostat=j)
+      if (j <= 0) call abort
+
+      i = -42
+      inquire (unit=i, exist=l)
+      if (l) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/negative_unit_int8.f b/gcc/testsuite/gfortran.dg/negative_unit_int8.f
new file mode 100644
index 000000000..d4c35579f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/negative_unit_int8.f
@@ -0,0 +1,35 @@
+! { dg-do run }
+! { dg-options "-fdefault-integer-8" }
+! 
+! NOTE: This test is identical to negative_unit.f except -fdefault-integer-8
+!
+! PR libfortran/20660 and other bugs (not filed in bugzilla) relating
+! to negative units
+! PR 33055 Runtime error in INQUIRE unit existance with -fdefault-integer-8
+! Test case update by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+!
+! Bugs submitted by Walt Brainerd
+      integer i
+      integer, parameter ::ERROR_BAD_UNIT = 5005
+      logical l
+      
+      i = -1
+! gfortran created a 'fort.-1' file and wrote "Hello" in it
+      write (unit=i, fmt=*, iostat=i) "Hello"
+      if (i <= 0) call abort
+      
+      i = -11
+      open (unit=i, file="xxx", iostat=i)
+      if (i <= 0) call abort
+
+      i = -42
+      inquire (unit=i, exist=l)
+      if (l) call abort
+
+      i = 2_8*huge(0_4)+20_8
+! This one is nasty
+      inquire (unit=i, exist=l, iostat=i)
+      if (l) call abort
+      if (i.ne.ERROR_BAD_UNIT) call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/nested_allocatables_1.f90 b/gcc/testsuite/gfortran.dg/nested_allocatables_1.f90
new file mode 100644
index 000000000..607a883b7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_allocatables_1.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! PR fortran/40850
+! The code freeing allocatable components used to be put after the code
+! freeing the containing entity.
+!
+! Original test case by Marco Restelli <mrestelli@gmail.com>
+! Reduced by Daniel Franke <franke.daniel@gmail.com>
+!        and Janus Weil <janus@gcc.gnu.org>
+
+
+  type t
+    integer, allocatable :: d(:)
+  end type
+  type(t), allocatable :: a(:)
+
+  ! Big enough to make it fail
+  allocate(a(2 * 1024))
+  call sub( (/ a /) )
+
+contains
+
+  subroutine sub(b)
+    type(t) :: b(:)
+  end subroutine
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/nested_array_constructor_1.f90 b/gcc/testsuite/gfortran.dg/nested_array_constructor_1.f90
new file mode 100644
index 000000000..54417a0de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_array_constructor_1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! This test is run with result-checking and -fbounds-check as
+! nested_array_constructor_2.f90
+
+! PR fortran/35846
+! This used to ICE because the charlength of the trim-expression was
+! NULL.
+
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+implicit none
+character(len=2) :: c(3)
+
+c = 'a'
+c = (/ (/ trim(c(1)), 'a' /)//'c', 'cd' /)
+
+print *, c
+
+end
diff --git a/gcc/testsuite/gfortran.dg/nested_array_constructor_2.f90 b/gcc/testsuite/gfortran.dg/nested_array_constructor_2.f90
new file mode 100644
index 000000000..28c2b49e8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_array_constructor_2.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+
+! PR fortran/35846
+! This used to ICE because the charlength of the trim-expression was
+! NULL.
+
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+implicit none
+character(len=2) :: c(3)
+
+c = 'a'
+c = (/ (/ trim(c(1)), 'a' /)//'c', 'cd' /)
+
+print *, c
+
+if (c(1) /= 'ac' .or. c(2) /= 'ac' .or. c(3) /= 'cd') then
+  call abort ()
+end if
+
+end
diff --git a/gcc/testsuite/gfortran.dg/nested_array_constructor_3.f90 b/gcc/testsuite/gfortran.dg/nested_array_constructor_3.f90
new file mode 100644
index 000000000..dd10e5faf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_array_constructor_3.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+
+! PR fortran/35846
+! Alternate test that also produced an ICE because of a missing length.
+
+PROGRAM test
+  IMPLICIT NONE
+  CHARACTER(LEN=2) :: x
+
+  x = 'a'
+  CALL sub ( (/ TRIM(x), 'a' /) // 'c')
+END PROGRAM
+
+SUBROUTINE sub(str)
+  IMPLICIT NONE
+  CHARACTER(LEN=*) :: str(2)
+  WRITE (*,*) str
+
+  IF (str(1) /= 'ac' .OR. str(2) /= 'ac') THEN
+    CALL abort ()
+  END IF
+END SUBROUTINE sub
diff --git a/gcc/testsuite/gfortran.dg/nested_array_constructor_4.f90 b/gcc/testsuite/gfortran.dg/nested_array_constructor_4.f90
new file mode 100644
index 000000000..cb113e9c9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_array_constructor_4.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+
+! PR fortran/35846
+! Alternate test that also produced an ICE because of a missing length.
+
+PROGRAM test
+  IMPLICIT NONE
+  CHARACTER(LEN=2) :: x
+  INTEGER :: length
+
+  x = 'a'
+  length = LEN ( (/ TRIM(x), 'a' /) // 'c')
+
+  IF (length /= 2) THEN
+    CALL abort ()
+  END IF
+END PROGRAM
diff --git a/gcc/testsuite/gfortran.dg/nested_array_constructor_5.f90 b/gcc/testsuite/gfortran.dg/nested_array_constructor_5.f90
new file mode 100644
index 000000000..7744f1ffe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_array_constructor_5.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+
+! PR fortran/35846
+! This used to ICE because the charlength of the trim-expression was
+! NULL, but it is switched around to test for the right operand of // being
+! not a constant, too.
+
+implicit none
+character(len=2) :: c(2)
+
+c = 'a'
+c = (/ (/ trim(c(1)), 'a' /) // (/ trim(c(1)), 'a' /) /)
+
+print *, c
+
+end
diff --git a/gcc/testsuite/gfortran.dg/nested_array_constructor_6.f90 b/gcc/testsuite/gfortran.dg/nested_array_constructor_6.f90
new file mode 100644
index 000000000..6eee6d0b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_array_constructor_6.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+
+! PR fortran/35846
+! Nested three levels deep.
+
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+implicit none
+character(len=3) :: c(3)
+c = 'a'
+c = (/ (/ 'A'//(/ trim(c(1)), 'a' /)/)//'c', 'dcd' /)
+print *, c(1)
+print *, c(2)
+print *, c(3)
+end
diff --git a/gcc/testsuite/gfortran.dg/nested_forall_1.f b/gcc/testsuite/gfortran.dg/nested_forall_1.f
new file mode 100644
index 000000000..6aa66ee97
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_forall_1.f
@@ -0,0 +1,38 @@
+! { dg-do compile }
+!
+! PR fortran/35820
+! 
+! Memory leak(s) while resolving forall constructs.
+! 
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+
+      MODULE TESTS
+      INTEGER,PARAMETER,PUBLIC  ::  I1_KV = KIND(1)
+      INTEGER,PARAMETER,PUBLIC  ::  R1_KV = KIND(1.0)
+      INTEGER, PRIVATE :: J1,J2
+      INTEGER,PARAMETER,PUBLIC  ::  S1 = 10, S2 = 9
+      CONTAINS
+      SUBROUTINE SA0136(RDA,IDA,BDA)
+      REAL(R1_KV) RDA(S1)
+      INTEGER(I1_KV) IDA(S1,S2)
+      INTEGER(I1_KV) ICA(S1,S2)
+      REAL(R1_KV) RCA(S1)
+!  T E S T  S T A T E M E N T S
+      FORALL (J1 = 1:S1)
+        RDA(J1) = RCA(J1) + 1.0_R1_KV
+        FORALL (J2 = 1:S2)
+          IDA(J1,J2) = ICA(J1,J2) + 1
+        END FORALL
+        FORALL (J2 = 1:S2)
+          IDA(J1,J2) = ICA(J1,J2)
+        END FORALL
+      ENDFORALL
+      FORALL (J1 = 1:S1)
+        RDA(J1) = RCA(J1)
+        FORALL (J2 = 1:S2)
+          IDA(J1,J2) = ICA(J1,J2)
+        END FORALL
+      END FORALL
+      END SUBROUTINE
+      END MODULE TESTS
+! { dg-final { cleanup-modules "tests" } }
diff --git a/gcc/testsuite/gfortran.dg/nested_modules_1.f90 b/gcc/testsuite/gfortran.dg/nested_modules_1.f90
new file mode 100644
index 000000000..a0bd96361
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_modules_1.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+!
+! This tests that common blocks function with multiply nested modules.
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+       module mod0
+         complex(kind=8) FOO, KANGA
+         common /bar/ FOO, KANGA
+       contains
+         subroutine eyeore ()    
+           FOO = FOO + (1.0d0, 0.0d0)
+           KANGA = KANGA - (1.0d0, 0.0d0)
+         end subroutine eyeore
+       end module mod0
+       module mod1
+         use mod0
+         complex ROBIN
+         common/owl/ROBIN
+       end module mod1
+       module mod2
+         use mod0
+         use mod1
+         real(kind=8) re1, im1, re2, im2, re, im
+         common /bar/ re1, im1, re2, im2
+         equivalence (re1, re), (im1, im)
+       contains
+         subroutine tigger (w)
+           complex(kind=8) w
+           if (FOO.ne.(1.0d0, 1.0d0)) call abort ()
+           if (KANGA.ne.(-1.0d0, -1.0d0)) call abort ()
+           if (ROBIN.ne.(99.0d0, 99.0d0)) CALL abort ()
+           if (w.ne.cmplx(re,im)) call abort ()
+         end subroutine tigger
+       end module mod2
+
+       use mod2
+       use mod0, only: w=>foo
+       w = (0.0d0, 1.0d0)  ! Was foo but this is forbidden (11.3.2)
+       KANGA = (0.0d0, -1.0d0)
+       ROBIN = (99.0d0, 99.0d0)
+       call eyeore ()
+       call tigger (w)
+       end
+
+! { dg-final { cleanup-modules "mod0 mod1 mod2" } }
diff --git a/gcc/testsuite/gfortran.dg/nested_modules_2.f90 b/gcc/testsuite/gfortran.dg/nested_modules_2.f90
new file mode 100644
index 000000000..5bfdaddaa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_modules_2.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! This tests the patch for PR16861.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+module foo
+INTEGER :: i
+end module foo
+
+module bar
+contains
+subroutine sub1 (j)
+  use foo
+  integer, dimension(i) :: j
+  j = 42
+end subroutine sub1
+subroutine sub2 (k)
+  use foo
+  integer, dimension(i) :: k
+  k = 84
+end subroutine sub2
+end module bar
+
+module foobar
+  use foo                      !This used to cause an ICE
+  use bar
+end module foobar
+
+program testfoobar
+  use foobar
+  integer, dimension(3)  :: l = 0
+  i = 2
+  call sub1 (l)
+  i = 1
+  call sub2 (l)
+  if (all (l.ne.(/84,42,0/))) call abort ()
+end program testfoobar
+
+! { dg-final { cleanup-modules "foo bar foobar" } }
diff --git a/gcc/testsuite/gfortran.dg/nested_modules_3.f90 b/gcc/testsuite/gfortran.dg/nested_modules_3.f90
new file mode 100644
index 000000000..7550368bc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_modules_3.f90
@@ -0,0 +1,57 @@
+! { dg-do run }
+!
+! This tests the improved version of the patch for PR16861.  Testing
+! after committing the first version, revealed that this test did
+! not work but was not regtested for, either.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+MODULE foo
+  TYPE type1
+    INTEGER i1
+  END TYPE type1
+END MODULE
+
+MODULE bar
+CONTAINS
+  SUBROUTINE sub1 (x, y)
+    USE foo
+    TYPE (type1)  :: x
+    INTEGER  :: y(x%i1)
+    y = 1
+  END SUBROUTINE SUB1
+  SUBROUTINE sub2 (u, v)
+    USE foo
+    TYPE (type1)  :: u
+    INTEGER  :: v(u%i1)
+    v = 2
+  END SUBROUTINE SUB2
+END MODULE
+
+MODULE foobar
+  USE foo
+  USE bar
+CONTAINS
+  SUBROUTINE sub3 (s, t)
+    USE foo
+    TYPE (type1)  :: s
+    INTEGER  :: t(s%i1)
+    t = 3
+  END SUBROUTINE SUB3
+END MODULE foobar
+
+PROGRAM use_foobar
+  USE foo
+  USE foobar
+  INTEGER :: j(3) = 0
+  TYPE (type1)   :: z
+  z%i1 = 3
+  CALL sub1 (z, j)
+  z%i1 = 2
+  CALL sub2 (z, j)
+  z%i1 = 1
+  CALL sub3 (z, j)
+  IF (ALL (j.ne.(/3,2,1/))) CALL abort ()
+END PROGRAM use_foobar
+
+! { dg-final { cleanup-modules "foo bar foobar" } }
diff --git a/gcc/testsuite/gfortran.dg/nested_modules_4.f90 b/gcc/testsuite/gfortran.dg/nested_modules_4.f90
new file mode 100644
index 000000000..6be77b367
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_modules_4.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! Test for the fix to PR24409 - the name clash between the module
+! name and the interface formal argument would cause an ICE.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module string 
+  interface
+    function  lc(string )
+      character(len=*), intent(in)  :: string 
+      character(len=len(string ))    :: lc
+    end function lc
+  end interface
+end module string
+
+module serial
+  use string
+end module serial
+
+  use serial
+  use string
+  character*15  :: buffer  
+  buffer = lc ("Have a Nice DAY")
+  end
+
+! { dg-final { cleanup-modules "string serial" } }
diff --git a/gcc/testsuite/gfortran.dg/nested_modules_5.f90 b/gcc/testsuite/gfortran.dg/nested_modules_5.f90
new file mode 100644
index 000000000..2ed68244e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_modules_5.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! Test for supplementary fix to PR24409 - the name clash between the module
+! variable and the interface formal argument would cause an ICE.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module anything 
+  interface
+    function  lc(string )
+      character(len=*), intent(in)  :: string 
+      character(len=len(string ))    :: lc
+    end function lc
+  end interface
+  character(len=12) :: string
+end module anything
+
+module serial
+  use anything
+end module serial
+
+  use serial
+  use anything
+  character*15  :: buffer  
+  buffer = lc ("Have a Nice DAY")
+  end
+
+! { dg-final { cleanup-modules "anything serial" } }
diff --git a/gcc/testsuite/gfortran.dg/nested_modules_6.f90 b/gcc/testsuite/gfortran.dg/nested_modules_6.f90
new file mode 100644
index 000000000..ab9cc2e80
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_modules_6.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! Test the patch for PR30084 in which the reference to SIZE
+! in function diag caused a segfault in module.c.
+!
+! Contributed by Troban Trumsko <trumsko@yahoo.com>
+! and reduced by Steve Kargl <kargl@gcc.gnu.org>
+!
+module tao_random_numbers
+  integer, dimension(10) :: s_buffer
+  integer :: s_last = size (s_buffer)
+end module tao_random_numbers
+
+module linalg
+  contains
+  function diag (a) result (d)
+    real, dimension(:,:), intent(in) :: a
+    real, dimension(min(size(a,dim=1),size(a,dim=2))) :: d
+    integer :: i
+    do i = 1, min(size(a, dim = 1), size(a, dim = 2))
+       d(i) = a(i,i)
+    end do
+  end function diag
+end module linalg
+
+module vamp_rest
+  use tao_random_numbers
+  use linalg
+end module vamp_rest
+
+  use vamp_rest
+  real :: x(2, 2) = reshape ([1.,2.,3.,4.], [2,2])
+  print *, s_last
+  print *, diag (x)
+end
+! { dg-final { cleanup-modules "tao_random_numbers linalg vamp_rest" } }
diff --git a/gcc/testsuite/gfortran.dg/nested_reshape.f90 b/gcc/testsuite/gfortran.dg/nested_reshape.f90
new file mode 100644
index 000000000..d71e4ecc1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_reshape.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! PR 20436: This used to give a runtime error.
+program nested_reshape
+  implicit none
+  real :: k(8,2)
+  real :: o(8,2)
+
+  k = reshape((/1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0, &
+            9.0,10.0,11.0,12.0,13.0,14.0,15.0,16.0/), (/8,2/))
+
+  o = reshape(reshape(k, (/2,8/), order=(/2,1/)), (/8,2/))
+end program
diff --git a/gcc/testsuite/gfortran.dg/nesting_1.f90 b/gcc/testsuite/gfortran.dg/nesting_1.f90
new file mode 100644
index 000000000..51ebfd999
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nesting_1.f90
@@ -0,0 +1,18 @@
+! PR 18525
+! we used to incorrectly refer to n from a when resolving the call to
+! c from b
+! { dg-do run }
+subroutine a(n)
+call b(n+1)
+contains
+  subroutine b(n)
+    call c(n)
+  end subroutine b
+
+  subroutine c(m)
+    if (m/=1) call abort
+  end subroutine c
+end subroutine a
+
+call a(0)
+end
diff --git a/gcc/testsuite/gfortran.dg/nesting_2.f90 b/gcc/testsuite/gfortran.dg/nesting_2.f90
new file mode 100644
index 000000000..a260c04c7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nesting_2.f90
@@ -0,0 +1,16 @@
+! check to make the nested function dawsonseries_v gets the correct
+! fake return decl and that the outer (dawson_v) has an assignment of
+! just the fake return decl for real and not the inner's return decl.
+! { dg-do compile }
+FUNCTION dawson_v()
+  IMPLICIT NONE
+  REAL  :: dawson_v
+  dawson_v = 1.0
+
+  CONTAINS
+    FUNCTION dawsonseries_v()
+      IMPLICIT NONE
+      REAL, DIMENSION(1) :: dawsonseries_v
+      dawsonseries_v=1.0
+    END FUNCTION dawsonseries_v
+END FUNCTION dawson_v
diff --git a/gcc/testsuite/gfortran.dg/nesting_3.f90 b/gcc/testsuite/gfortran.dg/nesting_3.f90
new file mode 100644
index 000000000..234f50e20
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nesting_3.f90
@@ -0,0 +1,15 @@
+! check to make the nested function dawsonseries_v gets the correct
+! fake return decl and that the outer (dawson_v) has an assignment of
+! just the fake return decl for real and not the inner's return decl.
+! { dg-do compile }
+FUNCTION dawson_v()
+  IMPLICIT NONE
+  REAL,DIMENSION(1)  :: dawson_v
+  dawson_v = 1.0
+  CONTAINS
+    FUNCTION dawsonseries_v()
+      IMPLICIT NONE
+      REAL, DIMENSION(1) :: dawsonseries_v
+      dawsonseries_v=1.0
+    END FUNCTION dawsonseries_v
+END FUNCTION dawson_v
diff --git a/gcc/testsuite/gfortran.dg/new_line.f90 b/gcc/testsuite/gfortran.dg/new_line.f90
new file mode 100644
index 000000000..aacabc69f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/new_line.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! Checks Fortran 2003's new_line intrinsic function
+! PR fortran/28585
+program new_line_check
+  implicit none
+  character(len=10) :: a1
+  character(len=10) :: a2(2)
+  character(len=10), parameter :: a3 = "1234567890"
+  character(len=10), parameter :: a4(2) = "1234567890"
+  character(len=10), parameter :: a5(2) = repeat("1234567890",2)
+
+  if(achar(10) /= new_line('a')) call abort
+
+  if (iachar(new_line(a1)) /= 10) call abort
+  if (iachar(new_line(a2)) /= 10) call abort
+  if (iachar(new_line(a3)) /= 10) call abort
+  if (iachar(new_line(a4)) /= 10) call abort
+  if (iachar(new_line(a5)) /= 10) call abort
+
+end program new_line_check
diff --git a/gcc/testsuite/gfortran.dg/newunit_1.f90 b/gcc/testsuite/gfortran.dg/newunit_1.f90
new file mode 100644
index 000000000..3a0c0b98c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/newunit_1.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! PR40008 F2008: Add NEWUNIT= for OPEN statement 
+! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+program newunit_1
+  character(len=25) :: str
+  integer(1) :: myunit, myunit2
+  myunit = 25
+  str = "bad"
+  open(newunit=myunit, status="scratch")
+  open(newunit = myunit2, file="newunit_1file")
+  write(myunit,'(e24.15e2)') 1.0d0
+  write(myunit2,*) "abcdefghijklmnop"
+  flush(myunit)
+  rewind(myunit)
+  rewind(myunit2)
+  read(myunit2,'(a)') str
+  if (str.ne." abcdefghijklmnop") call abort
+  close(myunit)
+  close(myunit2, status="delete")
+end program newunit_1
diff --git a/gcc/testsuite/gfortran.dg/newunit_2.f90 b/gcc/testsuite/gfortran.dg/newunit_2.f90
new file mode 100644
index 000000000..b0f797a07
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/newunit_2.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! PR40008 F2008: Add NEWUNIT= for OPEN statement 
+! Check for rejection with pre-F2008 standard.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+program main
+  character(len=25) :: str
+  integer(1) :: myunit
+
+  open (newunit=myunit, file="some_file") ! { dg-error "Fortran 2008" }
+  close (unit=myunit)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/nint_1.f90 b/gcc/testsuite/gfortran.dg/nint_1.f90
new file mode 100644
index 000000000..e487bec8f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nint_1.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+program nint_1
+  if (int(anint(8388609.0)) /= 8388609) call abort
+  if (int(anint(0.49999997)) /= 0) call abort
+  if (nint(8388609.0) /= 8388609) call abort
+  if (nint(0.49999997) /= 0) call abort
+  if (int(dnint(4503599627370497.0d0),8) /= 4503599627370497_8) call abort
+  if (int(dnint(0.49999999999999994d0)) /= 0) call abort
+  if (int(anint(-8388609.0)) /= -8388609) call abort
+  if (int(anint(-0.49999997)) /= 0) call abort
+  if (nint(-8388609.0) /= -8388609) call abort
+  if (nint(-0.49999997) /= 0) call abort
+  if (int(dnint(-4503599627370497.0d0),8) /= -4503599627370497_8) call abort
+  if (int(dnint(-0.49999999999999994d0)) /= 0) call abort
+end program nint_1
diff --git a/gcc/testsuite/gfortran.dg/nint_2.f90 b/gcc/testsuite/gfortran.dg/nint_2.f90
new file mode 100644
index 000000000..7520727f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nint_2.f90
@@ -0,0 +1,52 @@
+! Test that NINT gives right results even in corner cases
+!
+! PR 31202
+! http://gcc.gnu.org/ml/fortran/2005-04/msg00139.html
+!
+! { dg-do run }
+! { dg-xfail-run-if "PR 33271, math library bug" { powerpc-ibm-aix powerpc*-*-linux* *-*-mingw* } { "-O0" } { "" } }
+  real(kind=8) :: a
+  integer(kind=8) :: i1, i2
+  real :: b
+  integer :: j1, j2
+
+  a = nearest(0.5_8,-1.0_8)
+  i2 = nint(nearest(0.5_8,-1.0_8))
+  i1 = nint(a)
+  if (i1 /= 0 .or. i2 /= 0) call abort
+
+  a = 0.5_8
+  i2 = nint(0.5_8)
+  i1 = nint(a)
+  if (i1 /= 1 .or. i2 /= 1) call abort
+
+  a = nearest(0.5_8,1.0_8)
+  i2 = nint(nearest(0.5_8,1.0_8))
+  i1 = nint(a)
+  if (i1 /= 1 .or. i2 /= 1) call abort
+
+  b = nearest(0.5,-1.0)
+  j2 = nint(nearest(0.5,-1.0))
+  j1 = nint(b)
+  if (j1 /= 0 .or. j2 /= 0) call abort
+
+  b = 0.5
+  j2 = nint(0.5)
+  j1 = nint(b)
+  if (j1 /= 1 .or. j2 /= 1) call abort
+
+  b = nearest(0.5,1.0)
+  j2 = nint(nearest(0.5,1.0))
+  j1 = nint(b)
+  if (j1 /= 1 .or. j2 /= 1) call abort
+
+  a = 4503599627370497.0_8
+  i1 = nint(a,kind=8)
+  i2 = nint(4503599627370497.0_8,kind=8)
+  if (i1 /= i2 .or. i1 /= 4503599627370497_8) call abort
+
+  a = -4503599627370497.0_8
+  i1 = nint(a,kind=8)
+  i2 = nint(-4503599627370497.0_8,kind=8)
+  if (i1 /= i2 .or. i1 /= -4503599627370497_8) call abort
+  end
diff --git a/gcc/testsuite/gfortran.dg/no_range_check_1.f90 b/gcc/testsuite/gfortran.dg/no_range_check_1.f90
new file mode 100644
index 000000000..36890866e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/no_range_check_1.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fno-range-check -O0" }
+!
+! This testcase arose from PR 31262
+  integer :: a
+  integer(kind=8) :: b
+  a = -3
+  b = -huge(b) / 7
+  a = a ** 73
+  b = 7894_8 * b - 78941_8
+  if ((-3)**73 /= a) call abort
+  if (7894_8 * (-huge(b) / 7) - 78941_8 /= b) call abort
+
+  a = 1234789786453123
+  if (a - 1234789786453123 /= a - (-426244989)) call abort
+  end
diff --git a/gcc/testsuite/gfortran.dg/no_range_check_2.f90 b/gcc/testsuite/gfortran.dg/no_range_check_2.f90
new file mode 100644
index 000000000..4b45c4c8e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/no_range_check_2.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! { dg-options "-fno-range-check" }
+! PR36515 Integer read a value overflow for an invalid integer.
+! This tests that -fno-range-check allows this legacy behavior at runtime.
+program int_range
+character(25) :: inputline = "-2147483648"
+integer*4 smallest
+read(inputline,100) smallest
+100 format(1i11)
+if (smallest.ne.-2147483648) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/no_unit_error_1.f90 b/gcc/testsuite/gfortran.dg/no_unit_error_1.f90
new file mode 100644
index 000000000..1d69bccb8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/no_unit_error_1.f90
@@ -0,0 +1,7 @@
+! { dg-do run }
+! { dg-shouldfail "UNIT does not exist for FLUSH" }
+! PR28335 Check for error on no unit.
+  close(88)
+  flush(88) ! { dg-output "Specified UNIT in FLUSH is not connected" }
+  end
+
diff --git a/gcc/testsuite/gfortran.dg/noadv_size.f90 b/gcc/testsuite/gfortran.dg/noadv_size.f90
new file mode 100644
index 000000000..a3a88b18c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/noadv_size.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! PR 20774: Handle size parameter for non-advancing I/O correctly
+program main
+  open(77,status='scratch')
+  write(77,'(A)') '123'
+  rewind(77)
+  read(77,'(2I2)',advance='no',iostat=k,size=n) i1,i2
+  if (k >=0) call abort
+  if (n /= 3) call abort
+  if (i1 /= 12 .or. i2 /= 3) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/non_module_public.f90 b/gcc/testsuite/gfortran.dg/non_module_public.f90
new file mode 100644
index 000000000..3201a1598
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/non_module_public.f90
@@ -0,0 +1,5 @@
+! { dg-do compile }
+! PR20837 - A symbol may not be declared PUBLIC or PRIVATE outside a module.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+integer, parameter, public :: i=1 ! { dg-error "outside of the specification part of a module" }
+END
diff --git a/gcc/testsuite/gfortran.dg/nonreturning_statements.f90 b/gcc/testsuite/gfortran.dg/nonreturning_statements.f90
new file mode 100644
index 000000000..6268f7229
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nonreturning_statements.f90
@@ -0,0 +1,25 @@
+! { dg-final { scan-assembler-not "should_be_noreturn" } }
+! PR 17758
+! This checks that non-returning subroutines and statements
+! really don't return by calling non-existing subroutines
+! afterwards.  These calls are supposed to be optimized away, so
+! they won't show up in the generated assembly.
+program main
+  character(len=5) :: c
+  c = '12345'
+  read(unit=c,fmt='(A)') i
+  select case(i)
+     case(1)
+        call abort
+        call abort_should_be_noreturn
+     case(2)
+        stop 65
+        call stop_numeric_should_be_noreturn
+     case(3)
+        stop "foobar"
+        call stop_string_should_be_noreturn
+     case(4)
+        call exit
+        call exit_should_be_noreturn
+     end select
+end program main
diff --git a/gcc/testsuite/gfortran.dg/norm2_1.f90 b/gcc/testsuite/gfortran.dg/norm2_1.f90
new file mode 100644
index 000000000..6d69e6bb4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/norm2_1.f90
@@ -0,0 +1,91 @@
+! { dg-do run }
+!
+! PR fortran/33197
+!
+! Check implementation of L2 norm (Euclidean vector norm)
+!
+implicit none
+
+real :: a(3) = [real :: 1, 2, huge(3.0)]
+real :: b(3) = [real :: 1, 2, 3]
+real :: c(4) = [real :: 1, 2, 3, -1]
+real :: e(0) = [real :: ]
+real :: f(4) = [real :: 0, 0, 3, 0 ]
+
+real :: d(4,1) = RESHAPE ([real :: 1, 2, 3, -1], [4,1])
+real :: g(4,1) = RESHAPE ([real :: 0, 0, 4, -1], [4,1])
+
+! Check compile-time version
+
+if (abs (NORM2 ([real :: 1, 2, huge(3.0)])   - huge(3.0)) &
+    > epsilon(0.0)*huge(3.0)) call abort()
+
+if (abs (SNORM2([real :: 1, 2, huge(3.0)],3) - huge(3.0)) &
+    > epsilon(0.0)*huge(3.0)) call abort()
+
+if (abs (SNORM2([real :: 1, 2, 3],3) - NORM2([real :: 1, 2, 3])) &
+    > epsilon(0.0)*SNORM2([real :: 1, 2, 3],3)) call abort()
+
+if (NORM2([real :: ]) /= 0.0) call abort()
+if (abs (NORM2([real :: 0, 0, 3, 0]) - 3.0) > epsilon(0.0)) call abort()
+
+! Check TREE version
+
+if (abs (NORM2 (a)   - huge(3.0)) &
+    > epsilon(0.0)*huge(3.0)) call abort()
+
+if (abs (SNORM2(b,3) - NORM2(b)) &
+    > epsilon(0.0)*SNORM2(b,3)) call abort()
+
+if (abs (SNORM2(c,4) - NORM2(c)) &
+    > epsilon(0.0)*SNORM2(c,4)) call abort()
+
+if (ANY (abs (abs(d(:,1)) - NORM2(d, 2)) &
+    > epsilon(0.0))) call abort()
+
+! Check libgfortran version
+
+if (ANY (abs (SNORM2(d,4) - NORM2(d, 1)) &
+    > epsilon(0.0)*SNORM2(d,4))) call abort()
+
+if (abs (SNORM2(f,4) - NORM2(f, 1)) &
+    > epsilon(0.0)*SNORM2(d,4)) call abort()
+
+if (ANY (abs (abs(g(:,1)) - NORM2(g, 2)) &
+    > epsilon(0.0))) call abort()
+
+contains
+   ! NORM2 algorithm based on BLAS, cf.
+   ! http://www.netlib.org/blas/snrm2.f
+   REAL FUNCTION SNORM2 (X,n)
+      INTEGER, INTENT(IN) :: n
+      REAL, INTENT(IN) :: X(n)
+
+      REAL :: absXi, scale, SSQ
+      INTEGER :: i
+
+      INTRINSIC :: ABS, SQRT
+
+      IF (N < 1) THEN
+        snorm2 = 0.0
+      ELSE IF (N == 1) THEN
+        snorm2 = ABS(X(1))
+      ELSE
+          scale = 0.0
+          SSQ = 1.0
+
+          DO i = 1, N
+              IF (X(i) /= 0.0) THEN
+                  absXi = ABS(X(i))
+                  IF (scale < absXi) THEN
+                      SSQ = 1.0 + SSQ * (scale/absXi)**2
+                      scale = absXi
+                  ELSE
+                      SSQ = SSQ + (absXi/scale)**2
+                  END IF
+              END IF
+          END DO
+          snorm2 = scale * SQRT(SSQ)
+      END IF
+   END FUNCTION SNORM2
+end
diff --git a/gcc/testsuite/gfortran.dg/norm2_2.f90 b/gcc/testsuite/gfortran.dg/norm2_2.f90
new file mode 100644
index 000000000..d6ad7aa54
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/norm2_2.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
+! PR fortran/33197
+!
+! Check implementation of L2 norm (Euclidean vector norm)
+!
+implicit none
+
+print *, norm2([1, 2]) ! { dg-error "must be REAL" }
+print *, norm2([cmplx(1.0,2.0)]) ! { dg-error "must be REAL" }
+print *, norm2(1.0) ! { dg-error "must be an array" }
+print *, norm2([1.0, 2.0], dim=2) ! { dg-error "not a valid dimension index" }
+end
diff --git a/gcc/testsuite/gfortran.dg/norm2_3.f90 b/gcc/testsuite/gfortran.dg/norm2_3.f90
new file mode 100644
index 000000000..a1a3b3f45
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/norm2_3.f90
@@ -0,0 +1,95 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+!
+!
+! PR fortran/33197
+!
+! Check implementation of L2 norm (Euclidean vector norm)
+!
+implicit none
+
+integer,parameter :: qp = selected_real_kind (precision (0.0d0)+1)
+
+real(qp) :: a(3) = [real(qp) :: 1, 2, huge(3.0_qp)]
+real(qp) :: b(3) = [real(qp) :: 1, 2, 3]
+real(qp) :: c(4) = [real(qp) :: 1, 2, 3, -1]
+real(qp) :: e(0) = [real(qp) :: ]
+real(qp) :: f(4) = [real(qp) :: 0, 0, 3, 0 ]
+
+real(qp) :: d(4,1) = RESHAPE ([real(qp) :: 1, 2, 3, -1], [4,1])
+real(qp) :: g(4,1) = RESHAPE ([real(qp) :: 0, 0, 4, -1], [4,1])
+
+! Check compile-time version
+
+if (abs (NORM2 ([real(qp) :: 1, 2, huge(3.0_qp)])   - huge(3.0_qp)) &
+    > epsilon(0.0_qp)*huge(3.0_qp)) call abort()
+
+if (abs (SNORM2([real(qp) :: 1, 2, huge(3.0_qp)],3) - huge(3.0_qp)) &
+    > epsilon(0.0_qp)*huge(3.0_qp)) call abort()
+
+if (abs (SNORM2([real(qp) :: 1, 2, 3],3) - NORM2([real(qp) :: 1, 2, 3])) &
+    > epsilon(0.0_qp)*SNORM2([real(qp) :: 1, 2, 3],3)) call abort()
+
+if (NORM2([real(qp) :: ]) /= 0.0_qp) call abort()
+if (abs (NORM2([real(qp) :: 0, 0, 3, 0]) - 3.0_qp) > epsilon(0.0_qp)) call abort()
+
+! Check TREE version
+
+if (abs (NORM2 (a)   - huge(3.0_qp)) &
+    > epsilon(0.0_qp)*huge(3.0_qp)) call abort()
+
+if (abs (SNORM2(b,3) - NORM2(b)) &
+    > epsilon(0.0_qp)*SNORM2(b,3)) call abort()
+
+if (abs (SNORM2(c,4) - NORM2(c)) &
+    > epsilon(0.0_qp)*SNORM2(c,4)) call abort()
+
+if (ANY (abs (abs(d(:,1)) - NORM2(d, 2)) &
+    > epsilon(0.0_qp))) call abort()
+
+! Check libgfortran version
+
+if (ANY (abs (SNORM2(d,4) - NORM2(d, 1)) &
+    > epsilon(0.0_qp)*SNORM2(d,4))) call abort()
+
+if (abs (SNORM2(f,4) - NORM2(f, 1)) &
+    > epsilon(0.0_qp)*SNORM2(d,4)) call abort()
+
+if (ANY (abs (abs(g(:,1)) - NORM2(g, 2)) &
+    > epsilon(0.0_qp))) call abort()
+
+contains
+   ! NORM2 algorithm based on BLAS, cf.
+   ! http://www.netlib.org/blas/snrm2.f
+   REAL(qp) FUNCTION SNORM2 (X,n)
+      INTEGER, INTENT(IN) :: n
+      REAL(qp), INTENT(IN) :: X(n)
+
+      REAL(qp) :: absXi, scale, SSQ
+      INTEGER :: i
+
+      INTRINSIC :: ABS, SQRT
+
+      IF (N < 1) THEN
+        snorm2 = 0.0_qp
+      ELSE IF (N == 1) THEN
+        snorm2 = ABS(X(1))
+      ELSE
+          scale = 0.0_qp
+          SSQ = 1.0_qp
+
+          DO i = 1, N
+              IF (X(i) /= 0.0_qp) THEN
+                  absXi = ABS(X(i))
+                  IF (scale < absXi) THEN
+                      SSQ = 1.0_qp + SSQ * (scale/absXi)**2
+                      scale = absXi
+                  ELSE
+                      SSQ = SSQ + (absXi/scale)**2
+                  END IF
+              END IF
+          END DO
+          snorm2 = scale * SQRT(SSQ)
+      END IF
+   END FUNCTION SNORM2
+end
diff --git a/gcc/testsuite/gfortran.dg/norm_4.f90 b/gcc/testsuite/gfortran.dg/norm_4.f90
new file mode 100644
index 000000000..276b1743f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/norm_4.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/33197
+!
+! Check implementation of L2 norm (Euclidean vector norm)
+!
+implicit none
+
+print *, norm2([1.0, 2.0]) ! { dg-error "has no IMPLICIT type" }
+end
diff --git a/gcc/testsuite/gfortran.dg/nosigned_zero_1.f90 b/gcc/testsuite/gfortran.dg/nosigned_zero_1.f90
new file mode 100644
index 000000000..51ac87945
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nosigned_zero_1.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+!
+! PR fortran/40675
+!
+! Fortran 77 just had: "The value of a signed zero is the same as
+! the value of an unsigned zero." and g77 returned for SIGN(1.0, -0.0) = 1.0
+!
+! Fortran 95+ has for SIGN: "Case  (iv):  If B is of type real and is zero,
+! then ... (c) If B is negative real zero, the value of the result is -|A|".
+! On architectures, where signed zeros are supported, gfortran's SIGN thus
+! returns for B=-0.0 the -|A|.
+!
+program s
+   x = sign(1.,0.)
+   y = sign(1.,-0.)
+   if (x /=  1.) call abort()
+   if (y /= -1.) call abort()
+   x = 1.
+   y = 0.
+   x = sign(x, y)
+   y = sign(x, -y)
+   if (x /=  1.) call abort()
+   if (y /= -1.) call abort()
+end program s
diff --git a/gcc/testsuite/gfortran.dg/nosigned_zero_2.f90 b/gcc/testsuite/gfortran.dg/nosigned_zero_2.f90
new file mode 100644
index 000000000..af05574ed
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nosigned_zero_2.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fno-sign-zero" }
+!
+! PR fortran/40675
+!
+! Fortran 77 just had: "The value of a signed zero is the same as
+! the value of an unsigned zero." and g77 returned for SIGN(1.0, -0.0) = 1.0
+!
+! Fortran 95+ has for SIGN: "Case  (iv):  If B is of type real and is zero,
+! then ... (c) If B is negative real zero, the value of the result is -|A|".
+! On architectures, where signed zeros are supported, gfortran's SIGN thus
+! returns for B=-0.0 the -|A|.
+!
+program s
+   x = sign(1.,0.)
+   y = sign(1.,-0.)
+   if (x /= 1.) call abort()
+   if (y /= 1.) call abort()
+   x = 1.
+   y = 0.
+   x = sign(x, y)
+   y = sign(x, -y)
+   if (x /= 1.) call abort()
+   if (y /= 1.) call abort()
+end program s
diff --git a/gcc/testsuite/gfortran.dg/null_1.f90 b/gcc/testsuite/gfortran.dg/null_1.f90
new file mode 100644
index 000000000..d367bb3de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/null_1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! PR fortran/20858
+! If we have "x = null(i)", then "null()" acquires the type, kind type,
+! and rank of i and these need to match those of x.
+program null_1
+   integer, parameter :: sp = kind(1.e0), dp = kind(1.d0)
+   integer,  pointer :: i => null()
+   real(sp), pointer :: x => null()
+   real(dp), pointer :: y => null()
+   real(sp), pointer :: z(:) => null()
+   x => null(i)     ! { dg-error "types in pointer assignment" }
+   x => null(y)     ! { dg-error "types in pointer assignment" }
+   z => null(i)     ! { dg-error "types in pointer assignment" }
+   z => null(y)     ! { dg-error "types in pointer assignment" }
+   x => null(z)     ! { dg-error "ranks in pointer assignment" }
+   z => null(x)     ! { dg-error "ranks in pointer assignment" }
+   z => null(z)
+   nullify(i, x, y, z)
+end program null_1
diff --git a/gcc/testsuite/gfortran.dg/null_2.f90 b/gcc/testsuite/gfortran.dg/null_2.f90
new file mode 100644
index 000000000..3102aad62
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/null_2.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+! NULL(...) pointer is not allowed as operand
+! PR fortran/20888
+!
+! Contributed by Joost VandeVondele
+!
+PROGRAM main
+  IMPLICIT NONE
+  REAL, POINTER :: TEST
+  NULLIFY(TEST)
+  TEST => -NULL(TEST) ! { dg-error "Invalid context for NULL" }
+  IF (TEST .EQ. NULL(TEST)) TEST=>NULL() ! { dg-error "Invalid context for NULL" }
+  IF (NULL(TEST) .EQ. TEST) TEST=>NULL() ! { dg-error "Invalid context for NULL" }
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/null_3.f90 b/gcc/testsuite/gfortran.dg/null_3.f90
new file mode 100644
index 000000000..141af1f5b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/null_3.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! This checks the fix for PR34813 in which the error at line 17
+! was not detected.
+!
+! Contributed by Daniel Franke <dfranke@gcc.gnu.org>
+!
+SUBROUTINE kd_tree_init_default()
+  TYPE :: kd_tree_node
+    INTEGER :: dummy
+  END TYPE
+
+  TYPE :: kd_tree
+    TYPE(kd_tree_node) :: root
+  END TYPE
+
+  TYPE(kd_tree)  :: tree
+  tree = kd_tree(null()) ! { dg-error "neither a POINTER nor ALLOCATABLE" }
+END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/null_4.f90 b/gcc/testsuite/gfortran.dg/null_4.f90
new file mode 100644
index 000000000..dbbb681b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/null_4.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+!
+! PR fortran/42936
+!
+! Contributed by Mat Cross
+!
+PROGRAM PASSES_NULL
+  CALL SUB(NULL())
+CONTAINS
+  SUBROUTINE SUB(I)
+    INTEGER, POINTER :: I(:,:,:)
+    IF (ASSOCIATED (I)) CALL ABORT ()
+  END SUBROUTINE SUB
+END PROGRAM PASSES_NULL
diff --git a/gcc/testsuite/gfortran.dg/null_actual.f90 b/gcc/testsuite/gfortran.dg/null_actual.f90
new file mode 100644
index 000000000..b29e89d48
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/null_actual.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! NULL() actual argument to non-pointer dummies
+!
+
+call f(null()) ! { dg-error "Fortran 2008: Null pointer at .1. to non-pointer dummy" }
+call g(null()) ! { dg-error "Unexpected NULL.. intrinsic at .1. to dummy" }
+call h(null()) ! { dg-error "Unexpected NULL.. intrinsic at .1. to dummy" }
+contains
+subroutine f(x)
+  integer, optional  :: x
+end subroutine f
+subroutine g(x)
+  integer, optional, allocatable  :: x
+end subroutine g
+subroutine h(x)
+  integer :: x
+end subroutine h
+end
diff --git a/gcc/testsuite/gfortran.dg/nullify_1.f b/gcc/testsuite/gfortran.dg/nullify_1.f
new file mode 100644
index 000000000..abf68c969
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nullify_1.f
@@ -0,0 +1,11 @@
+C { dg-do compile }
+C PR 18993 
+C we didn't match the end of statement following NULLIFY ()
+C this lead to weird error messages
+      subroutine ordern( ) 
+      real, pointer :: aux(:,:) 
+C Nullify pointers 
+      nullify(aux)
+C Set default sizes for order N arrays
+      end subroutine ordern
+
diff --git a/gcc/testsuite/gfortran.dg/nullify_2.f90 b/gcc/testsuite/gfortran.dg/nullify_2.f90
new file mode 100644
index 000000000..ebfcb374c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nullify_2.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! PR fortran/25146
+program i
+   implicit none
+   TYPE (a) t1     ! { dg-error "is being used before" }
+   nullify(t1%x)   ! { dg-error "error in NULLIFY" }
+end program
diff --git a/gcc/testsuite/gfortran.dg/nullify_3.f90 b/gcc/testsuite/gfortran.dg/nullify_3.f90
new file mode 100644
index 000000000..7d202a258
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nullify_3.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! { dg-options "-O0 -fbounds-check" }
+! Tests patch for PR29371, in which the null pointer
+! assignment would cause a segfault with the bounds
+! check on.
+!
+! Contributed by Tobias Burnus <tobias.burnus@physik.fu-berlin.de>
+!
+program test
+  implicit none
+  type projector_t
+    real,   pointer :: ket(:, :), bra(:, :)
+  end type projector_t
+
+  type(projector_t),pointer, dimension(:) :: p
+  integer :: stat,i
+  allocate(p(2),stat=stat)
+  do i = 1, 2
+        nullify(p(i)%bra)
+        nullify(p(i)%ket)
+  end do
+  do i = 1, 2
+        if (associated (p(i)%bra)) call abort ()
+        if (associated (p(i)%ket)) call abort ()
+  end do
+end program
diff --git a/gcc/testsuite/gfortran.dg/nullify_4.f90 b/gcc/testsuite/gfortran.dg/nullify_4.f90
new file mode 100644
index 000000000..48dcf72ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nullify_4.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! PR fortran/40246
+!
+! Check error recovery; was crashing before.
+!
+real, pointer :: ptr
+nullify(ptr, mesh%coarser) ! { dg-error "Syntax error in NULLIFY statement" }
+end
diff --git a/gcc/testsuite/gfortran.dg/old_style_init.f90 b/gcc/testsuite/gfortran.dg/old_style_init.f90
new file mode 100644
index 000000000..5319917f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/old_style_init.f90
@@ -0,0 +1,15 @@
+!{ dg-do compile }
+! this routine tests all the execution paths
+! through the routine known as match_old_style_init()
+! it does not make sense in any other context !!
+      subroutine sub1(Z) !{ dg-error "DATA attribute conflicts" }
+      integer Z/10/!{ dg-error "DATA"}
+      end
+      pure function pi(k)
+      integer ,intent(in) :: k
+      integer i / 10 / !{ dg-error "Initialization at " }
+      pi=3.0
+      end function pi
+      subroutine sub2
+      integer I /  /!{ dg-error "Syntax error in DATA" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/oldstyle_1.f90 b/gcc/testsuite/gfortran.dg/oldstyle_1.f90
new file mode 100644
index 000000000..e26c467bf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/oldstyle_1.f90
@@ -0,0 +1,9 @@
+      integer i, j /1/, g/2/, h ! { dg-warning "" "" }
+      integer k, l(3) /2*2,1/   ! { dg-warning "" "" }
+      real pi /3.1416/, e       ! { dg-warning "" "" }
+
+      if (j /= 1) call abort ()
+      if (g /= 2) call abort ()
+      if (any(l /= (/2,2,1/))) call abort ()
+      if (pi /= 3.1416) call abort ()
+      end
diff --git a/gcc/testsuite/gfortran.dg/oldstyle_2.f90 b/gcc/testsuite/gfortran.dg/oldstyle_2.f90
new file mode 100644
index 000000000..8d8402888
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/oldstyle_2.f90
@@ -0,0 +1,4 @@
+! { dg-do compile }
+subroutine foo(i) ! { dg-error "DATA attribute" }
+  integer i /10/
+end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/oldstyle_3.f90 b/gcc/testsuite/gfortran.dg/oldstyle_3.f90
new file mode 100644
index 000000000..dad69568b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/oldstyle_3.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! Suppress the warning about an old-style initializer;
+! { dg-options "" }
+! This tests the fix for PR29052 in which the error below would cause a seg-fault
+! because the locus of the initializer was never set.
+!
+! Contributed by Bud Davis  <bdavis@gcc.gnu.org>
+!
+       character*10 a(4,2) /'aaa','bbb','ccc','ddd'/ ! { dg-error "more variables than values" }
+       end
diff --git a/gcc/testsuite/gfortran.dg/only_clause_main.c b/gcc/testsuite/gfortran.dg/only_clause_main.c
new file mode 100644
index 000000000..2cc6c8dd3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/only_clause_main.c
@@ -0,0 +1,12 @@
+/* this is an f90 function */
+void testOnly(int *cIntPtr);
+
+int main(int argc, char **argv)
+{
+   int myCInt;
+
+   myCInt = -11;
+   testOnly(&myCInt);
+   
+   return 0;
+}/* end main() */
diff --git a/gcc/testsuite/gfortran.dg/open-options-blanks.f b/gcc/testsuite/gfortran.dg/open-options-blanks.f
new file mode 100644
index 000000000..4db31b9e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/open-options-blanks.f
@@ -0,0 +1,9 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR 20163, first half:  Trailing blanks on an option to
+!                        open used to cause an error
+      CHARACTER*8 ST
+      ST = 'SCRATCH '
+      OPEN(UNIT=10,STATUS=ST)
+      END
diff --git a/gcc/testsuite/gfortran.dg/open_access_1.f90 b/gcc/testsuite/gfortran.dg/open_access_1.f90
new file mode 100644
index 000000000..95466177f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/open_access_1.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+
+  real :: a
+  a = 6.0
+  open (unit = 6, file = 'foo', access = a) ! { dg-error "must be of type CHARACTER" }
+end
diff --git a/gcc/testsuite/gfortran.dg/open_access_append_1.f90 b/gcc/testsuite/gfortran.dg/open_access_append_1.f90
new file mode 100644
index 000000000..8dae32796
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/open_access_append_1.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! Testcase for the GNU extension OPEN(...,ACCESS="APPEND")
+  open (10,file="foo")
+  close (10,status="delete")
+
+  open (10,file="foo",access="append") ! { dg-warning "Extension: ACCESS specifier in OPEN statement" }
+  write (10,*) 42
+  close (10,status="keep")
+  open (10,file="foo",access="append") ! { dg-warning "Extension: ACCESS specifier in OPEN statement" }
+  write (10,*) -42
+  close (10,status="keep")
+
+  open (10,file="foo")
+  read (10,*) i
+  if (i /= 42) call abort
+  read (10,*) i
+  if (i /= -42) call abort
+  close (10,status="delete")
+
+  end
+! { dg-output ".*Extension.*Extension" } 
diff --git a/gcc/testsuite/gfortran.dg/open_access_append_2.f90 b/gcc/testsuite/gfortran.dg/open_access_append_2.f90
new file mode 100644
index 000000000..3f9dd914d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/open_access_append_2.f90
@@ -0,0 +1,6 @@
+! { dg-do run }
+! Testcase for the GNU extension OPEN(...,ACCESS="APPEND")
+  open (10,err=900,access="append",position="asis") ! { dg-warning "Extension: ACCESS specifier in OPEN statement" }
+  call abort
+ 900 end
+! { dg-output ".*Extension.*" }
diff --git a/gcc/testsuite/gfortran.dg/open_dev_null.f90 b/gcc/testsuite/gfortran.dg/open_dev_null.f90
new file mode 100644
index 000000000..00394cb55
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/open_dev_null.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! PR45723 opening /dev/null for appending writes fails
+logical :: thefile
+inquire(file="/dev/null",exist=thefile)
+if (thefile) then
+  open(unit=7,file="/dev/null",position="append")
+  close(7)
+endif
+end
diff --git a/gcc/testsuite/gfortran.dg/open_errors.f90 b/gcc/testsuite/gfortran.dg/open_errors.f90
new file mode 100644
index 000000000..d6f1e4305
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/open_errors.f90
@@ -0,0 +1,39 @@
+! { dg-do run { target { ! { *-*-mingw* *-*-cygwin* spu-*-* } } } }
+! PR30005 Enhanced error messages for OPEN
+! Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+! See PR38956.  Test fails on cygwin when user has Administrator rights
+character(60) :: msg
+character(25) :: n = "temptestfile"
+logical :: there
+inquire(file=n, exist=there)
+if (.not.there) then
+  open(77,file=n,status="new")
+  close(77, status="keep")
+endif
+msg=""
+open(77,file=n,status="new", iomsg=msg, iostat=i)
+if (i == 0) call abort()
+if (msg /= "File 'temptestfile' already exists") call abort()
+
+open(77,file=n,status="old")
+close(77, status="delete")
+open(77,file=n,status="old", iomsg=msg, iostat=i)
+if (i == 0) call abort()
+if (msg /= "File 'temptestfile' does not exist") call abort()
+
+open(77,file="./", iomsg=msg, iostat=i)
+if (msg /= "'./' is a directory" .and. msg /= "Invalid argument") call abort()
+
+open(77,file=n,status="new")
+i = chmod(n, "-w")
+if (i == 0 .and. getuid() /= 0) then
+ close(77, status="keep")
+ open(77,file=n, iomsg=msg, iostat=i, action="write")
+ if (i == 0) call abort()
+ if (msg /= "Permission denied trying to open file 'temptestfile'") call abort()
+endif
+
+i = chmod(n,"+w")
+open(77,file=n, iomsg=msg, iostat=i, action="read")
+close(77, status="delete")
+end
diff --git a/gcc/testsuite/gfortran.dg/open_new.f90 b/gcc/testsuite/gfortran.dg/open_new.f90
new file mode 100644
index 000000000..96edd93c3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/open_new.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! PR 18982:  verifies that opening an existing file with
+!            status="new" is an error
+program main
+  nout = 10
+  open(nout, file="foo.dat", status="replace")     ! make sure foo.dat exists
+  close(nout)
+  open(nout, file="foo.dat", status="new",err=100)
+  call abort                 ! This should never happen
+100 call unlink ("foo.dat")
+end program main
diff --git a/gcc/testsuite/gfortran.dg/open_nounit.f90 b/gcc/testsuite/gfortran.dg/open_nounit.f90
new file mode 100644
index 000000000..8781f6f47
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/open_nounit.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! PR43832 Missing UNIT in OPEN
+  open () ! { dg-error "must have UNIT" }
+  open (file="test") ! { dg-error "must have UNIT" }
+  end
+
diff --git a/gcc/testsuite/gfortran.dg/open_readonly_1.f90 b/gcc/testsuite/gfortran.dg/open_readonly_1.f90
new file mode 100644
index 000000000..87d3ba7a9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/open_readonly_1.f90
@@ -0,0 +1,14 @@
+! { dg-do run { target fd_truncate } }
+! PR19451
+! Writing to a non-empty readonly file caused a segfault.
+! We were still trying to write the EOR after an error ocurred
+program prog
+  open (unit=10, file='PR19451.dat')
+  write (10,*) "Hello World"
+  close (10)
+  open (unit=10, file='PR19451.dat', action="read")
+  write (10,*,err=20) "Hello World"
+  call abort()
+  20 close (10, status='delete')
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/open_status_1.f90 b/gcc/testsuite/gfortran.dg/open_status_1.f90
new file mode 100644
index 000000000..df44a4461
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/open_status_1.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+! Test reopening with io status='old'
+program iostatus
+  open (1, file='foo', status='replace') ! Make sure file exists.
+  open (1, file='foo', status='old')
+  open (1, file='foo', status='old')
+  close (1, status='delete')
+end program iostatus
diff --git a/gcc/testsuite/gfortran.dg/open_status_2.f90 b/gcc/testsuite/gfortran.dg/open_status_2.f90
new file mode 100644
index 000000000..ce0e71bd3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/open_status_2.f90
@@ -0,0 +1,12 @@
+! { dg-do run } 
+! PR 24945
+! Test reopening file without status specifier or with
+! status='unknown'. The standard says that these two must behave
+! identically, but the actual behaviour is processor dependent.
+program open_status_2
+  open(10, file="f", form='unformatted', status='unknown')
+  open(10, file="f", form='unformatted', status='unknown')
+  open(10, file="f", form='unformatted')
+  close(10, status='delete')
+end program open_status_2
+ 
diff --git a/gcc/testsuite/gfortran.dg/open_status_3.f90 b/gcc/testsuite/gfortran.dg/open_status_3.f90
new file mode 100644
index 000000000..e64561952
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/open_status_3.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! PR27704 Incorrect runtime error on multiple OPEN.
+! Test case contribyted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+       OPEN(8, FORM = 'unformatted', STATUS = 'scratch')
+       OPEN(8, FORM = 'unformatted', status = 'scratch')
+       close(8)
+       open(8)
+       open(8, status = 'old')
+       close(8, status="delete")       
+       end
+
diff --git a/gcc/testsuite/gfortran.dg/operator_1.f90 b/gcc/testsuite/gfortran.dg/operator_1.f90
new file mode 100644
index 000000000..1800b68e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/operator_1.f90
@@ -0,0 +1,69 @@
+! { dg-do run }
+! Test the extension of intrinsic operators
+module m1
+ interface operator(*)
+  module procedure f1
+  module procedure f2
+  module procedure f3
+ end interface
+
+ interface operator(.or.)
+  module procedure g1
+ end interface
+
+ interface operator(//)
+  module procedure g1
+ end interface
+
+contains
+
+ function f1(a,b) result (c)
+  integer, dimension(2,2), intent(in) :: a
+  integer, dimension(2), intent(in)   :: b
+  integer, dimension(2)   :: c
+  c = matmul(a,b)
+ end function f1
+ function f2(a,b) result (c)
+  real, dimension(2,2), intent(in) :: a
+  real, dimension(2), intent(in)   :: b
+  real, dimension(2)   :: c
+  c = matmul(a,b)
+ end function f2
+ function f3(a,b) result (c)
+  complex, dimension(2,2), intent(in) :: a
+  complex, dimension(2), intent(in)   :: b
+  complex, dimension(2)   :: c
+  c = matmul(a,b)
+ end function f3
+
+ elemental function g1(a,b) result (c)
+   integer, intent(in) :: a, b
+   integer :: c
+   c = a + b
+ end function g1
+
+end module m1
+
+  use m1
+  implicit none
+
+  integer, dimension(2,2) :: ai
+  integer, dimension(2)   :: bi, ci
+  real, dimension(2,2) :: ar
+  real, dimension(2)   :: br, cr
+  complex, dimension(2,2) :: ac
+  complex, dimension(2)   :: bc, cc
+
+  ai = reshape((/-2,-4,7,8/),(/2,2/)) ; bi = 3
+  if (any((ai*bi) /= matmul(ai,bi))) call abort()
+  if (any((ai .or. ai) /= ai+ai)) call abort()
+  if (any((ai // ai) /= ai+ai)) call abort()
+
+  ar = reshape((/-2,-4,7,8/),(/2,2/)) ; br = 3
+  if (any((ar*br) /= matmul(ar,br))) call abort()
+
+  ac = reshape((/-2,-4,7,8/),(/2,2/)) ; bc = 3
+  if (any((ac*bc) /= matmul(ac,bc))) call abort()
+
+end
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/operator_2.f90 b/gcc/testsuite/gfortran.dg/operator_2.f90
new file mode 100644
index 000000000..0e560dad7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/operator_2.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+! Test that we can't override intrinsic operators in invalid ways
+module foo
+
+ interface operator(*)
+  module procedure f1 ! { dg-error "conflicts with intrinsic interface" }
+ end interface
+
+ interface operator(>)
+   module procedure f2 ! { dg-error "conflicts with intrinsic interface" }
+ end interface
+
+ interface operator(/)
+  module procedure f3
+ end interface
+
+contains
+
+ function f1(a,b) result (c)
+  integer, intent(in) :: a
+  integer, dimension(:), intent(in)   :: b
+  integer, dimension(size(b,1))   :: c
+  c = 0
+ end function f1
+
+ function f2(a,b)
+   character(len=*), intent(in) :: a
+   character(len=*), intent(in) :: b
+   logical :: f2
+   f2 = .false.
+ end function f2
+
+ function f3(a,b) result (c)
+  integer, dimension(:,:), intent(in) :: a
+  integer, dimension(:), intent(in)   :: b
+  integer, dimension(size(b,1))   :: c
+  c = 0
+ end function f3
+
+end
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/operator_3.f90 b/gcc/testsuite/gfortran.dg/operator_3.f90
new file mode 100644
index 000000000..e702bf148
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/operator_3.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR fortran/31580
+!
+! Testcase contributed by Tobias Burnus <burnus AT gcc DOT gnu DOT org>
+!
+PROGRAM test
+  real :: a,b
+  if(a .nonex. b) stop       ! { dg-error "Unknown operator" }
+end program
diff --git a/gcc/testsuite/gfortran.dg/operator_4.f90 b/gcc/testsuite/gfortran.dg/operator_4.f90
new file mode 100644
index 000000000..39cd7ebdf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/operator_4.f90
@@ -0,0 +1,100 @@
+! PR 17711 : Verify error message text meets operator in source
+! { dg-do compile }
+
+MODULE mod_t
+  type :: t
+    integer :: x
+  end type
+
+  INTERFACE OPERATOR(==)
+    MODULE PROCEDURE t_eq
+  END INTERFACE
+
+  INTERFACE OPERATOR(/=)
+    MODULE PROCEDURE t_ne
+  END INTERFACE
+
+  INTERFACE OPERATOR(>)
+    MODULE PROCEDURE t_gt
+  END INTERFACE
+
+  INTERFACE OPERATOR(>=)
+    MODULE PROCEDURE t_ge
+  END INTERFACE
+
+  INTERFACE OPERATOR(<)
+    MODULE PROCEDURE t_lt
+  END INTERFACE
+
+  INTERFACE OPERATOR(<=)
+    MODULE PROCEDURE t_le
+  END INTERFACE
+
+CONTAINS
+  LOGICAL FUNCTION t_eq(this, other)
+    TYPE(t), INTENT(in) :: this, other
+    t_eq = (this%x == other%x)
+  END FUNCTION
+
+  LOGICAL FUNCTION t_ne(this, other)
+    TYPE(t), INTENT(in) :: this, other
+    t_ne = (this%x /= other%x)
+  END FUNCTION
+
+  LOGICAL FUNCTION t_gt(this, other)
+    TYPE(t), INTENT(in) :: this, other
+    t_gt = (this%x > other%x)
+  END FUNCTION
+
+  LOGICAL FUNCTION t_ge(this, other)
+    TYPE(t), INTENT(in) :: this, other
+    t_ge = (this%x >= other%x)
+  END FUNCTION
+
+  LOGICAL FUNCTION t_lt(this, other)
+    TYPE(t), INTENT(in) :: this, other
+    t_lt = (this%x < other%x)
+  END FUNCTION
+
+  LOGICAL FUNCTION t_le(this, other)
+    TYPE(t), INTENT(in) :: this, other
+    t_le = (this%x <= other%x)
+  END FUNCTION
+END MODULE
+
+PROGRAM pr17711
+  USE mod_t
+
+  LOGICAL :: A
+  INTEGER :: B
+  TYPE(t) :: C
+
+  A = (A == B)   ! { dg-error "comparison operator '=='" }
+  A = (A.EQ.B)   ! { dg-error "comparison operator '.eq.'" }
+  A = (A /= B)   ! { dg-error "comparison operator '/='" }
+  A = (A.NE.B)   ! { dg-error "comparison operator '.ne.'" }
+  A = (A <= B)   ! { dg-error "comparison operator '<='" }
+  A = (A.LE.B)   ! { dg-error "comparison operator '.le.'" }
+  A = (A <  B)   ! { dg-error "comparison operator '<'" }
+  A = (A.LT.B)   ! { dg-error "comparison operator '.lt.'" }
+  A = (A >= B)   ! { dg-error "comparison operator '>='" }
+  A = (A.GE.B)   ! { dg-error "comparison operator '.ge.'" }
+  A = (A >  B)   ! { dg-error "comparison operator '>'" }
+  A = (A.GT.B)   ! { dg-error "comparison operator '.gt.'" }
+
+  ! this should also work with user defined operators
+  A = (A == C)   ! { dg-error "comparison operator '=='" }
+  A = (A.EQ.C)   ! { dg-error "comparison operator '.eq.'" }
+  A = (A /= C)   ! { dg-error "comparison operator '/='" }
+  A = (A.NE.C)   ! { dg-error "comparison operator '.ne.'" }
+  A = (A <= C)   ! { dg-error "comparison operator '<='" }
+  A = (A.LE.C)   ! { dg-error "comparison operator '.le.'" }
+  A = (A <  C)   ! { dg-error "comparison operator '<'" }
+  A = (A.LT.C)   ! { dg-error "comparison operator '.lt.'" }
+  A = (A >= C)   ! { dg-error "comparison operator '>='" }
+  A = (A.GE.C)   ! { dg-error "comparison operator '.ge.'" }
+  A = (A >  C)   ! { dg-error "comparison operator '>'" }
+  A = (A.GT.C)   ! { dg-error "comparison operator '.gt.'" }
+END PROGRAM
+
+! { dg-final { cleanup-modules "mod_t" } }
diff --git a/gcc/testsuite/gfortran.dg/operator_5.f90 b/gcc/testsuite/gfortran.dg/operator_5.f90
new file mode 100644
index 000000000..6ce77c8dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/operator_5.f90
@@ -0,0 +1,51 @@
+! { dg-do compile }
+! { dg-options "-c" }
+
+MODULE mod_t
+  type :: t
+    integer :: x
+  end type
+
+  ! user defined operator
+  INTERFACE OPERATOR(.FOO.)
+    MODULE PROCEDURE t_foo
+  END INTERFACE
+
+  INTERFACE OPERATOR(.FOO.)
+    MODULE PROCEDURE t_foo                  ! { dg-error "already present" }
+  END INTERFACE
+
+  INTERFACE OPERATOR(.FOO.)
+    MODULE PROCEDURE t_bar                  ! { dg-error "Ambiguous interfaces" }
+  END INTERFACE
+
+  ! intrinsic operator
+  INTERFACE OPERATOR(==)
+    MODULE PROCEDURE t_foo
+  END INTERFACE
+
+  INTERFACE OPERATOR(.eq.)
+    MODULE PROCEDURE t_foo                  ! { dg-error "already present" }
+  END INTERFACE
+
+  INTERFACE OPERATOR(==)
+    MODULE PROCEDURE t_bar                  ! { dg-error "Ambiguous interfaces" }
+  END INTERFACE
+
+  INTERFACE OPERATOR(.eq.)
+    MODULE PROCEDURE t_bar                  ! { dg-error "already present" }
+  END INTERFACE
+
+CONTAINS
+  LOGICAL FUNCTION t_foo(this, other)
+    TYPE(t), INTENT(in) :: this, other
+    t_foo = .FALSE.
+  END FUNCTION
+
+  LOGICAL FUNCTION t_bar(this, other)
+    TYPE(t), INTENT(in) :: this, other
+    t_bar = .FALSE.
+  END FUNCTION
+END MODULE
+
+! { dg-final { cleanup-modules "mod_t" } }
diff --git a/gcc/testsuite/gfortran.dg/operator_6.f90 b/gcc/testsuite/gfortran.dg/operator_6.f90
new file mode 100644
index 000000000..f7b4693f5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/operator_6.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+!
+! PR fortran/29876 ICE on bad operator in ONLY clause of USE statement
+! Testcase contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!
+module foo
+end module foo
+
+program test
+  use foo, only : operator(.none.)           ! { dg-error "not found in module" }
+  end program test
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/operator_7.f90 b/gcc/testsuite/gfortran.dg/operator_7.f90
new file mode 100644
index 000000000..66d8dd187
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/operator_7.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! PR fortran/45786 - operators were not correctly marked as public
+! if the alternative form was used.
+! Test case contributed by Neil Carlson.
+module foo_type
+  private
+  public :: foo, operator(==)
+  type :: foo
+    integer :: bar
+  end type
+  interface operator(.eq.)
+    module procedure eq_foo
+  end interface
+contains
+  logical function eq_foo (a, b)
+    type(foo), intent(in) :: a, b
+    eq_foo = (a%bar == b%bar)
+  end function
+end module
+
+ subroutine use_it (a, b)
+  use foo_type
+  type(foo) :: a, b
+  print *, a == b
+end subroutine
+
+! { dg-final { cleanup-modules "foo_type" } }
diff --git a/gcc/testsuite/gfortran.dg/operator_c1202.f90 b/gcc/testsuite/gfortran.dg/operator_c1202.f90
new file mode 100644
index 000000000..c53079ac5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/operator_c1202.f90
@@ -0,0 +1,68 @@
+! { dg-do compile }
+module op
+
+   implicit none
+
+   type a
+      integer i
+   end type a
+
+   type b
+      real i
+   end type b
+
+   interface operator(==)
+      module procedure f1
+   end interface operator(.eq.)
+   interface operator(.eq.)
+      module procedure f2
+   end interface operator(==)
+
+   interface operator(/=)
+      module procedure f1
+   end interface operator(.ne.)
+   interface operator(.ne.)
+      module procedure f2
+   end interface operator(/=)
+
+   interface operator(<=)
+      module procedure f1
+   end interface operator(.le.)
+   interface operator(.le.)
+      module procedure f2
+   end interface operator(<=)
+
+   interface operator(<)
+      module procedure f1
+   end interface operator(.lt.)
+   interface operator(.lt.)
+      module procedure f2
+   end interface operator(<)
+
+   interface operator(>=)
+      module procedure f1
+   end interface operator(.ge.)
+   interface operator(.ge.)
+      module procedure f2
+   end interface operator(>=)
+
+   interface operator(>)
+      module procedure f1
+   end interface operator(.gt.)
+   interface operator(.gt.)
+      module procedure f2
+   end interface operator(>)
+
+   contains
+
+      function f2(x,y)
+         logical f2
+         type(a), intent(in) :: x, y
+      end function f2
+
+      function f1(x,y)
+         logical f1
+         type(b), intent(in) :: x, y
+      end function f1
+
+end module op
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_1.f90 b/gcc/testsuite/gfortran.dg/optional_absent_1.f90
new file mode 100644
index 000000000..690c30fa2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_1.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+!
+! Passing a null pointer or deallocated variable to an
+! optional, non-pointer, non-allocatable dummy.
+!
+program test
+  implicit none
+  integer, pointer :: ps => NULL(), pa(:) => NULL()
+  integer, allocatable :: as, aa(:)
+
+  call scalar(ps) 
+  call scalar(as) 
+  call scalar() 
+  call scalar(NULL())
+
+  call assumed_size(pa) 
+  call assumed_size(aa) 
+  call assumed_size() 
+  call assumed_size(NULL(pa))
+
+  call assumed_shape(pa)
+  call assumed_shape(aa)
+  call assumed_shape()
+  call assumed_shape(NULL())
+
+  call ptr_func(.true., ps)
+  call ptr_func(.true., null())
+  call ptr_func(.false.)
+contains
+  subroutine scalar(a)
+    integer, optional :: a
+    if (present(a)) call abort()
+  end subroutine scalar
+  subroutine assumed_size(a)
+    integer, optional :: a(*)
+    if (present(a)) call abort()
+  end subroutine assumed_size
+  subroutine assumed_shape(a)
+    integer, optional :: a(:)
+    if (present(a)) call abort()
+  end subroutine assumed_shape
+  subroutine ptr_func(is_psnt, a)
+    integer, optional, pointer :: a
+    logical :: is_psnt
+    if (is_psnt .neqv. present(a)) call abort()
+  end subroutine ptr_func
+end program test
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_2.f90 b/gcc/testsuite/gfortran.dg/optional_absent_2.f90
new file mode 100644
index 000000000..717bab7e7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_2.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+!
+! PR fortran/51758
+!
+! Contributed by Mikael Morin
+!
+! Check whether passing NULL() to an elemental procedure works,
+! where NULL() denotes an absent optional argument.
+!
+program p
+
+  integer :: a(2)
+  integer :: b
+
+  a = 0
+  a = foo((/ 1, 1 /), null())
+!  print *, a
+  if (any(a /= 2)) call abort
+
+  a = 0
+  a = bar((/ 1, 1 /), null())
+!  print *, a
+  if (any(a /= 2)) call abort
+
+  b = 0
+  b = bar(1, null())
+!  print *, b
+  if (b /= 2) call abort
+
+contains
+
+  function foo(a, b)
+    integer           :: a(:)
+    integer, optional :: b(:)
+    integer           :: foo(size(a))
+
+    if (present(b)) call abort
+
+    foo = 2
+  end function foo
+
+  elemental function bar(a, b)
+    integer, intent(in)           :: a
+    integer, intent(in), optional :: b
+    integer                       :: bar
+
+    bar = 2
+
+    if (present(b)) bar = 1
+
+  end function bar
+
+end program p
diff --git a/gcc/testsuite/gfortran.dg/optional_assumed_charlen_1.f90 b/gcc/testsuite/gfortran.dg/optional_assumed_charlen_1.f90
new file mode 100644
index 000000000..90631aa61
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_assumed_charlen_1.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! Tests the fix for PR29284 in which an ICE would occur in converting
+! the call to a suboutine with an assumed character length, optional
+! dummy that is not present.
+!
+! Contributed by Rakuen Himawari  <rakuen_himawari@yahoo.co.jp>
+!
+      MODULE foo
+      CONTAINS
+        SUBROUTINE sub1(a)
+          CHARACTER (LEN=*), OPTIONAL :: a
+          WRITE(*,*) 'foo bar'
+        END SUBROUTINE sub1
+
+      SUBROUTINE sub2
+        CALL sub1()
+      END SUBROUTINE sub2
+
+     END MODULE foo
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/optional_dim.f90 b/gcc/testsuite/gfortran.dg/optional_dim.f90
new file mode 100644
index 000000000..dd201fbf4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_dim.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+subroutine foo(a,n)
+  real, dimension(2) :: a
+  integer, optional :: n
+  print *,maxloc(a,dim=n) ! { dg-error "must not be OPTIONAL" }
+  print *,maxloc(a,dim=4) ! { dg-error "is not a valid dimension index" }
+  print *,maxval(a,dim=n) ! { dg-error "must not be OPTIONAL" }
+  print *,maxval(a,dim=4) ! { dg-error "is not a valid dimension index" }
+end subroutine foo
+  
diff --git a/gcc/testsuite/gfortran.dg/optional_dim_2.f90 b/gcc/testsuite/gfortran.dg/optional_dim_2.f90
new file mode 100644
index 000000000..41cbbf542
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_dim_2.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! PR33317 CSHIFT/EOSHIFT: Rejects optional dummy for DIM=
+! Test case submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program test
+ implicit none
+ call sub(bound=.false., dimmy=1_8)
+ call sub()
+contains
+ subroutine sub(bound, dimmy)
+   integer(kind=8), optional :: dimmy
+   logical, optional :: bound
+   logical :: lotto(4)
+   character(20) :: testbuf
+   lotto = .false.
+   lotto = cshift((/.true.,.false.,.true.,.false./),1,dim=dimmy)
+   write(testbuf,*) lotto
+   if (trim(testbuf).ne." F T F T") call abort
+   lotto = .false.
+   lotto = eoshift((/.true.,.true.,.true.,.true./),1,boundary=bound,dim=dimmy)
+   lotto = eoshift(lotto,1,dim=dimmy)
+   write(testbuf,*) lotto
+   if (trim(testbuf).ne." T T F F") call abort
+ end subroutine
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/optional_dim_3.f90 b/gcc/testsuite/gfortran.dg/optional_dim_3.f90
new file mode 100644
index 000000000..45099a307
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_dim_3.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+! PR34540 cshift, eoshift, kind=1 and kind=2 arguments.
+! Test case thanks to Thomas Koenig.
+module tst_foo
+  implicit none
+contains
+  subroutine tst_optional(a,n1,n2)
+    integer(kind=1), intent(in), optional:: n1
+    integer(kind=2), intent(in), optional:: n2
+    integer(kind=1), dimension(2) :: s1
+    character(64) :: testbuf
+    real, dimension(:,:) :: a
+    s1 = (/1, 1/)
+    write(testbuf,'(4F10.2)') cshift(a, shift=s1)
+    if (testbuf /= "      2.00      1.00      4.00      3.00") CALL abort
+    write(testbuf,'(4F10.2)') cshift(a,shift=s1,dim=n2)
+    if (testbuf /= "      2.00      1.00      4.00      3.00") CALL abort
+    write(testbuf,'(4F10.2)') eoshift(a,shift=s1,dim=n1)
+    if (testbuf /= "      2.00      0.00      4.00      0.00") CALL abort
+    write(testbuf,'(4F10.2)') eoshift(a,shift=s1,dim=n2)
+    if (testbuf /= "      2.00      0.00      4.00      0.00") CALL abort
+  end subroutine tst_optional
+ subroutine sub(bound, dimmy)
+   integer(kind=8), optional :: dimmy
+   logical, optional :: bound
+   logical :: lotto(4)
+   character(20) :: testbuf
+   lotto = .false.
+   lotto = cshift((/.true.,.false.,.true.,.false./),1,dim=dimmy)
+   write(testbuf,*) lotto
+   if (trim(testbuf).ne." F T F T") call abort
+   lotto = .false.
+   lotto = eoshift((/.true.,.true.,.true.,.true./),1,boundary=bound,dim=dimmy)
+   lotto = eoshift(lotto,1,dim=dimmy)
+   write(testbuf,*) lotto
+   if (trim(testbuf).ne." T T F F") call abort
+ end subroutine
+end module tst_foo
+
+program main
+  use tst_foo
+  implicit none
+  real, dimension(2,2) :: r
+  integer(kind=1) :: d1
+  integer(kind=2) :: d2
+  data r /1.0, 2.0, 3.0, 4.0/
+  d1 = 1_1
+  d2 = 1_2
+  call tst_optional(r,d1, d2)
+  call sub(bound=.false., dimmy=1_8)
+  call sub()
+end program main
+! { dg-final { cleanup-modules "tst_foo" } }
diff --git a/gcc/testsuite/gfortran.dg/optional_mask.f90 b/gcc/testsuite/gfortran.dg/optional_mask.f90
new file mode 100644
index 000000000..de7bd339b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_mask.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! Bug 45794 - ICE: Segmentation fault in gfc_conv_procedure_call
+subroutine foo (vector, mask)
+  real :: vector(:)
+  logical, optional :: mask(:)
+  integer :: loc(1)
+  if (present(mask)) then
+    loc = maxloc(vector, mask)
+  end if
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/output_exponents_1.f90 b/gcc/testsuite/gfortran.dg/output_exponents_1.f90
new file mode 100644
index 000000000..db47b0bfc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/output_exponents_1.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR 21376
+! we used to take the logarithm of zero in this special case
+  character*10 c
+  write (c,'(e10.4)') 1.0
+  if(c /= "0.1000E+01") call abort
+  write (c,'(e10.4)') 0.0
+  if(c /= "0.0000E+00") call abort
+  write (c,'(e10.4)') 1.0d100
+  if(c /= "0.1000+101") call abort
+  write (c,'(e10.4)') 1.0d-102
+  if(c /= "0.1000-101") call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/overload_1.f90 b/gcc/testsuite/gfortran.dg/overload_1.f90
new file mode 100644
index 000000000..fc38a6c90
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/overload_1.f90
@@ -0,0 +1,184 @@
+! { dg-do run }
+! tests that operator overloading works correctly for operators with
+! different spellings
+module m
+  type t
+     integer :: i
+  end type t
+  
+  interface operator (==)
+     module procedure teq
+  end interface
+
+  interface operator (/=)
+     module procedure tne
+  end interface
+
+  interface operator (>)
+     module procedure tgt
+  end interface
+
+  interface operator (>=)
+     module procedure tge
+  end interface
+  
+  interface operator (<)
+     module procedure tlt
+  end interface
+
+  interface operator (<=)
+     module procedure tle
+  end interface
+
+  type u
+     integer :: i
+  end type u
+  
+  interface operator (.eq.)
+     module procedure ueq
+  end interface
+
+  interface operator (.ne.)
+     module procedure une
+  end interface
+
+  interface operator (.gt.)
+     module procedure ugt
+  end interface
+
+  interface operator (.ge.)
+     module procedure uge
+  end interface
+  
+  interface operator (.lt.)
+     module procedure ult
+  end interface
+
+  interface operator (.le.)
+     module procedure ule
+  end interface
+
+contains
+  function teq (a, b)
+    logical teq
+    type (t), intent (in) :: a, b
+
+    teq = a%i == b%i
+  end function teq
+
+  function tne (a, b)
+    logical tne
+    type (t), intent (in) :: a, b
+
+    tne = a%i /= b%i
+  end function tne
+
+  function tgt (a, b)
+    logical tgt
+    type (t), intent (in) :: a, b
+
+    tgt = a%i > b%i
+  end function tgt
+
+  function tge (a, b)
+    logical tge
+    type (t), intent (in) :: a, b
+
+    tge = a%i >= b%i
+  end function tge
+
+  function tlt (a, b)
+    logical tlt
+    type (t), intent (in) :: a, b
+
+    tlt = a%i < b%i
+  end function tlt
+
+  function tle (a, b)
+    logical tle
+    type (t), intent (in) :: a, b
+
+    tle = a%i <= b%i
+  end function tle
+
+  function ueq (a, b)
+    logical ueq
+    type (u), intent (in) :: a, b
+
+    ueq = a%i == b%i
+  end function ueq
+
+  function une (a, b)
+    logical une
+    type (u), intent (in) :: a, b
+
+    une = a%i /= b%i
+  end function une
+
+  function ugt (a, b)
+    logical ugt
+    type (u), intent (in) :: a, b
+
+    ugt = a%i > b%i
+  end function ugt
+
+  function uge (a, b)
+    logical uge
+    type (u), intent (in) :: a, b
+
+    uge = a%i >= b%i
+  end function uge
+
+  function ult (a, b)
+    logical ult
+    type (u), intent (in) :: a, b
+
+    ult = a%i < b%i
+  end function ult
+
+  function ule (a, b)
+    logical ule
+    type (u), intent (in) :: a, b
+
+    ule = a%i <= b%i
+  end function ule
+end module m
+
+
+program main
+  call checkt
+  call checku
+
+contains
+  
+  subroutine checkt
+    use m
+
+    type (t) :: a, b
+    logical :: r1(6), r2(6)
+    a%i = 0; b%i = 1
+
+    r1 = (/ a == b, a /= b, a <  b, a <= b, a >  b, a >= b /)
+    r2 = (/ a.eq.b, a.ne.b, a.lt.b, a.le.b, a.gt.b, a.ge.b /)
+    if (any (r1.neqv.r2)) call abort
+    if (any (r1.neqv. &
+         (/ .false.,.true.,.true., .true., .false.,.false. /) )) call&
+         & abort
+  end subroutine checkt
+
+  subroutine checku
+    use m
+
+    type (u) :: a, b
+    logical :: r1(6), r2(6)
+    a%i = 0; b%i = 1
+
+    r1 = (/ a == b, a /= b, a <  b, a <= b, a >  b, a >= b /)
+    r2 = (/ a.eq.b, a.ne.b, a.lt.b, a.le.b, a.gt.b, a.ge.b /)
+    if (any (r1.neqv.r2)) call abort
+    if (any (r1.neqv. &
+         (/ .false.,.true.,.true., .true., .false.,.false. /) )) call&
+         & abort
+  end subroutine checku
+end program main
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/overload_2.f90 b/gcc/testsuite/gfortran.dg/overload_2.f90
new file mode 100644
index 000000000..feefb4607
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/overload_2.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! Test the fix for PR32157, in which overloading 'LEN', as
+! in 'test' below would cause a compile error.
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+!
+subroutine len(c)
+  implicit none
+  character :: c
+  c = "X"
+end subroutine len
+
+subroutine test()
+  implicit none
+  character :: str
+  external len
+  call len(str)
+  if(str /= "X") call abort()
+end subroutine test
+
+PROGRAM VAL
+ implicit none
+ external test
+ intrinsic len
+ call test()
+ if(len(" ") /= 1) call abort()
+END
diff --git a/gcc/testsuite/gfortran.dg/overwrite_1.f b/gcc/testsuite/gfortran.dg/overwrite_1.f
new file mode 100644
index 000000000..f6c5fdbd9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/overwrite_1.f
@@ -0,0 +1,20 @@
+! { dg-do run { target fd_truncate } } 
+! PR 19872 - closed and re-opened file not overwriten
+      implicit none
+      integer i(4)
+      data i / 4 * 0 /
+      open(1,form='FORMATTED',status='UNKNOWN')
+      write(1,'("1 2 3 4 5 6 7 8 9")')
+      close(1)
+      open(1,form='FORMATTED')
+      write(1,'("9 8 7 6")')
+      close(1)
+      open(1,form='FORMATTED')
+      read(1,*)i
+      if(i(1).ne.9.and.i(2).ne.8.and.i(3).ne.7.and.i(4).ne.9)call abort
+      read(1,*,end=200)i
+! should only be able to read one line from the file
+      call abort
+ 200  continue
+      close(1,STATUS='DELETE')
+      end
diff --git a/gcc/testsuite/gfortran.dg/pack_assign_1.f90 b/gcc/testsuite/gfortran.dg/pack_assign_1.f90
new file mode 100644
index 000000000..7c480fc36
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pack_assign_1.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! PR32890 - compile-time checks for assigments
+
+INTEGER :: it, neighbrs(42)  ! anything but 30
+
+neighbrs = PACK((/ (it, it=1,30) /), (/ (it, it=1,30) /) < 3, (/ (0,it=1,30) /) )  ! { dg-error "Different shape" }
+
+END
diff --git a/gcc/testsuite/gfortran.dg/pack_bounds_1.f90 b/gcc/testsuite/gfortran.dg/pack_bounds_1.f90
new file mode 100644
index 000000000..d1e185cc4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pack_bounds_1.f90
@@ -0,0 +1,10 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect extent in return value of PACK intrinsic; is 4, should be 5" }
+! PR 30814 - a bounds error with pack was not caught.
+program main
+  integer :: a(2,2), b(5)
+  a = reshape((/ 1, -1, 1, -1 /), shape(a))
+  b = pack(a, a /= 0)
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return value of PACK intrinsic; is 4, should be 5" }
diff --git a/gcc/testsuite/gfortran.dg/pack_mask_1.f90 b/gcc/testsuite/gfortran.dg/pack_mask_1.f90
new file mode 100644
index 000000000..e81d4e76e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pack_mask_1.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! PR 32721 - missing conversion for kind=1 and kind=2 masks for pack
+program main
+  real, dimension(2,2) :: a
+  real, dimension(4) :: b
+  call random_number(a)
+  b = pack(a,logical(a>0,kind=1))
+  b = pack(a,logical(a>0,kind=2))
+end program main
diff --git a/gcc/testsuite/gfortran.dg/pack_vector_1.f90 b/gcc/testsuite/gfortran.dg/pack_vector_1.f90
new file mode 100644
index 000000000..956bb1636
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pack_vector_1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+!
+! Check that the VECTOR argument of the PACK intrinsic has at least
+! as many elements as the MASK has .TRUE. values.
+!
+
+  INTEGER :: res(2)
+  res = PACK ((/ 1, 2, 3 /), (/.TRUE., .TRUE., .FALSE. /), SHAPE(1)) !{ dg-error "must provide at least as many" }
+  res = PACK ((/ 1, 2, 3 /), (/.TRUE., .TRUE., .FALSE. /), (/ -1 /)) !{ dg-error "must provide at least as many" }
+END
diff --git a/gcc/testsuite/gfortran.dg/pad_no.f90 b/gcc/testsuite/gfortran.dg/pad_no.f90
new file mode 100644
index 000000000..c023adec8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pad_no.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! Test correct operation for pad='no'.
+program main
+  character(len=1) line(2)
+  line = 'x'
+  open(77,status='scratch',pad='no')
+  write(77,'(A)') 'a','b'
+  rewind(77)
+  read(77,'(2A)',iostat=i) line(1)
+  if (line(1) /= 'a' .or. line(2) /= 'x') call abort
+  rewind(77)
+  line = 'y'
+  read(77,'(2A)',iostat=i,advance='no') line
+  if (line(1) /= 'a' .or. line(2) /= 'y') call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/parameter_array_dummy.f90 b/gcc/testsuite/gfortran.dg/parameter_array_dummy.f90
new file mode 100644
index 000000000..d9a43432f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_array_dummy.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! PR fortran/31188
+program foo_mod
+  implicit none
+  character (len=1), parameter :: letters(2) = (/"a","b"/)
+  call concat(1, [1])
+  call concat(2, [2])
+  call concat(3, [1,2])
+  call concat(4, [2,1])
+  call concat(5, [2,2,2])
+contains
+  subroutine concat(i, ivec)
+    integer, intent(in)  :: i, ivec(:)
+    write (*,*) i, "a" // letters(ivec)
+  end subroutine concat
+end program foo_mod
+! { dg-output " *1 aa(\n|\r\n|\r)" }
+! { dg-output " *2 ab(\n|\r\n|\r)" }
+! { dg-output " *3 aaab(\n|\r\n|\r)" }
+! { dg-output " *4 abaa(\n|\r\n|\r)" }
+! { dg-output " *5 ababab(\n|\r\n|\r)" }
diff --git a/gcc/testsuite/gfortran.dg/parameter_array_element_1.f90 b/gcc/testsuite/gfortran.dg/parameter_array_element_1.f90
new file mode 100644
index 000000000..f5a33f8b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_array_element_1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+! Tests the fix for PR 30872, in which the array element references bo(1,1) etc.
+! would be wrong for rank > 1.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+ INTEGER, PARAMETER, DIMENSION(2,3) :: bo= &
+                    RESHAPE((/-1,1,-2,2,-3,3/),(/2,3/))
+ REAL(kind=8), DIMENSION(  &
+          bo(1,1):bo(2,1), &
+          bo(1,2):bo(2,2), &
+          bo(1,3):bo(2,3)) :: out_val
+ out_val=0.0
+END
+! Scan for the 105 in the declaration real8 out_val[105];
+! { dg-final { scan-tree-dump-times "105" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/parameter_array_init_1.f90 b/gcc/testsuite/gfortran.dg/parameter_array_init_1.f90
new file mode 100644
index 000000000..bb029a5b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_array_init_1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! tests the fix for PR29397, in which the initializer for the parameter
+! 'J' was not expanded into an array.
+!
+! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!
+  INTEGER :: K(3) = 1
+  INTEGER, PARAMETER :: J(3) = 2
+  IF (ANY (MAXLOC (K, J<3) .NE. 1)) CALL ABORT ()
+  IF (ANY (J .NE. 2)) CALL ABORT ()
+END
diff --git a/gcc/testsuite/gfortran.dg/parameter_array_init_2.f90 b/gcc/testsuite/gfortran.dg/parameter_array_init_2.f90
new file mode 100644
index 000000000..bf238e5ee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_array_init_2.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! { dg-options "-std=gnu" } ! suppress the warning about line 15
+! Thrashes the fix for PR29400, where the scalar initializers
+! were not expanded to arrays with the appropriate shape.
+!
+! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!
+  integer,parameter :: i(1,1) = 0, j(2) = 42

+

+  if (any (maxloc(j+j,mask=(j==2)) .ne. 0)) call abort ()

+  if (size(j+j) .ne. 2) call abort ()

+  if (minval(j+j) .ne. 84) call abort ()

+  if (minval(j,mask=(j==2)) .ne. huge (j)) call abort ()

+  if (maxval(j+j) .ne. 84) call abort ()

+  if (maxval(j,mask=(j==2)) .ne. -huge (j)-1) call abort ()

+  if (sum(j,mask=j==2) .ne. 0) call abort ()

+  if (sum(j+j) .ne. 168) call abort ()

+  if (product(j+j) .ne. 7056) call abort ()

+  if (any(ubound(j+j) .ne. 2)) call abort ()

+  if (any(lbound(j+j) .ne. 1)) call abort ()

+  if (dot_product(j+j,j) .ne. 7056) call abort ()

+  if (dot_product(j,j+j) .ne. 7056) call abort ()

+  if (count(i==1) .ne. 0) call abort ()

+  if (any(i==1)) call abort ()

+  if (all(i==1)) call abort ()

+  end

diff --git a/gcc/testsuite/gfortran.dg/parameter_array_init_3.f90 b/gcc/testsuite/gfortran.dg/parameter_array_init_3.f90
new file mode 100644
index 000000000..e39da8e80
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_array_init_3.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! Test the fix for PR34476 in which an 'out of bounds' error would be
+! generated for the array initializations AND the implicit index 'i'
+! would be rejected.
+!
+! Reported by Tobias Burnus <burnus@gcc.gnu.org> following a thread
+! on comp.lang.fortran (see PR)
+!
+module abuse_mod
+   implicit none
+   integer i
+   character(8), parameter :: HEX1 = '40490FDB'
+   integer(1), parameter :: MSKa1(len(HEX1)) =  [(1,i=1,len(HEX1))]
+   integer(1), parameter :: ARR1(len(HEX1)) = [( MSKa1(i), i=1,len(HEX1) )]
+end module abuse_mod
+! { dg-final { cleanup-modules "abuse_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/parameter_array_init_4.f90 b/gcc/testsuite/gfortran.dg/parameter_array_init_4.f90
new file mode 100644
index 000000000..f6c2f84b2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_array_init_4.f90
@@ -0,0 +1,55 @@
+! { dg-do run }
+! PR fortran/36476
+!
+IMPLICIT NONE
+CHARACTER (len=*) MY_STRING(1:3), my_string_s
+PARAMETER ( MY_STRING = (/ "A" , "B", "C" /) )
+PARAMETER ( MY_STRING_S = "AB C" )
+character(len=*), parameter :: str(2) = [ 'Ac','cc']
+character(len=*), parameter :: str_s = 'Acc'
+
+CHARACTER (kind=1,len=*) MY_STRING1(1:3), my_string_s1
+PARAMETER ( MY_STRING1 = (/ "A" , "B", "C" /) )
+PARAMETER ( MY_STRING_S1 = "AB C" )
+character(kind=1,len=*), parameter :: str1(2) = [ 1_'Ac',1_'cc']
+character(kind=1,len=*), parameter :: str_s1 = 'Acc'
+
+CHARACTER (kind=4,len=*) MY_STRING4(1:3), my_string_s4
+PARAMETER ( MY_STRING4 = (/ 4_"A" , 4_"B", 4_"C" /) )
+PARAMETER ( MY_STRING_S4 = 4_"AB C" )
+character(kind=4,len=*), parameter :: str4(2) = [ 4_'Ac',4_'cc']
+character(kind=4,len=*), parameter :: str_s4 = 4_'Acc'
+
+if(len(MY_STRING)   /= 1) call abort()
+if(    MY_STRING(1) /= "A" &
+   .or.MY_STRING(2) /= "B" &
+   .or.MY_STRING(3) /= "C") call abort()
+if(len(MY_STRING_s)  /= 4) call abort()
+if(MY_STRING_S /= "AB C") call abort()
+if(len(str)        /= 2) call abort()
+if(str(1) /= "Ac" .or. str(2) /=  "cc") call abort()
+if(len(str_s)      /= 3) call abort()
+if(str_s /= 'Acc') call abort()
+
+if(len(MY_STRING1) /= 1) call abort()
+if(    MY_STRING1(1) /= 1_"A" &
+   .or.MY_STRING1(2) /= 1_"B" &
+   .or.MY_STRING1(3) /= 1_"C") call abort()
+if(len(MY_STRING_s1)  /= 4) call abort()
+if(MY_STRING_S1 /= 1_"AB C") call abort()
+if(len(str1)       /= 2) call abort()
+if(str1(1) /= 1_"Ac" .or. str1(2) /=  1_"cc") call abort()
+if(len(str_s1)     /= 3) call abort()
+if(str_s1 /= 1_'Acc') call abort()
+
+if(len(MY_STRING4) /= 1) call abort()
+if(    MY_STRING4(1) /= 4_"A" &
+   .or.MY_STRING4(2) /= 4_"B" &
+   .or.MY_STRING4(3) /= 4_"C") call abort()
+if(len(MY_STRING_s4)  /= 4) call abort()
+if(MY_STRING_S4 /= 4_"AB C") call abort()
+if(len(str4)       /= 2) call abort()
+if(str4(1) /= 4_"Ac" .or. str4(2) /=  4_"cc") call abort()
+if(len(str_s4)     /= 3) call abort()
+if(str_s4 /= 4_'Acc') call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/parameter_array_init_5.f90 b/gcc/testsuite/gfortran.dg/parameter_array_init_5.f90
new file mode 100644
index 000000000..2977b88af
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_array_init_5.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+!
+! PR fortran/41515
+! Contributed by ros@rzg.mpg.de.
+!
+! Before, the "parm' string array was never initialized.
+!
+Module BUG3
+contains
+    Subroutine SR
+    character(3)   :: parm(5)
+    character(20)  :: str
+    parameter(parm=(/'xo ','yo ','ag ','xr ','yr '/))
+
+    str =    'XXXXXXXXXXXXXXXXXXXX'
+    if(str /='XXXXXXXXXXXXXXXXXXXX') call abort()
+    write(str,*) parm
+    if(str /= ' xo yo ag xr yr') call abort()
+    end subroutine SR
+end Module BUG3
+!
+program TEST
+    use bug3
+    call sr
+end program TEST
+! { dg-final { cleanup-modules "bug3" } }
diff --git a/gcc/testsuite/gfortran.dg/parameter_array_init_6.f90 b/gcc/testsuite/gfortran.dg/parameter_array_init_6.f90
new file mode 100644
index 000000000..9a654db3f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_array_init_6.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+!
+! PR fortran/44742
+!
+! Test case based on Juergen Reuter's and reduced by
+! Janus Weil.
+!
+! The program creates a large array constructor, which
+! exceeds -fmax-array-constructor - and caused an ICE.
+!
+
+module proc8
+  implicit none
+  integer, parameter :: N = 256
+  logical, dimension(N**2), parameter :: A = .false.
+  logical, dimension(N,N), parameter :: B &
+    = reshape ( (/ A /), (/ N, N /) ) ! { dg-error "array constructor at .1. requires an increase" }
+end module
diff --git a/gcc/testsuite/gfortran.dg/parameter_array_ref_1.f90 b/gcc/testsuite/gfortran.dg/parameter_array_ref_1.f90
new file mode 100644
index 000000000..c22f34377
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_array_ref_1.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+!
+! PR fortran/32906 - Parameter array ... cannot be automatic or assumed shape
+!
+! Testcase contributed by Florian Ladstaedter <flad AT gmx DOT at>
+!
+program test_program
+  integer, parameter :: len = 1
+  integer, parameter :: arr(max(len,1)) = (/1/)
+
+  character(len=*), dimension (1), parameter             :: specStr = (/'string'/)
+  double precision, dimension (size(specStr)), parameter :: specNum = (/99.0d0/)
+end
diff --git a/gcc/testsuite/gfortran.dg/parameter_array_ref_2.f90 b/gcc/testsuite/gfortran.dg/parameter_array_ref_2.f90
new file mode 100644
index 000000000..30f300f37
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_array_ref_2.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! Test the fix for the problems in PR41044
+!
+! Contributed by <ros@rzg.mpg.de>
+! Reduced by Joos VandeVondele <jv244@cam.ac.uk>
+!
+  Subroutine PS_INIT (bkgd, punit, pform, psize, rot90, bbox, clip, eps,  &
+                        caller)
+    type psfd                          ! paper size and frame defaults
+      character(3)                     :: n
+      real                             :: p(2)
+      real                             :: f(4)
+    end type psfd
+    character(4)                       :: fn, orich, pfmt
+    type(psfd), parameter              :: pfd(0:11)=(/  &
+         psfd('   ',(/   0.0,   0.0/),(/200.,120.,800.,560./)), &    ! A0_L
+         psfd('A0 ',(/ 840.9,1189.2/),(/140., 84.,560.,400./)), &    ! A0_P
+         psfd('A1 ',(/ 594.6, 840.9/),(/100., 60.,400.,280./)), &    ! A1_P
+         psfd('A2 ',(/ 420.4, 594.6/),(/ 70., 42.,280.,200./)), &    ! A2_P
+         psfd('A3 ',(/ 297.3, 420.4/),(/ 50., 30.,200.,140./)), &    ! A3_P
+         psfd('A4 ',(/ 210.2, 297.3/),(/ 35., 21.,140.,100./)), &    ! A4_P
+         psfd('A5 ',(/ 148.7, 210.2/),(/ 25., 15.,100., 70./)), &    ! A5_P
+         psfd('A6 ',(/ 105.1, 148.7/),(/ 18., 11., 70., 50./)), &    ! A6_P
+         psfd('   ',(/   0.0,   0.0/),(/ 50., 30.,200.,140./)), &    ! Letter_L
+         psfd('LET',(/ 215.9, 279.4/),(/ 35., 21.,140.,100./)), &    ! Letter_P
+         psfd('   ',(/   0.0,   0.0/),(/ 50., 30.,200.,140./)), &    ! Legal_L
+         psfd('LEG',(/ 215.9, 355.6/),(/ 35., 21.,140.,100./))/)     ! Legal_P
+    if (len_trim(pfmt) > 0) then       ! set paper format
+      idx=sum(maxloc(index(pfd%n,pfmt(1:3))))-1
+    end if
+  end subroutine PS_INIT
+
+! This, additional problem, was posted as comment #8 by Tobias Burnus <burnus@gcc.gnu.org>
+  type t
+    integer :: i
+  end type t
+  type(t), parameter :: a(1) = t(4) ! [t(4)] worked OK
+  real(a(1)%i) :: b
+end
diff --git a/gcc/testsuite/gfortran.dg/parameter_array_section_1.f90 b/gcc/testsuite/gfortran.dg/parameter_array_section_1.f90
new file mode 100644
index 000000000..6c6959332
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_array_section_1.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! Tests the fix for PR29821, which was due to failure to simplify the
+! array section, since the section is not constant, provoking failure
+! to resolve the argument of SUM and therefore to resolve SUM itself.
+!
+! Contributed by Harald Anlauf  <anlauf@gmx.de>
+!
+module gfcbug45
+  implicit none
+contains
+  subroutine foo 
+    real, external :: mysum
+    integer :: i
+    real    :: a
+    real, parameter :: eps(2) = (/ 1, 99 /)
+    i = 1
+    a = sum (eps(i:i+1) * eps)
+    print *, a
+  end subroutine foo
+end module gfcbug45
+  use gfcbug45
+  call foo
+end
+! { dg-final { cleanup-modules "gfcbug45" } }
diff --git a/gcc/testsuite/gfortran.dg/parameter_array_section_2.f90 b/gcc/testsuite/gfortran.dg/parameter_array_section_2.f90
new file mode 100644
index 000000000..aa212c050
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_array_section_2.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! { dg-options "-O" }
+! Test the fix for PR31011 in which the length of the array sections
+! with stride other than unity were incorrectly calculated.
+!
+! Contributed by <terry@chem.gu.se>
+!
+program PotentialMatrix
+ implicit none
+ real(kind=8),dimension(2),parameter::v2=(/1,2/)
+ real(kind=8),dimension(4),parameter::v4=(/1,2,3,4/)
+ if (any (v2*v4(1:3:2) .ne. (/1,6/))) call abort ()
+ if (any (v2*v4(3:1:-2) .ne. (/3,2/))) call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/parameter_save.f90 b/gcc/testsuite/gfortran.dg/parameter_save.f90
new file mode 100644
index 000000000..ea34ea729
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_save.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! PR 20848 - parameter and save should conflict.
+  integer, parameter, save :: x=0 ! { dg-error "conflicts" }
+  integer, save :: y 
+  parameter (y=42)   ! { dg-error "conflicts" }
+end
diff --git a/gcc/testsuite/gfortran.dg/parameter_unused.f90 b/gcc/testsuite/gfortran.dg/parameter_unused.f90
new file mode 100644
index 000000000..86d50851a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_unused.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-Wunused-parameter" }
+!
+! PR fortran/31129 - No warning on unused parameters
+!
+program fred
+integer,parameter :: j = 9     ! { dg-warning "Unused parameter" }
+end
+
diff --git a/gcc/testsuite/gfortran.dg/parens_1.f90 b/gcc/testsuite/gfortran.dg/parens_1.f90
new file mode 100644
index 000000000..91ced3b6d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parens_1.f90
@@ -0,0 +1,8 @@
+! PR 20894
+! { dg-do compile }
+! Originally contributed by Joost VandeVondele
+INTEGER, POINTER :: I,J
+INTEGER :: K
+ALLOCATE(I)
+J=>(I)   ! { dg-error "Pointer assignment target is neither TARGET nor POINTER" }
+END
diff --git a/gcc/testsuite/gfortran.dg/parens_2.f90 b/gcc/testsuite/gfortran.dg/parens_2.f90
new file mode 100644
index 000000000..bc2acd8e7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parens_2.f90
@@ -0,0 +1,11 @@
+! PR 25048
+! { dg-do compile }
+! Originally contributed by Joost VandeVondele
+INTEGER, POINTER :: I
+CALL S1((I)) ! { dg-error "Actual argument for .i. must be a pointer" }
+CONTAINS
+ SUBROUTINE S1(I)
+  INTEGER, POINTER ::I
+ END SUBROUTINE S1
+END
+
diff --git a/gcc/testsuite/gfortran.dg/parens_3.f90 b/gcc/testsuite/gfortran.dg/parens_3.f90
new file mode 100644
index 000000000..47bb75e40
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parens_3.f90
@@ -0,0 +1,48 @@
+! PR 14771
+! { dg-do run }
+! Originally contributed by Walt Brainerd, modified for the testsuite
+      PROGRAM fc107
+
+! Submitted by Walt Brainerd, The Fortran Company
+! GNU Fortran 95 (GCC 4.1.0 20050322 (experimental))
+! Windows XP
+
+! Return value should be 3
+
+      INTEGER I, J, M(2), N(2)
+      integer, pointer :: k
+      integer, target :: l
+      INTEGER TRYME
+
+      interface
+        FUNCTION TRYyou(RTNME,HITME)
+          INTEGER RTNME(2),HITME(2), tryyou(2)
+        END function tryyou
+      end interface
+
+      m = 7
+      l = 5
+      I = 3
+      k => l
+
+      j = tryme((i),i)
+      if (j .ne. 3) call abort ()
+
+      j = tryme((k),k)
+      if (j .ne. 5) call abort ()
+
+      n = tryyou((m),m)
+      if (any(n .ne. 7)) call abort ()
+      END
+
+      INTEGER FUNCTION TRYME(RTNME,HITME)
+      INTEGER RTNME,HITME
+      HITME = 999
+      TRYME = RTNME
+      END
+
+      FUNCTION TRYyou(RTNME,HITME)
+      INTEGER RTNME(2),HITME(2), tryyou(2)
+      HITME = 999
+      TRYyou = RTNME
+      END
diff --git a/gcc/testsuite/gfortran.dg/parens_4.f90 b/gcc/testsuite/gfortran.dg/parens_4.f90
new file mode 100644
index 000000000..1678ce74a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parens_4.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! Fallout from the patch for PR 14771
+! Testcase by Erik Zeek
+program test
+    call bob(5)
+contains
+    subroutine bob(n)
+        integer, intent(in) :: n
+        character(len=n) :: temp1
+        character(len=(n)) :: temp2 ! Fails here
+    end subroutine bob
+end program test
diff --git a/gcc/testsuite/gfortran.dg/parens_5.f90 b/gcc/testsuite/gfortran.dg/parens_5.f90
new file mode 100644
index 000000000..ac631ef08
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parens_5.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! Another case of fallout from the original patch for PR14771
+! Testcase by Erik Zeek
+module para
+contains
+   function bobo(n)
+       integer, intent(in) :: n
+       character(len=(n)) :: bobo ! Used to fail here
+       bobo = "1234567890"
+   end function bobo
+end module para
+
+program test
+   use para
+   implicit none
+   character*5 c
+   c = bobo(5)
+   if (c .ne. "12345") call abort
+end program test
+
+! { dg-final { cleanup-modules "para" } }
diff --git a/gcc/testsuite/gfortran.dg/parens_6.f90 b/gcc/testsuite/gfortran.dg/parens_6.f90
new file mode 100644
index 000000000..6d5ee3b52
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parens_6.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR fortran/33626
+! Types were not always propagated correctly
+  logical(kind=1) :: i, j
+  integer(kind=1) :: a, b
+  character*1 :: c, d
+  if (any( (/ kind(i .and. j), kind(.not. (i .and. j)), kind((a + b)), &
+              kind((42_1)), kind((j .and. i)), kind((.true._1)), &
+              kind(c // d), kind((c) // d), kind((c//d)) /) /= 1 )) call abort()
+  if (any( (/ len(c // d), len((c) // d), len ((c // d)) /) /= 2)) call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/parens_7.f90 b/gcc/testsuite/gfortran.dg/parens_7.f90
new file mode 100644
index 000000000..daf5fdbd1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parens_7.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! PR34432 integer(kind=init_expression) function  is rejected
+module m
+  integer, parameter :: int_t = 4
+end module m
+
+program test
+  print *, test4()
+contains
+
+integer(kind=(int_t)) function test4() ! This failed before patch
+  use m
+  test4 = 345
+end function test4
+
+ 
+end program test
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/parent_result_ref_1.f90 b/gcc/testsuite/gfortran.dg/parent_result_ref_1.f90
new file mode 100644
index 000000000..c1c7c3d76
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parent_result_ref_1.f90
@@ -0,0 +1,19 @@
+! { dg-do run }

+! Tests the fix for PR19546 in which an ICE would result from

+! setting the parent result in a contained procedure. 

+! From the testcase of Francois-Xavier Coudert/Tobias Schlueter

+! 

+function f()

+  integer :: f

+  f = 42

+  call sub ()

+  if (f.eq.1) f = f + 1

+contains

+  subroutine sub

+    if (f.eq.42) f = f - 41

+  end subroutine sub

+end function f

+

+  integer, external :: f

+  if (f ().ne.2) call abort ()

+end

diff --git a/gcc/testsuite/gfortran.dg/parent_result_ref_2.f90 b/gcc/testsuite/gfortran.dg/parent_result_ref_2.f90
new file mode 100644
index 000000000..38a5fdc7b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parent_result_ref_2.f90
@@ -0,0 +1,35 @@
+! { dg-do run }

+! Tests the fix for PR19546 in which an ICE would result from

+! setting the parent result in a contained procedure. 

+! This case tests character results.

+! 

+function f()
+  character(4) :: f
+  f = "efgh"
+  call sub ()
+  if (f.eq."iklm") f = "abcd"
+  call sub ()
+contains
+  subroutine sub
+    f = "wxyz"
+    if (f.eq."efgh") f = "iklm"
+  end subroutine sub
+end function f
+
+function g()              ! { dg-warning "Obsolescent feature" }
+  character(*) :: g
+  g = "efgh"
+  call sub ()
+  if (g.eq."iklm") g = "ABCD"
+  call sub ()
+contains
+  subroutine sub
+    g = "WXYZ"
+    if (g.eq."efgh") g = "iklm"
+  end subroutine sub
+end function g
+
+  character(4), external :: f, g

+  if (f ().ne."wxyz") call abort ()
+  if (g ().ne."WXYZ") call abort ()
+end

diff --git a/gcc/testsuite/gfortran.dg/parent_result_ref_3.f90 b/gcc/testsuite/gfortran.dg/parent_result_ref_3.f90
new file mode 100644
index 000000000..f8e93ff80
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parent_result_ref_3.f90
@@ -0,0 +1,28 @@
+! { dg-do run }

+! Tests the fix for PR19546 in which an ICE would result from

+! setting the parent result in a contained procedure. 

+! Check that parent alternate entry results can be referenced.

+! 

+function f()

+  integer :: f, g

+  f = 42

+  call sub1 ()

+  if (f.eq.1) f = 2

+  return

+entry g()

+  g = 99

+  call sub2 ()
+  if (g.eq.77) g = 33

+contains

+  subroutine sub1

+    if (f.eq.42) f = 1

+  end subroutine sub1

+  subroutine sub2

+    if (g.eq.99) g = g - 22

+  end subroutine sub2

+end function f

+

+  integer, external :: f, g

+  if (f ().ne.2) call abort ()
+  if (g ().ne.33) call abort ()

+end

diff --git a/gcc/testsuite/gfortran.dg/parent_result_ref_4.f90 b/gcc/testsuite/gfortran.dg/parent_result_ref_4.f90
new file mode 100644
index 000000000..174d64569
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parent_result_ref_4.f90
@@ -0,0 +1,24 @@
+! { dg-do run }

+! Tests the fix for PR19546 in which an ICE would result from

+! setting the parent result in a contained procedure. 

+! Check that parent function results can be referenced in modules.

+!
+module m
+contains

+  function f()

+    integer :: f

+    f = 42

+    call sub ()

+    if (f.eq.1) f = f + 1

+  contains

+    subroutine sub

+     if (f.eq.42) f = f - 41

+    end subroutine sub

+  end function f
+end module m

+

+  use m

+  if (f ().ne.2) call abort ()

+end

+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/parity_1.f90 b/gcc/testsuite/gfortran.dg/parity_1.f90
new file mode 100644
index 000000000..05f9537fa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parity_1.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+!
+! PR fortran/33197
+!
+! Check implementation of PARITY
+!
+implicit none
+
+integer :: i
+logical :: Lt(1) = [ .true. ]
+logical :: Lf(1) = [ .false.]
+logical :: Ltf(2) = [ .true., .false. ]
+logical :: Ltftf(4) = [.true., .false., .true.,.false.]
+
+if (parity([logical ::]) .neqv. .false.) call abort()
+if (parity([.true., .false.]) .neqv. .true.) call abort()
+if (parity([.true.]) .neqv. .true.) call abort()
+if (parity([.false.]) .neqv. .false.) call abort()
+if (parity([.true., .false., .true.,.false.]) .neqv. .false.) call abort()
+if (parity(reshape([.true., .false., .true.,.false.],[2,2])) &
+    .neqv. .false.) call abort()
+if (any (parity(reshape([.true., .false., .true.,.false.],[2,2]),dim=1) &
+         .neqv. [.true., .true.])) call abort()
+if (any (parity(reshape([.true., .false., .true.,.false.],[2,2]),dim=2) &
+         .neqv. [.false., .false.])) call abort()
+
+i = 0
+if (parity(Lt(1:i)) .neqv. .false.) call abort()
+if (parity(Ltf) .neqv. .true.) call abort()
+if (parity(Lt) .neqv. .true.) call abort()
+if (parity(Lf) .neqv. .false.) call abort()
+if (parity(Ltftf) .neqv. .false.) call abort()
+if (parity(reshape(Ltftf,[2,2])) &
+    .neqv. .false.) call abort()
+if (any (parity(reshape(Ltftf,[2,2]),dim=1) &
+         .neqv. [.true., .true.])) call abort()
+if (any (parity(reshape(Ltftf,[2,2]),dim=2) &
+         .neqv. [.false., .false.])) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/parity_2.f90 b/gcc/testsuite/gfortran.dg/parity_2.f90
new file mode 100644
index 000000000..5ff11dab9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parity_2.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
+! PR fortran/33197
+!
+! Check implementation of PARITY
+!
+implicit none
+print *, parity([real ::]) ! { dg-error "must be LOGICAL" })
+print *, parity([integer ::]) ! { dg-error "must be LOGICAL" }
+print *, parity([logical ::])
+print *, parity(.true.) ! { dg-error "must be an array" }
+end
diff --git a/gcc/testsuite/gfortran.dg/parity_3.f90 b/gcc/testsuite/gfortran.dg/parity_3.f90
new file mode 100644
index 000000000..88d674d41
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parity_3.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/33197
+!
+! Check implementation of PARITY
+!
+implicit none
+print *, parity([.true.]) ! { dg-error "has no IMPLICIT type" }
+end
diff --git a/gcc/testsuite/gfortran.dg/past_eor.f90 b/gcc/testsuite/gfortran.dg/past_eor.f90
new file mode 100644
index 000000000..e89ed2272
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/past_eor.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! Test of the fix to the bug triggered by NIST fm908.for.
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+program past_eor
+  character(len=82)         ::  buffer
+  real                      ::  a(2), b(2), c(2), d(2), e(2)
+
+  e = (/2.34,2.456/)
+
+! tests 28-31 from fm908.for
+
+  buffer = '  2.34 ,  2.456     2.34 ,  2.456     0.234E01,  2.456E00&
+ &   0.234E+001, 2.456E-000'
+
+  READ (UNIT=buffer,FMT=10) a, b, c, d
+10 FORMAT (2(2(G7.5,1X),2X),2(G10.4E2,1X),1X,2(G11.7E4,1X))
+
+  if (any (a.ne.e).or.any (b.ne.e).or.any (c.ne.e).or.any (d.ne.e)) call abort ()
+
+end program past_eor
+
diff --git a/gcc/testsuite/gfortran.dg/pointer_1.f90 b/gcc/testsuite/gfortran.dg/pointer_1.f90
new file mode 100644
index 000000000..01ad8b951
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_1.f90
@@ -0,0 +1,14 @@
+! Testcase for PR34770
+! { dg-do run }
+  implicit none
+  integer, target :: x(0:12)
+  integer, pointer :: z(:)
+  integer i
+  do i = 0,12
+    x(i) = i
+  enddo
+  z => x
+  do i = 0,12
+    if (x(i) /= i .or. z(i) /= i) call abort
+  enddo
+end
diff --git a/gcc/testsuite/gfortran.dg/pointer_assign_1.f90 b/gcc/testsuite/gfortran.dg/pointer_assign_1.f90
new file mode 100644
index 000000000..cfe8ad170
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_assign_1.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! Tests fix for PR20838 - would ICE with vector subscript in 
+! pointer assignment.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+  integer, parameter, dimension(3) :: i = (/2,1,3/)
+  integer, dimension(3), target   :: tar
+  integer, dimension(2, 3), target   :: tar2
+  integer, dimension(:), pointer  :: ptr
+  ptr => tar
+  ptr => tar(3:1:-1)
+  ptr => tar(i)     ! { dg-error "with vector subscript" }
+  ptr => tar2(1, :)
+  ptr => tar2(2, i) ! { dg-error "with vector subscript" }
+  end
+
diff --git a/gcc/testsuite/gfortran.dg/pointer_assign_2.f90 b/gcc/testsuite/gfortran.dg/pointer_assign_2.f90
new file mode 100644
index 000000000..5f13fb3b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_assign_2.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! PR32361 Type declaration to initialize data in named common
+      BLOCK DATA
+       integer, pointer :: ptr1 => NULL()
+       common / T / ptr1
+      END
diff --git a/gcc/testsuite/gfortran.dg/pointer_assign_3.f90 b/gcc/testsuite/gfortran.dg/pointer_assign_3.f90
new file mode 100644
index 000000000..432d59fff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_assign_3.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! PR32360 Won't compile 'data ptr1 /null ()/' when ptr1 has pointer attribute.
+      integer, pointer :: ptr1
+      data ptr1 /NULL()/
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/pointer_assign_4.f90 b/gcc/testsuite/gfortran.dg/pointer_assign_4.f90
new file mode 100644
index 000000000..faf7c776c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_assign_4.f90
@@ -0,0 +1,66 @@
+! { dg-do run }
+!
+! Verify that the bounds are correctly set when assigning pointers.
+!
+! PR fortran/33139
+!
+program prog
+  implicit none
+  real, target :: a(-10:10)
+  real, pointer :: p(:),p2(:)
+  integer :: i
+  do i = -10, 10
+    a(i) = real(i)
+  end do
+  p  => a
+  p2 => p
+  if((lbound(p, dim=1) /= -10) .or. (ubound(p, dim=1) /= 10)) &
+    call abort()
+  if((lbound(p2,dim=1) /= -10) .or. (ubound(p2,dim=1) /= 10)) &
+    call abort()
+  do i = -10, 10
+    if(p(i) /= real(i)) call abort()
+    if(p2(i) /= real(i)) call abort()
+  end do
+  p => a(:)
+  p2 => p
+  if((lbound(p, dim=1) /= 1) .or. (ubound(p, dim=1) /= 21)) &
+    call abort()
+  if((lbound(p2,dim=1) /= 1) .or. (ubound(p2,dim=1) /= 21)) &
+    call abort()
+  p2 => p(:)
+  if((lbound(p2,dim=1) /= 1) .or. (ubound(p2,dim=1) /= 21)) &
+    call abort()
+  call multdim()
+contains
+  subroutine multdim()
+    real, target, allocatable :: b(:,:,:)
+    real, pointer :: ptr(:,:,:)
+    integer :: i, j, k
+    allocate(b(-5:5,10:20,0:3))
+    do i = 0, 3
+      do j = 10, 20
+        do k = -5, 5
+          b(k,j,i) = real(i+10*j+100*k)
+        end do
+      end do
+    end do
+    ptr => b
+    if((lbound(ptr,dim=1) /= -5) .or. (ubound(ptr,dim=1) /=  5) .or. &
+       (lbound(ptr,dim=2) /= 10) .or. (ubound(ptr,dim=2) /= 20) .or. &
+       (lbound(ptr,dim=3) /=  0) .or. (ubound(ptr,dim=3) /=  3))     &
+      call abort()
+    do i = 0, 3
+      do j = 10, 20
+        do k = -5, 5
+          if(ptr(k,j,i) /= real(i+10*j+100*k)) call abort()
+        end do
+      end do
+    end do
+    ptr => b(:,:,:)
+    if((lbound(ptr,dim=1) /= 1) .or. (ubound(ptr,dim=1) /= 11) .or. &
+       (lbound(ptr,dim=2) /= 1) .or. (ubound(ptr,dim=2) /= 11) .or. &
+       (lbound(ptr,dim=3) /= 1) .or. (ubound(ptr,dim=3) /=  4))     &
+      call abort()
+  end subroutine multdim
+end program prog
diff --git a/gcc/testsuite/gfortran.dg/pointer_assign_5.f90 b/gcc/testsuite/gfortran.dg/pointer_assign_5.f90
new file mode 100644
index 000000000..1994ffebb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_assign_5.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! PR fortran/37580
+
+! See also the pointer_remapping_* tests.
+
+program test
+implicit none
+real, pointer :: ptr1(:), ptr2(:)
+ptr1(1) => ptr2 ! { dg-error "Expected bounds specification" }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/pointer_assign_6.f90 b/gcc/testsuite/gfortran.dg/pointer_assign_6.f90
new file mode 100644
index 000000000..0b4d8f5ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_assign_6.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! PR fortran/37580
+!
+program test
+implicit none
+real, pointer :: ptr1(:), ptr2(:)
+ptr1(1:) => ptr2 ! { dg-error "Fortran 2003: Bounds specification" }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/pointer_assign_7.f90 b/gcc/testsuite/gfortran.dg/pointer_assign_7.f90
new file mode 100644
index 000000000..c85dc72c8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_assign_7.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+!
+! PR 39931: ICE on invalid Fortran 95 code (bad pointer assignment)
+!
+! Contributed by Thomas Orgis <thomas.orgis@awi.de>
+
+program point_of_no_return
+
+implicit none
+
+type face_t
+  integer :: bla
+end type
+
+integer, pointer :: blu
+type(face_t), pointer :: face
+
+allocate(face)
+allocate(blu)
+
+face%bla => blu  ! { dg-error "Non-POINTER in pointer association context" }
+
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/pointer_check_1.f90 b/gcc/testsuite/gfortran.dg/pointer_check_1.f90
new file mode 100644
index 000000000..6d43bf302
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_check_1.f90
@@ -0,0 +1,86 @@
+! { dg-do run }
+! { dg-options "-fcheck=pointer" }
+! { dg-shouldfail "Unassociated/unallocated actual argument" }
+!
+! { dg-output ".*At line 53 .*Allocatable actual argument 'alloc2' is not allocated" }
+!
+! PR fortran/40580
+!
+! Run-time check of passing deallocated/nonassociated actuals
+! to nonallocatable/nonpointer dummies.
+!
+! Check for variable actuals
+!
+
+subroutine test1(a)
+  integer :: a
+  a = 4444
+end subroutine test1
+
+subroutine test2(a)
+  integer :: a(2)
+  a = 4444
+end subroutine test2
+
+subroutine ppTest(f)
+  implicit none
+  external f
+  call f()
+end subroutine ppTest
+
+Program RunTimeCheck
+  implicit none
+  external :: test1, test2, ppTest
+  integer, pointer :: ptr1, ptr2(:)
+  integer, allocatable :: alloc2(:)
+  procedure(), pointer :: pptr
+
+  allocate(ptr1,ptr2(2),alloc2(2))
+  pptr => sub
+  ! OK
+  call test1(ptr1)
+  call test3(ptr1)
+
+  call test2(ptr2)
+  call test2(alloc2)
+  call test4(ptr2)
+  call test4(alloc2)
+  call ppTest(pptr)
+  call ppTest2(pptr)
+
+  ! Invalid 1:
+  deallocate(alloc2)
+  call test2(alloc2)
+!  call test4(alloc2)
+
+  ! Invalid 2:
+   deallocate(ptr1,ptr2)
+   nullify(ptr1,ptr2)
+!   call test1(ptr1)
+!   call test3(ptr1)
+!   call test2(ptr2)
+!   call test4(ptr2)
+
+  ! Invalid 3:
+  nullify(pptr)
+!  call ppTest(pptr)
+  call ppTest2(pptr)
+
+contains
+  subroutine test3(b)
+    integer :: b
+    b = 333
+  end subroutine test3
+  subroutine test4(b)
+    integer :: b(2)
+    b = 333
+  end subroutine test4
+  subroutine sub()
+    print *, 'Hello World'
+  end subroutine sub
+  subroutine ppTest2(f)
+    implicit none
+    procedure(sub) :: f
+    call f()
+  end subroutine ppTest2
+end Program RunTimeCheck
diff --git a/gcc/testsuite/gfortran.dg/pointer_check_11.f90 b/gcc/testsuite/gfortran.dg/pointer_check_11.f90
new file mode 100644
index 000000000..b6aa79ae2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_check_11.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-options "-fcheck=all" }
+!
+! { dg-shouldfail "Pointer check" }
+! { dg-output "Fortran runtime error: Pointer actual argument 'y' is not associated" }
+!
+!
+! PR fortran/50718
+!
+! Was failing (ICE) with -fcheck=pointer if the dummy had the value attribute.
+
+type t
+  integer :: p
+end type t
+
+type(t), pointer :: y => null()
+
+call sub(y) ! Invalid: Nonassociated pointer
+
+contains
+  subroutine sub (x)
+    type(t), value :: x
+  end subroutine
+end
diff --git a/gcc/testsuite/gfortran.dg/pointer_check_12.f90 b/gcc/testsuite/gfortran.dg/pointer_check_12.f90
new file mode 100644
index 000000000..cfef70e59
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_check_12.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options "-fcheck=all" }
+!
+! { dg-shouldfail "Pointer check" }
+! { dg-output "Fortran runtime error: Pointer actual argument 'p' is not associated" }
+!
+! PR fortran/50718
+!
+! Was failing with -fcheck=pointer: Segfault at run time
+
+integer, pointer :: p => null()
+
+call sub2(%val(p)) ! Invalid: Nonassociated pointer
+end
+
+! Not quite correct dummy, but if one uses VALUE, gfortran
+! complains about a missing interface - which we cannot use
+! if we want to use %VAL().
+
+subroutine sub2(p)
+  integer :: p
+end subroutine sub2
diff --git a/gcc/testsuite/gfortran.dg/pointer_check_2.f90 b/gcc/testsuite/gfortran.dg/pointer_check_2.f90
new file mode 100644
index 000000000..2359b4ae8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_check_2.f90
@@ -0,0 +1,86 @@
+! { dg-do run }
+! { dg-options "-fcheck=pointer" }
+! { dg-shouldfail "Unassociated/unallocated actual argument" }
+!
+! { dg-output ".*At line 60.*Pointer actual argument 'ptr1' is not associated" }
+!
+! PR fortran/40580
+!
+! Run-time check of passing deallocated/nonassociated actuals
+! to nonallocatable/nonpointer dummies.
+!
+! Check for variable actuals
+!
+
+subroutine test1(a)
+  integer :: a
+  a = 4444
+end subroutine test1
+
+subroutine test2(a)
+  integer :: a(2)
+  a = 4444
+end subroutine test2
+
+subroutine ppTest(f)
+  implicit none
+  external f
+  call f()
+end subroutine ppTest
+
+Program RunTimeCheck
+  implicit none
+  external :: test1, test2, ppTest
+  integer, pointer :: ptr1, ptr2(:)
+  integer, allocatable :: alloc2(:)
+  procedure(), pointer :: pptr
+
+  allocate(ptr1,ptr2(2),alloc2(2))
+  pptr => sub
+  ! OK
+  call test1(ptr1)
+  call test3(ptr1)
+
+  call test2(ptr2)
+  call test2(alloc2)
+  call test4(ptr2)
+  call test4(alloc2)
+  call ppTest(pptr)
+  call ppTest2(pptr)
+
+  ! Invalid 1:
+  deallocate(alloc2)
+!  call test2(alloc2)
+!  call test4(alloc2)
+
+  ! Invalid 2:
+   deallocate(ptr1,ptr2)
+   nullify(ptr1,ptr2)
+!   call test1(ptr1)
+   call test3(ptr1)
+!   call test2(ptr2)
+!   call test4(ptr2)
+
+  ! Invalid 3:
+  nullify(pptr)
+!  call ppTest(pptr)
+  call ppTest2(pptr)
+
+contains
+  subroutine test3(b)
+    integer :: b
+    b = 333
+  end subroutine test3
+  subroutine test4(b)
+    integer :: b(2)
+    b = 333
+  end subroutine test4
+  subroutine sub()
+    print *, 'Hello World'
+  end subroutine sub
+  subroutine ppTest2(f)
+    implicit none
+    procedure(sub) :: f
+    call f()
+  end subroutine ppTest2
+end Program RunTimeCheck
diff --git a/gcc/testsuite/gfortran.dg/pointer_check_3.f90 b/gcc/testsuite/gfortran.dg/pointer_check_3.f90
new file mode 100644
index 000000000..23596e44e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_check_3.f90
@@ -0,0 +1,86 @@
+! { dg-do run }
+! { dg-options "-fcheck=pointer" }
+! { dg-shouldfail "Unassociated/unallocated actual argument" }
+!
+! { dg-output ".*At line 61.*Pointer actual argument 'ptr2' is not associated" }
+!
+! PR fortran/40580
+!
+! Run-time check of passing deallocated/nonassociated actuals
+! to nonallocatable/nonpointer dummies.
+!
+! Check for variable actuals
+!
+
+subroutine test1(a)
+  integer :: a
+  a = 4444
+end subroutine test1
+
+subroutine test2(a)
+  integer :: a(2)
+  a = 4444
+end subroutine test2
+
+subroutine ppTest(f)
+  implicit none
+  external f
+  call f()
+end subroutine ppTest
+
+Program RunTimeCheck
+  implicit none
+  external :: test1, test2, ppTest
+  integer, pointer :: ptr1, ptr2(:)
+  integer, allocatable :: alloc2(:)
+  procedure(), pointer :: pptr
+
+  allocate(ptr1,ptr2(2),alloc2(2))
+  pptr => sub
+  ! OK
+  call test1(ptr1)
+  call test3(ptr1)
+
+  call test2(ptr2)
+  call test2(alloc2)
+  call test4(ptr2)
+  call test4(alloc2)
+  call ppTest(pptr)
+  call ppTest2(pptr)
+
+  ! Invalid 1:
+  deallocate(alloc2)
+!  call test2(alloc2)
+!  call test4(alloc2)
+
+  ! Invalid 2:
+   deallocate(ptr1,ptr2)
+   nullify(ptr1,ptr2)
+!   call test1(ptr1)
+!   call test3(ptr1)
+   call test2(ptr2)
+!   call test4(ptr2)
+
+  ! Invalid 3:
+  nullify(pptr)
+!  call ppTest(pptr)
+  call ppTest2(pptr)
+
+contains
+  subroutine test3(b)
+    integer :: b
+    b = 333
+  end subroutine test3
+  subroutine test4(b)
+    integer :: b(2)
+    b = 333
+  end subroutine test4
+  subroutine sub()
+    print *, 'Hello World'
+  end subroutine sub
+  subroutine ppTest2(f)
+    implicit none
+    procedure(sub) :: f
+    call f()
+  end subroutine ppTest2
+end Program RunTimeCheck
diff --git a/gcc/testsuite/gfortran.dg/pointer_check_4.f90 b/gcc/testsuite/gfortran.dg/pointer_check_4.f90
new file mode 100644
index 000000000..97eb6fad5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_check_4.f90
@@ -0,0 +1,86 @@
+! { dg-do run }
+! { dg-options "-fcheck=pointer" }
+! { dg-shouldfail "Unassociated/unallocated actual argument" }
+!
+! { dg-output ".*At line 66.*Proc-pointer actual argument 'pptr' is not associated" }
+!
+! PR fortran/40580
+!
+! Run-time check of passing deallocated/nonassociated actuals
+! to nonallocatable/nonpointer dummies.
+!
+! Check for variable actuals
+!
+
+subroutine test1(a)
+  integer :: a
+  a = 4444
+end subroutine test1
+
+subroutine test2(a)
+  integer :: a(2)
+  a = 4444
+end subroutine test2
+
+subroutine ppTest(f)
+  implicit none
+  external f
+  call f()
+end subroutine ppTest
+
+Program RunTimeCheck
+  implicit none
+  external :: test1, test2, ppTest
+  integer, pointer :: ptr1, ptr2(:)
+  integer, allocatable :: alloc2(:)
+  procedure(), pointer :: pptr
+
+  allocate(ptr1,ptr2(2),alloc2(2))
+  pptr => sub
+  ! OK
+  call test1(ptr1)
+  call test3(ptr1)
+
+  call test2(ptr2)
+  call test2(alloc2)
+  call test4(ptr2)
+  call test4(alloc2)
+  call ppTest(pptr)
+  call ppTest2(pptr)
+
+  ! Invalid 1:
+  deallocate(alloc2)
+!  call test2(alloc2)
+!  call test4(alloc2)
+
+  ! Invalid 2:
+   deallocate(ptr1,ptr2)
+   nullify(ptr1,ptr2)
+!   call test1(ptr1)
+!   call test3(ptr1)
+!   call test2(ptr2)
+!   call test4(ptr2)
+
+  ! Invalid 3:
+  nullify(pptr)
+  call ppTest(pptr)
+!  call ppTest2(pptr)
+
+contains
+  subroutine test3(b)
+    integer :: b
+    b = 333
+  end subroutine test3
+  subroutine test4(b)
+    integer :: b(2)
+    b = 333
+  end subroutine test4
+  subroutine sub()
+    print *, 'Hello World'
+  end subroutine sub
+  subroutine ppTest2(f)
+    implicit none
+    procedure(sub) :: f
+    call f()
+  end subroutine ppTest2
+end Program RunTimeCheck
diff --git a/gcc/testsuite/gfortran.dg/pointer_check_5.f90 b/gcc/testsuite/gfortran.dg/pointer_check_5.f90
new file mode 100644
index 000000000..440d9a879
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_check_5.f90
@@ -0,0 +1,100 @@
+! { dg-do run }
+! { dg-options "-fcheck=pointer" }
+! { dg-shouldfail "Unassociated/unallocated actual argument" }
+! 
+! { dg-output ".*At line 46 .*Pointer actual argument 'getptr' is not associated" }
+!
+! PR fortran/40580
+!
+! Run-time check of passing deallocated/nonassociated actuals
+! to nonallocatable/nonpointer dummies.
+!
+! Check for function actuals
+!
+
+subroutine test1(a)
+  integer :: a
+  print *, a
+end subroutine test1
+
+subroutine test2(a)
+  integer :: a(2)
+  print *, a
+end subroutine test2
+
+subroutine ppTest(f)
+  implicit none
+  external f
+  call f()
+end subroutine ppTest
+
+Program RunTimeCheck
+  implicit none
+  external :: test1, test2, ppTest
+  procedure(), pointer :: pptr
+
+  ! OK
+  call test1(getPtr(.true.))
+  call test2(getPtrArray(.true.))
+  call test2(getAlloc(.true.))
+
+  ! OK but fails due to PR 40593
+!  call ppTest(getProcPtr(.true.))
+!  call ppTest2(getProcPtr(.true.))
+
+  ! Invalid:
+  call test1(getPtr(.false.))
+!  call test2(getAlloc(.false.)) - fails because the check is inserted after
+!                                  _gfortran_internal_pack, which fails with out of memory
+!  call ppTest(getProcPtr(.false.)) - fails due to PR 40593
+!  call ppTest2(getProcPtr(.false.)) - fails due to PR 40593
+
+contains
+  function getPtr(alloc)
+    integer, pointer :: getPtr
+    logical, intent(in) :: alloc
+    if (alloc) then
+      allocate (getPtr)
+      getPtr = 1
+    else
+      nullify (getPtr)
+    end if
+  end function getPtr
+  function getPtrArray(alloc)
+    integer, pointer :: getPtrArray(:)
+    logical, intent(in) :: alloc
+    if (alloc) then
+      allocate (getPtrArray(2))
+      getPtrArray = 1
+    else
+      nullify (getPtrArray)
+    end if
+  end function getPtrArray
+  function getAlloc(alloc)
+    integer, allocatable :: getAlloc(:)
+    logical, intent(in) :: alloc
+    if (alloc) then
+      allocate (getAlloc(2))
+      getAlloc = 2
+    else if (allocated(getAlloc)) then
+      deallocate(getAlloc)
+    end if
+  end function getAlloc
+  subroutine sub()
+    print *, 'Hello World'
+  end subroutine sub
+  function getProcPtr(alloc)
+    procedure(sub), pointer :: getProcPtr
+    logical, intent(in) :: alloc
+    if (alloc) then
+      getProcPtr => sub
+    else
+      nullify (getProcPtr)
+    end if
+  end function getProcPtr
+  subroutine ppTest2(f)
+    implicit none
+    procedure(sub) :: f
+    call f()
+  end subroutine ppTest2
+end Program RunTimeCheck
diff --git a/gcc/testsuite/gfortran.dg/pointer_check_6.f90 b/gcc/testsuite/gfortran.dg/pointer_check_6.f90
new file mode 100644
index 000000000..2f7373fe6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_check_6.f90
@@ -0,0 +1,118 @@
+! { dg-do run }
+! { dg-options "-fcheck=pointer" }
+!
+! { dg-shouldfail "pointer check" }
+! { dg-output ".*At line 104 of file .*Fortran runtime error: Pointer actual argument 'a' is not associated.*" }
+!
+! PR fortran/40604
+!
+! The following cases are all valid, but were failing
+! for one or the other reason.
+!
+! Contributed by Janus Weil and Tobias Burnus.
+!
+
+subroutine test1()
+  call test(uec=-1)
+contains 
+  subroutine test(str,uec)
+    implicit none
+    character*(*), intent(in), optional:: str
+    integer, intent(in), optional :: uec
+  end subroutine
+end subroutine test1
+
+module m
+  interface matrixMult
+     Module procedure matrixMult_C2
+  End Interface
+contains
+  subroutine test
+    implicit none
+    complex, dimension(0:3,0:3) :: m1,m2
+    print *,Trace(MatrixMult(m1,m2))
+  end subroutine
+  complex function trace(a)
+    implicit none
+    complex, intent(in),  dimension(0:3,0:3) :: a 
+  end function trace
+  function matrixMult_C2(a,b) result(matrix)
+    implicit none
+    complex, dimension(0:3,0:3) :: matrix,a,b
+  end function matrixMult_C2
+end module m
+
+SUBROUTINE plotdop(amat)
+      IMPLICIT NONE
+      REAL,    INTENT (IN) :: amat(3,3)
+      integer :: i1
+      real :: pt(3)
+      i1 = 1
+      pt = MATMUL(amat,(/i1,i1,i1/))
+END SUBROUTINE plotdop
+
+        FUNCTION evaluateFirst(s,n)result(number)
+          IMPLICIT NONE
+          CHARACTER(len =*), INTENT(inout) :: s
+          INTEGER,OPTIONAL                 :: n
+          REAL                             :: number
+          number = 1.1
+        end function
+
+SUBROUTINE rw_inp(scpos)
+      IMPLICIT NONE
+      REAL scpos
+
+      interface
+        FUNCTION evaluateFirst(s,n)result(number)
+          IMPLICIT NONE
+          CHARACTER(len =*), INTENT(inout) :: s
+          INTEGER,OPTIONAL                 :: n
+          REAL                             :: number
+        end function
+      end interface
+
+      CHARACTER(len=100) :: line
+      scpos = evaluatefirst(line)
+END SUBROUTINE rw_inp
+
+program test
+  integer, pointer :: a
+!  nullify(a)
+  allocate(a)
+  a = 1
+  call sub1a(a)
+  call sub1b(a)
+  call sub1c()
+contains
+  subroutine sub1a(a)
+   integer, pointer :: a
+   call sub2(a)
+   call sub3(a)
+   call sub4(a)
+  end subroutine sub1a
+  subroutine sub1b(a)
+   integer, pointer,optional :: a
+   call sub2(a)
+   call sub3(a)
+   call sub4(a)
+  end subroutine sub1b
+  subroutine sub1c(a)
+   integer, pointer,optional :: a
+   call sub4(a)
+!   call sub2(a)  ! << Invalid - working correctly, but not allowed in F2003
+   call sub3(a) ! << INVALID
+  end subroutine sub1c
+  subroutine sub4(b)
+    integer, optional,pointer :: b
+  end subroutine
+  subroutine sub2(b)
+    integer, optional :: b
+  end subroutine
+  subroutine sub3(b)
+    integer :: b
+  end subroutine
+end
+
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/pointer_check_7.f90 b/gcc/testsuite/gfortran.dg/pointer_check_7.f90
new file mode 100644
index 000000000..0f6dcdc87
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_check_7.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! { dg-options "-fcheck=pointer" }
+!
+! PR 45438: [4.6 Regression] [OOP] ICE with -fcheck=pointer
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+module base_mat_mod
+
+  implicit none 
+
+  type  :: base_sparse_mat
+  contains 
+    procedure :: get_fmt
+  end type
+
+contains
+
+  function get_fmt(a) result(res)
+    class(base_sparse_mat), intent(in) :: a
+    character(len=5) :: res
+    res = 'NULL'
+  end function
+
+  subroutine errlog(name)
+    character(len=*) :: name
+  end subroutine
+
+  subroutine test (a)
+    class(base_sparse_mat), intent(in) :: a
+    call errlog(a%get_fmt())
+  end subroutine
+
+end module
+
+! { dg-final { cleanup-modules "base_mat_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/pointer_check_8.f90 b/gcc/testsuite/gfortran.dg/pointer_check_8.f90
new file mode 100644
index 000000000..99c6652f2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_check_8.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fcheck=pointer" }
+!
+! PR 46809: [OOP] ICE with -fcheck=pointer for CLASS IS
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+  type t
+  end type t
+
+contains
+
+  subroutine sub(a)
+    class(t) :: a
+    select type (a)
+      class is (t)
+        print *, 'Hi there'
+    end select
+  end subroutine
+
+end
diff --git a/gcc/testsuite/gfortran.dg/pointer_comp_init_1.f90 b/gcc/testsuite/gfortran.dg/pointer_comp_init_1.f90
new file mode 100644
index 000000000..44f360e98
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_comp_init_1.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+!
+! PR fortran/50050
+! ICE whilst trying to access NULL shape.
+
+! Reduced from the FoX library http://www1.gly.bris.ac.uk/~walker/FoX/
+! Contributed by Andrew Benson <abenson@its.caltech.edu>
+
+module m_common_attrs
+  implicit none
+
+  type dict_item
+  end type dict_item
+
+  type dict_item_ptr
+     type(dict_item), pointer :: d => null()
+  end type dict_item_ptr
+
+contains
+
+  subroutine add_item_to_dict()
+    type(dict_item_ptr), pointer :: tempList(:)
+    integer :: n
+
+    allocate(tempList(0:n+1)) 
+  end subroutine add_item_to_dict
+
+end module m_common_attrs
+
+! { dg-final { cleanup-modules "m_common_attrs" } }
diff --git a/gcc/testsuite/gfortran.dg/pointer_component_type_1.f90 b/gcc/testsuite/gfortran.dg/pointer_component_type_1.f90
new file mode 100644
index 000000000..b3a4086af
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_component_type_1.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! This checks the fix for PR20889 in wrong pointer types in derived
+! type constructors would either give no message or would segfault.
+!
+! Contributed by Joost VandVondele  <jv244@cam.ac.uk>
+!==============
+  TYPE TEST
+    REAL, POINTER :: A
+  END TYPE
+
+  TYPE TEST1
+    REAL :: A
+  END TYPE
+
+  INTEGER, POINTER :: IP
+  real, POINTER :: RP
+  TYPE(TEST) :: DD
+  TYPE(TEST1) :: EE
+! Next line is the original => gave no warning/error.
+  DD=TEST(NULL(IP))    ! { dg-error "INTEGER but should be REAL" }
+! Would segfault here.
+  DD=TEST(IP)          ! { dg-error "INTEGER but should be REAL" }
+! Check right target type is OK.
+  DD=TEST(NULL(RP))
+! Check non-pointer is OK.
+  EE= TEST1(1)
+! Test attempted conversion from character to real.
+  EE= TEST1("e")       ! { dg-error "convert CHARACTER" }
+END
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/pointer_function_actual_1.f90 b/gcc/testsuite/gfortran.dg/pointer_function_actual_1.f90
new file mode 100644
index 000000000..092411708
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_function_actual_1.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! Tests the fix for PR31209, in which an ICE would result because
+! the reference to the pointer function f would be indirected, as
+! if it were the result that is being passed.
+!
+! COntributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+FUNCTION F() RESULT(RES)
+ INTEGER, POINTER :: RES
+ ALLOCATE(RES)
+ RES=2
+END FUNCTION F
+
+SUBROUTINE S1(f,*,*)
+ INTERFACE
+  FUNCTION F() RESULT(RES)
+   INTEGER, POINTER :: RES
+  END FUNCTION F
+ END INTERFACE
+ RETURN F()
+END SUBROUTINE
+
+PROGRAM TEST
+   INTERFACE
+    FUNCTION F() RESULT(RES)
+     INTEGER, POINTER :: RES
+    END FUNCTION F
+   END INTERFACE
+
+
+   INTERFACE
+    SUBROUTINE S1(f,*,*)
+      INTERFACE
+       FUNCTION F() RESULT(RES)
+        INTEGER, POINTER :: RES
+       END FUNCTION F
+      END INTERFACE
+     END SUBROUTINE
+   END INTERFACE
+
+   CALL S1(F,*1,*2)
+
+   1 CONTINUE
+   CALL ABORT()
+
+   GOTO 3
+   2 CONTINUE
+
+   3 CONTINUE
+END
+
diff --git a/gcc/testsuite/gfortran.dg/pointer_function_actual_2.f90 b/gcc/testsuite/gfortran.dg/pointer_function_actual_2.f90
new file mode 100644
index 000000000..11457ffd9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_function_actual_2.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! Tests the fix for PR31200, in which the target x would
+! not be associated with p
+!
+! COntributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+  REAL,TARGET :: x
+  CALL s3(f(x))
+CONTAINS
+  FUNCTION f(a)
+    REAL,POINTER :: f
+    REAL,TARGET :: a
+    f => a
+  END FUNCTION
+  SUBROUTINE s3(targ)
+    REAL,TARGET :: targ
+    REAL,POINTER :: p
+    p => targ
+    IF (.NOT. ASSOCIATED(p,x)) CALL ABORT()
+  END SUBROUTINE
+END
+
diff --git a/gcc/testsuite/gfortran.dg/pointer_init_1.f90 b/gcc/testsuite/gfortran.dg/pointer_init_1.f90
new file mode 100644
index 000000000..0cfa90381
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_init_1.f90
@@ -0,0 +1,15 @@
+! Check that null initialization of pointer variable works.
+! { dg-do run }
+program pointer_init_1
+  type t
+    real x
+  end type
+  type(t), pointer :: a => NULL()
+  real, pointer :: b => NULL()
+  character, pointer :: c => NULL()
+  integer, pointer, dimension(:) :: d => NULL()
+  if (associated(a)) call abort()
+  if (associated(b)) call abort()
+  if (associated(c)) call abort()
+  if (associated(d)) call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/pointer_init_2.f90 b/gcc/testsuite/gfortran.dg/pointer_init_2.f90
new file mode 100644
index 000000000..8f72663e2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_init_2.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+!
+! PR 45290: [F08] pointer initialization
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+subroutine sub
+  implicit none
+
+  real, target, save :: r
+  integer, target, save, dimension(1:3) :: v
+
+  integer, save :: i
+  integer, target :: j
+  integer, target, save, allocatable :: a
+
+
+  integer, pointer :: dp0 => 13  ! { dg-error "Error in pointer initialization" }
+  integer, pointer :: dp1 => r   ! { dg-error "Different types in pointer assignment" }
+  integer, pointer :: dp2 => v   ! { dg-error "Different ranks in pointer assignment" }
+  integer, pointer :: dp3 => i   ! { dg-error "is neither TARGET nor POINTER" }
+  integer, pointer :: dp4 => j   ! { dg-error "must have the SAVE attribute" }
+  integer, pointer :: dp5 => a   ! { dg-error "must not be ALLOCATABLE" }
+
+  type :: t
+    integer, pointer :: dpc0 => 13  ! { dg-error "Error in pointer initialization" }
+    integer, pointer :: dpc1 => r   ! { dg-error "is REAL but should be INTEGER" }
+    integer, pointer :: dpc2 => v   ! { dg-error "rank of the element.*does not match" }
+    integer, pointer :: dpc3 => i   ! { dg-error "should be a POINTER or a TARGET" }
+    integer, pointer :: dpc4 => j   ! { dg-error "must have the SAVE attribute" }
+    integer, pointer :: dpc5 => a   ! { dg-error "must not be ALLOCATABLE" }
+  end type
+
+  type(t) ::u
+
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/pointer_init_3.f90 b/gcc/testsuite/gfortran.dg/pointer_init_3.f90
new file mode 100644
index 000000000..867a428bf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_init_3.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+!
+! PR 45290: [F08] pointer initialization
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m
+ integer, target  :: t1          ! SAVE is implicit
+ integer, pointer :: p1 => t1
+end module m
+
+
+use m
+implicit none
+
+integer,target :: i0 = 2
+integer,target,dimension(1:3) :: vec = 1
+
+type :: t
+  integer, pointer :: dpc => i0
+  integer :: i = 0
+end type
+
+type (t), save, target :: u
+
+integer, pointer :: dp => i0
+integer, pointer :: dp2 => vec(2)
+integer, pointer :: dp3 => u%i
+
+dp = 5
+if (i0/=5) call abort()
+
+u%dpc = 6
+if (i0/=6) call abort()
+
+dp2 = 3
+if (vec(2)/=3) call abort()
+
+dp3 = 4
+if (u%i/=4) call abort()
+
+end 
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/pointer_init_4.f90 b/gcc/testsuite/gfortran.dg/pointer_init_4.f90
new file mode 100644
index 000000000..75ead4529
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_init_4.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+!
+! PR 45290: [F08] pointer initialization
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m
+
+implicit none
+
+contains
+
+  integer function f1()
+    f1 = 42
+  end function
+
+  integer function f2()
+    f2 = 43
+  end function
+
+end module
+
+
+program test_ptr_init
+
+use m
+implicit none
+
+procedure(f1), pointer :: pp => f1
+
+type :: t
+  procedure(f2), pointer, nopass :: ppc => f2
+end type
+
+type (t) :: u
+
+if (pp()/=42) call abort()
+if (u%ppc()/=43) call abort()
+
+end
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/pointer_init_5.f90 b/gcc/testsuite/gfortran.dg/pointer_init_5.f90
new file mode 100644
index 000000000..beedad27d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_init_5.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+!
+! PR 45290: [F08] pointer initialization
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m
+
+implicit none
+
+procedure(f1), pointer :: pp => f1
+
+type :: t
+  procedure(f2), pointer, nopass :: ppc => f2
+end type
+
+contains
+
+  integer function f1()
+    f1 = 42
+  end function
+
+  integer function f2()
+    f2 = 43
+  end function
+
+end module
+
+
+program test_ptr_init
+
+use m
+implicit none
+
+type (t) :: u
+
+if (pp()/=42) call abort()
+if (u%ppc()/=43) call abort()
+
+end
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/pointer_init_6.f90 b/gcc/testsuite/gfortran.dg/pointer_init_6.f90
new file mode 100644
index 000000000..92cece3a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_init_6.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+!
+! PR 45290: [F08] pointer initialization
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m1
+ implicit none
+ type :: t
+   integer, pointer :: p
+   integer :: i
+ end type
+ integer, target :: i
+ type(t), target :: x
+ integer, pointer :: p1 => i
+ integer, pointer :: p2 => p1   ! { dg-error "must have the TARGET attribute" }
+ integer, pointer :: p3 => x%p  ! { dg-error "must have the TARGET attribute" }
+ integer, pointer :: p4 => x%i
+end module m1
+
+
+module m2
+
+ type :: t
+   procedure(s), pointer, nopass :: ppc
+ end type
+ type(t) :: x
+ procedure(s), pointer :: pp1 => s
+ procedure(s), pointer :: pp2 => pp1    ! { dg-error "may not be a procedure pointer" }
+ procedure(s), pointer :: pp3 => t%ppc  ! { dg-error "Syntax error" }
+
+contains
+
+  subroutine s
+  end subroutine
+
+end module m2
+
+! { dg-final { cleanup-modules "m1 m2" } }
diff --git a/gcc/testsuite/gfortran.dg/pointer_intent_1.f90 b/gcc/testsuite/gfortran.dg/pointer_intent_1.f90
new file mode 100644
index 000000000..1bdab241c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_intent_1.f90
@@ -0,0 +1,77 @@
+! { dg-do run }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+! Pointer intent test
+! PR fortran/29624
+!
+! Valid program
+program test
+ implicit none
+ type myT
+   integer          :: x
+   integer, pointer :: point
+ end type myT
+ integer, pointer :: p
+ type(myT), pointer :: t
+ type(myT) :: t2
+ allocate(p,t)
+ allocate(t%point)
+ t%point = 55
+ p = 33
+ call a(p,t)
+ deallocate(p)
+ nullify(p)
+ call a(p,t)
+ t2%x     = 5
+ allocate(t2%point)
+ t2%point = 42
+ call nonpointer(t2)
+ if(t2%point /= 7) call abort()
+contains
+  subroutine a(p,t)
+    integer, pointer,intent(in)    :: p
+    type(myT), pointer, intent(in) :: t
+    integer, pointer :: tmp
+    if(.not.associated(p)) return
+    if(p /= 33) call abort()
+    p = 7
+    if (associated(t)) then
+      ! allocating is valid as we don't change the status
+      ! of the pointer "t", only of it's target
+      t%x = -15
+      if(.not.associated(t%point)) call abort()
+      if(t%point /= 55) call abort()
+      nullify(t%point)
+      allocate(tmp)
+      t%point => tmp
+      deallocate(t%point)
+      t%point => null(t%point)
+      tmp => null(tmp)
+      allocate(t%point)
+      t%point = 27
+      if(t%point /= 27) call abort()
+      if(t%x     /= -15) call abort()
+      call foo(t)
+      if(t%x     /=  32) call abort()
+      if(t%point /= -98) call abort()
+    end if
+    call b(p)
+    if(p /= 5) call abort()
+  end subroutine
+  subroutine b(v)
+    integer, intent(out) :: v
+    v = 5
+  end subroutine b
+  subroutine foo(comp)
+    type(myT), intent(inout) :: comp
+    if(comp%x     /= -15) call abort()
+    if(comp%point /=  27) call abort()
+    comp%x     = 32
+    comp%point = -98
+  end subroutine foo
+  subroutine nonpointer(t)
+     type(myT), intent(in) :: t
+     if(t%x     /= 5 ) call abort()
+     if(t%point /= 42) call abort()
+     t%point = 7
+  end subroutine nonpointer
+end program
diff --git a/gcc/testsuite/gfortran.dg/pointer_intent_2.f90 b/gcc/testsuite/gfortran.dg/pointer_intent_2.f90
new file mode 100644
index 000000000..692570339
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_intent_2.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! { dg-shouldfail "Fortran 2003 feature with -std=f95" }
+!
+! Pointer intent test
+! PR fortran/29624
+!
+! Fortran 2003 features in Fortran 95
+program test
+ implicit none
+ integer, pointer :: p
+ allocate(p)
+ p = 33
+ call a(p) ! { dg-error "Type mismatch in argument" }
+contains
+  subroutine a(p)! { dg-error "has no IMPLICIT type" }
+    integer, pointer,intent(in) :: p ! { dg-error "POINTER attribute with INTENT attribute" }
+  end subroutine
+end program
diff --git a/gcc/testsuite/gfortran.dg/pointer_intent_3.f90 b/gcc/testsuite/gfortran.dg/pointer_intent_3.f90
new file mode 100644
index 000000000..7f87d10e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_intent_3.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+! { dg-shouldfail "Invalid code" }
+!
+! Pointer intent test
+! PR fortran/29624
+!
+! Valid program
+program test
+ implicit none
+ type myT
+    integer :: j = 5
+    integer, pointer :: jp => null()
+ end type myT
+ integer, pointer :: p
+ type(myT) :: t
+ call a(p)
+ call b(t)
+contains
+  subroutine a(p)
+    integer, pointer,intent(in) :: p
+    p => null(p)! { dg-error "pointer association context" }
+    nullify(p)  ! { dg-error "pointer association context" }
+    allocate(p) ! { dg-error "pointer association context" }
+    call c(p)   ! { dg-error "pointer association context" }
+    deallocate(p) ! { dg-error "pointer association context" }
+  end subroutine
+  subroutine c(p)
+    integer, pointer, intent(inout) :: p
+    nullify(p)
+  end subroutine c
+  subroutine b(t)
+    type(myT),intent(in) :: t
+    t%jp = 5
+    t%jp => null(t%jp)  ! { dg-error "pointer association context" }
+    nullify(t%jp) ! { dg-error "pointer association context" }
+    t%j = 7 ! { dg-error "variable definition context" }
+    allocate(t%jp) ! { dg-error "pointer association context" }
+    deallocate(t%jp) ! { dg-error "pointer association context" }
+  end subroutine b
+end program
diff --git a/gcc/testsuite/gfortran.dg/pointer_intent_4.f90 b/gcc/testsuite/gfortran.dg/pointer_intent_4.f90
new file mode 100644
index 000000000..862edff4a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_intent_4.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! { dg-options "-fno-inline" }
+!
+! PR fortran/46937
+!
+! Check that a non-pointer INTENT(IN) dummy
+! with pointer component is properly treated
+!
+program test
+ type myT
+   integer, pointer :: point
+ end type myT
+ type(myT) :: t2
+ allocate(t2%point)
+ t2%point = 42
+ call nonpointer(t2)
+ if(t2%point /= 7) call abort()
+ t2%point = 42
+ call nonpointer2(t2)
+ if(t2%point /= 66) call abort()
+contains
+  subroutine nonpointer(t)
+     type(myT), intent(in) :: t
+     t%point = 7
+  end subroutine nonpointer
+  subroutine nonpointer2(t)
+     class(myT), intent(in) :: t
+     t%point = 66
+  end subroutine nonpointer2
+end program
diff --git a/gcc/testsuite/gfortran.dg/pointer_intent_5.f90 b/gcc/testsuite/gfortran.dg/pointer_intent_5.f90
new file mode 100644
index 000000000..c4e3c7a3c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_intent_5.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+!
+! PR 50570: [4.6/4.7 Regression] Incorrect error for assignment to intent(in) pointer
+!
+! Contributed by Bill Long <longb@cray.com>
+
+program bots_sparselu_pointer_intent_in
+
+  implicit none
+  integer, pointer :: array(:)
+
+  allocate(array(4))
+  array = 0
+  call sub(array)
+  if (sum(array)/=1) call abort
+
+contains
+
+  subroutine sub(dummy)
+    integer, pointer, intent(in) :: dummy(:)
+    dummy(1) = 1
+  end subroutine sub
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/pointer_intent_6.f90 b/gcc/testsuite/gfortran.dg/pointer_intent_6.f90
new file mode 100644
index 000000000..56c7de5eb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_intent_6.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! PR fortran/52864
+!
+! Assigning to an intent(in) pointer (which is valid).
+!
+      program test
+         type PoisFFT_Solver3D
+           complex, dimension(:,:,:), &
+                           pointer :: work => null()
+         end type PoisFFT_Solver3D
+      contains
+        subroutine PoisFFT_Solver3D_FullPeriodic(D, p)
+          type(PoisFFT_Solver3D), intent(in) :: D
+          real, intent(in), pointer :: p(:)
+          D%work(i,j,k) = 0.0
+          p = 0.0
+        end subroutine
+      end
diff --git a/gcc/testsuite/gfortran.dg/pointer_remapping_1.f90 b/gcc/testsuite/gfortran.dg/pointer_remapping_1.f90
new file mode 100644
index 000000000..d360c4223
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_remapping_1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! PR fortran/29785
+! PR fortran/45016
+! Check for F2003 rejection of pointer remappings.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER, TARGET :: arr(12)
+  INTEGER, POINTER :: vec(:), mat(:, :)
+
+  vec => arr ! This is ok.
+
+  vec(2:) => arr ! { dg-error "Fortran 2003" }
+  mat(1:2, 1:6) => arr ! { dg-error "Fortran 2003" }
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/pointer_remapping_2.f03 b/gcc/testsuite/gfortran.dg/pointer_remapping_2.f03
new file mode 100644
index 000000000..57ec5c872
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_remapping_2.f03
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! PR fortran/29785
+! Check for F2008 rejection of rank remapping to rank-two base array.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER, TARGET :: arr(12), basem(3, 4)
+  INTEGER, POINTER :: vec(:), mat(:, :)
+
+  ! These are ok.
+  vec => arr
+  vec(2:) => arr
+  mat(1:2, 1:6) => arr
+
+  vec(1:12) => basem ! { dg-error "Fortran 2008" }
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/pointer_remapping_3.f08 b/gcc/testsuite/gfortran.dg/pointer_remapping_3.f08
new file mode 100644
index 000000000..376adb07a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_remapping_3.f08
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+
+! PR fortran/29785
+! PR fortran/45016
+! Check for pointer remapping compile-time errors.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER, TARGET :: arr(12), basem(3, 4)
+  INTEGER, POINTER :: vec(:), mat(:, :)
+
+  ! Existence of reference elements.
+  vec(:) => arr ! { dg-error "Lower bound has to be present" }
+  vec(5:7:1) => arr ! { dg-error "Stride must not be present" }
+  mat(1:, 2:5) => arr ! { dg-error "Either all or none of the upper bounds" }
+  mat(2, 6) => arr ! { dg-error "Expected bounds specification" }
+
+  ! This is bound remapping not rank remapping!
+  mat(1:, 3:) => arr ! { dg-error "Different ranks" }
+
+  ! Invalid remapping target; for non-rank one we already check the F2008
+  ! error elsewhere.  Here, test that not-contiguous target is disallowed
+  ! with rank > 1.
+  mat(1:2, 1:3) => arr(1:12:2) ! This is ok, rank one target.
+  vec(1:8) => basem(1:3:2, :) ! { dg-error "rank 1 or simply contiguous" }
+
+  ! Target is smaller than pointer.
+  vec(1:20) => arr ! { dg-error "smaller than size of the pointer" }
+  vec(1:10) => arr(1:12:2) ! { dg-error "smaller than size of the pointer" }
+  vec(1:20) => basem(:, :) ! { dg-error "smaller than size of the pointer" }
+  mat(1:5, 1:5) => arr ! { dg-error "smaller than size of the pointer" }
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/pointer_remapping_4.f03 b/gcc/testsuite/gfortran.dg/pointer_remapping_4.f03
new file mode 100644
index 000000000..d196ddeb0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_remapping_4.f03
@@ -0,0 +1,33 @@
+! { dg-do run }
+! { dg-options "-std=f2003 -fall-intrinsics -fcheck=bounds" }
+
+! PR fortran/45016
+! Check pointer bounds remapping at runtime.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER, TARGET :: arr(2_2:5), basem(-2:-1, 3:4_1)
+  INTEGER, POINTER :: vec(:), vec2(:), mat(:, :)
+
+  arr = (/ 1, 2, 3, 4 /)
+  basem = RESHAPE (arr, SHAPE (basem))
+
+  vec(0:) => arr
+  IF (LBOUND (vec, 1) /= 0 .OR. UBOUND (vec, 1) /= 3) CALL abort ()
+  IF (ANY (vec /= arr)) CALL abort ()
+  IF (vec(0) /= 1 .OR. vec(2) /= 3) CALL abort ()
+
+  ! Test with bound different of index type, so conversion is necessary.
+  vec2(-5_1:) => vec
+  IF (LBOUND (vec2, 1) /= -5 .OR. UBOUND (vec2, 1) /= -2) CALL abort ()
+  IF (ANY (vec2 /= arr)) CALL abort ()
+  IF (vec2(-5) /= 1 .OR. vec2(-3) /= 3) CALL abort ()
+
+  mat(1:, 2:) => basem
+  IF (ANY (LBOUND (mat) /= (/ 1, 2 /) .OR. UBOUND (mat) /= (/ 2, 3 /))) &
+    CALL abort ()
+  IF (ANY (mat /= basem)) CALL abort ()
+  IF (mat(1, 2) /= 1 .OR. mat(1, 3) /= 3 .OR. mat(2, 3) /= 4) CALL abort ()
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/pointer_remapping_5.f08 b/gcc/testsuite/gfortran.dg/pointer_remapping_5.f08
new file mode 100644
index 000000000..28c0a7d8d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_remapping_5.f08
@@ -0,0 +1,37 @@
+! { dg-do run }
+! { dg-options "-std=f2008 -fall-intrinsics -fcheck=bounds" }
+
+! PR fortran/29785
+! Check pointer rank remapping at runtime.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER, TARGET :: arr(12), basem(3, 4)
+  INTEGER, POINTER :: vec(:), mat(:, :)
+  INTEGER :: i
+
+  arr = (/ (i, i = 1, 12) /)
+  basem = RESHAPE (arr, SHAPE (basem))
+
+  ! We need not necessarily change the rank...
+  vec(2_1:5) => arr(1_1:12_1:2_1)
+  IF (LBOUND (vec, 1) /= 2 .OR. UBOUND (vec, 1) /= 5) CALL abort ()
+  IF (ANY (vec /= (/ 1, 3, 5, 7 /))) CALL abort ()
+  IF (vec(2) /= 1 .OR. vec(5) /= 7) CALL abort ()
+
+  ! ...but it is of course the more interesting.  Also try remapping a pointer.
+  vec => arr(1:12:2)
+  mat(1:3, 1:2) => vec
+  IF (ANY (LBOUND (mat) /= (/ 1, 1 /) .OR. UBOUND (mat) /= (/ 3, 2 /))) &
+    CALL abort ()
+  IF (ANY (mat /= RESHAPE (arr(1:12:2), SHAPE (mat)))) CALL abort ()
+  IF (mat(1, 1) /= 1 .OR. mat(1, 2) /= 7) CALL abort ()
+
+  ! Remap with target of rank > 1.
+  vec(1:12_1) => basem
+  IF (LBOUND (vec, 1) /= 1 .OR. UBOUND (vec, 1) /= 12) CALL abort ()
+  IF (ANY (vec /= arr)) CALL abort ()
+  IF (vec(1) /= 1 .OR. vec(5) /= 5 .OR. vec(12) /= 12) CALL abort ()
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/pointer_remapping_6.f08 b/gcc/testsuite/gfortran.dg/pointer_remapping_6.f08
new file mode 100644
index 000000000..6a4e138f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_remapping_6.f08
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-options "-std=f2008 -fcheck=bounds" }
+! { dg-shouldfail "Bounds check" }
+
+! PR fortran/29785
+! Check that -fcheck=bounds catches too small target at runtime for
+! pointer rank remapping.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER, POINTER :: ptr(:, :)
+  INTEGER :: n
+
+  n = 10
+  BLOCK
+    INTEGER, TARGET :: arr(2*n)
+
+    ! These are ok.
+    ptr(1:5, 1:2) => arr
+    ptr(1:5, 1:2) => arr(::2)
+    ptr(-5:-1, 11:14) => arr
+
+    ! This is not.
+    ptr(1:3, 1:5) => arr(::2)
+  END BLOCK
+END PROGRAM main
+! { dg-output "At line 26 of .*\nFortran runtime error: Target of rank remapping is too small \\(10 < 15\\)" }
diff --git a/gcc/testsuite/gfortran.dg/pointer_target_1.f90 b/gcc/testsuite/gfortran.dg/pointer_target_1.f90
new file mode 100644
index 000000000..0f1b7129b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_target_1.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+!
+! TARGET actual to POINTER dummy with INTENT(IN)
+!
+program test
+  implicit none
+  integer, target :: a
+  a = 66
+  call foo(a)
+  if (a /= 647) call abort()
+contains
+  subroutine foo(p)
+    integer, pointer, intent(in) :: p
+    if (a /= 66) call abort()
+    if (p /= 66) call abort()
+    p = 647
+    if (p /= 647) call abort()
+    if (a /= 647) call abort()
+  end subroutine foo
+end program test
diff --git a/gcc/testsuite/gfortran.dg/pointer_target_2.f90 b/gcc/testsuite/gfortran.dg/pointer_target_2.f90
new file mode 100644
index 000000000..95c3e5f79
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_target_2.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! TARGET actual to POINTER dummy with INTENT(IN)
+!
+program test
+  implicit none
+  integer, target :: a
+  a = 66
+  call foo(a) ! { dg-error "Fortran 2008: Non-pointer actual argument" }
+  if (a /= 647) call abort()
+contains
+  subroutine foo(p)
+    integer, pointer, intent(in) :: p
+    if (a /= 66) call abort()
+    if (p /= 66) call abort()
+    p = 647
+    if (p /= 647) call abort()
+    if (a /= 647) call abort()
+  end subroutine foo
+end program test
diff --git a/gcc/testsuite/gfortran.dg/pointer_target_3.f90 b/gcc/testsuite/gfortran.dg/pointer_target_3.f90
new file mode 100644
index 000000000..85e4981ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_target_3.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+!
+! TARGET actual to POINTER dummy with INTENT(IN)
+!
+program test
+  implicit none
+  integer, target :: a
+  integer :: b
+  call foo(a) ! OK
+  call foo(b) ! { dg-error "must be a pointer" }
+  call bar(a) ! { dg-error "must be a pointer" }
+  call bar(b) ! { dg-error "must be a pointer" }
+contains
+  subroutine foo(p)
+    integer, pointer, intent(in) :: p
+  end subroutine foo
+  subroutine bar(p)
+    integer, pointer :: p
+  end subroutine bar
+end program test
diff --git a/gcc/testsuite/gfortran.dg/pointer_target_4.f90 b/gcc/testsuite/gfortran.dg/pointer_target_4.f90
new file mode 100644
index 000000000..cda3453d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_target_4.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+! PR fortran/47377
+!
+! Contributed by <thenlich@users.sourceforge.net>
+!
+program testgferr
+    real, pointer :: y
+    y => f()  ! { dg-error "must deliver a pointer result" }
+contains
+    function f()
+      real :: f
+      f = 5
+    end function f
+end program testgferr
diff --git a/gcc/testsuite/gfortran.dg/pointer_to_substring.f90 b/gcc/testsuite/gfortran.dg/pointer_to_substring.f90
new file mode 100644
index 000000000..054a29d56
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_to_substring.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! PR36724 - ICE on pointer to substring
+! testcase contributed by Loukas Peristeras.
+
+  character(LEN=132), target :: line
+  character(LEN=1), pointer :: t
+
+  read(*,'(A)') line
+  t=>line(1:1)
+end
diff --git a/gcc/testsuite/gfortran.dg/popcnt_poppar_1.F90 b/gcc/testsuite/gfortran.dg/popcnt_poppar_1.F90
new file mode 100644
index 000000000..3b7322b94
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/popcnt_poppar_1.F90
@@ -0,0 +1,121 @@
+! { dg-do run }
+! { dg-options "-ffree-line-length-none" }
+
+interface runtime_popcnt
+  procedure runtime_popcnt_i1
+  procedure runtime_popcnt_i2
+  procedure runtime_popcnt_i4
+  procedure runtime_popcnt_i8
+end interface
+
+interface runtime_poppar
+  procedure runtime_poppar_i1
+  procedure runtime_poppar_i2
+  procedure runtime_poppar_i4
+  procedure runtime_poppar_i8
+end interface
+
+#define CHECK(val,res) \
+  if (popcnt(val) /= res) call abort ; \
+  if (runtime_popcnt(val) /= res) call abort
+
+#define CHECK2(val) \
+  if (poppar(val) /= modulo(popcnt(val),2)) call abort ; \
+  if (runtime_poppar(val) /= poppar(val)) call abort
+
+  CHECK(0_1, 0)
+  CHECK(0_2, 0)
+  CHECK(0_4, 0)
+  CHECK(0_8, 0)
+
+  CHECK(1_1, 1)
+  CHECK(1_2, 1)
+  CHECK(1_4, 1)
+  CHECK(1_8, 1)
+
+  CHECK(-1_1,8)
+  CHECK(-1_2,16)
+  CHECK(-1_4,32)
+  CHECK(-1_8,64)
+
+  CHECK(-8_1,8-3)
+  CHECK(-8_2,16-3)
+  CHECK(-8_4,32-3)
+  CHECK(-8_8,64-3)
+
+  CHECK(huge(0_1), 8-1)
+  CHECK(huge(0_2), 16-1)
+  CHECK(huge(0_4), 32-1)
+  CHECK(huge(0_8), 64-1)
+
+  CHECK(-huge(0_1), 2)
+  CHECK(-huge(0_2), 2)
+  CHECK(-huge(0_4), 2)
+  CHECK(-huge(0_8), 2)
+
+  CHECK2(0_1)
+  CHECK2(0_2)
+  CHECK2(0_4)
+  CHECK2(0_8)
+
+  CHECK2(17_1)
+  CHECK2(17_2)
+  CHECK2(17_4)
+  CHECK2(17_8)
+
+  CHECK2(-17_1)
+  CHECK2(-17_2)
+  CHECK2(-17_4)
+  CHECK2(-17_8)
+
+  CHECK2(huge(0_1))
+  CHECK2(huge(0_2))
+  CHECK2(huge(0_4))
+  CHECK2(huge(0_8))
+
+  CHECK2(-huge(0_1))
+  CHECK2(-huge(0_2))
+  CHECK2(-huge(0_4))
+  CHECK2(-huge(0_8))
+
+contains
+  integer function runtime_popcnt_i1 (i) result(res)
+    integer(kind=1), intent(in) :: i
+    res = popcnt(i)
+  end function
+
+  integer function runtime_popcnt_i2 (i) result(res)
+    integer(kind=2), intent(in) :: i
+    res = popcnt(i)
+  end function
+
+  integer function runtime_popcnt_i4 (i) result(res)
+    integer(kind=4), intent(in) :: i
+    res = popcnt(i)
+  end function
+
+  integer function runtime_popcnt_i8 (i) result(res)
+    integer(kind=8), intent(in) :: i
+    res = popcnt(i)
+  end function
+
+  integer function runtime_poppar_i1 (i) result(res)
+    integer(kind=1), intent(in) :: i
+    res = poppar(i)
+  end function
+
+  integer function runtime_poppar_i2 (i) result(res)
+    integer(kind=2), intent(in) :: i
+    res = poppar(i)
+  end function
+
+  integer function runtime_poppar_i4 (i) result(res)
+    integer(kind=4), intent(in) :: i
+    res = poppar(i)
+  end function
+
+  integer function runtime_poppar_i8 (i) result(res)
+    integer(kind=8), intent(in) :: i
+    res = poppar(i)
+  end function
+end
diff --git a/gcc/testsuite/gfortran.dg/popcnt_poppar_2.F90 b/gcc/testsuite/gfortran.dg/popcnt_poppar_2.F90
new file mode 100644
index 000000000..fb984e2f5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/popcnt_poppar_2.F90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! { dg-options "-ffree-line-length-none" }
+! { dg-require-effective-target fortran_integer_16 }
+
+#define CHECK(val,res) \
+  if (popcnt(val) /= res) call abort ; \
+  if (runtime_popcnt(val) /= res) call abort
+
+#define CHECK2(val) \
+  if (poppar(val) /= modulo(popcnt(val),2)) call abort ; \
+  if (runtime_poppar(val) /= poppar(val)) call abort
+
+  CHECK(0_16, 0)
+  CHECK(1_16, 1)
+
+  CHECK(-1_16,128)
+  CHECK(-8_16,128-3)
+
+  CHECK(huge(0_16), 128-1)
+
+  CHECK(-huge(0_16), 2)
+
+  CHECK2(0_16)
+  CHECK2(17_16)
+  CHECK2(-17_16)
+  CHECK2(huge(0_16))
+  CHECK2(-huge(0_16))
+
+contains
+  integer function runtime_popcnt (i) result(res)
+    integer(kind=16), intent(in) :: i
+    res = popcnt(i)
+  end function
+
+  integer function runtime_poppar (i) result(res)
+    integer(kind=16), intent(in) :: i
+    res = poppar(i)
+  end function
+end
diff --git a/gcc/testsuite/gfortran.dg/power.f90 b/gcc/testsuite/gfortran.dg/power.f90
new file mode 100644
index 000000000..5f6b6c6c3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/power.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+integer i
+i = 0
+if ( a (i) ** 5 .ne. 1) call abort ()
+contains
+function a (i)
+integer a, i
+i = i + 1
+a = i
+end function
+end
diff --git a/gcc/testsuite/gfortran.dg/power1.f90 b/gcc/testsuite/gfortran.dg/power1.f90
new file mode 100644
index 000000000..50dbac275
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/power1.f90
@@ -0,0 +1,58 @@
+! { dg-do run }
+! Test fix for PR fortran/38823.
+program power
+
+   implicit none
+
+   integer, parameter :: &
+   &  s = kind(1.e0), &
+   &  d = kind(1.d0), &
+   &  e = max(selected_real_kind(precision(1.d0)+1), d)
+
+  real(s),    parameter :: ris = 2.e0_s**2
+  real(d),    parameter :: rid = 2.e0_d**2
+  real(e),    parameter :: rie = 2.e0_e**2 
+  complex(s), parameter :: cis = (2.e0_s,1.e0_s)**2
+  complex(d), parameter :: cid = (2.e0_d,1.e0_d)**2
+  complex(e), parameter :: cie = (2.e0_e,1.e0_e)**2
+
+  real(s),    parameter :: rrs = 2.e0_s**2.e0
+  real(d),    parameter :: rrd = 2.e0_d**2.e0
+  real(e),    parameter :: rre = 2.e0_e**2.e0
+  complex(s), parameter :: crs = (2.e0_s,1.e0_s)**2.e0
+  complex(d), parameter :: crd = (2.e0_d,1.e0_d)**2.e0
+  complex(e), parameter :: cre = (2.e0_e,1.e0_e)**2.e0
+
+  real(s),    parameter :: rds = 2.e0_s**2.e0_d
+  real(d),    parameter :: rdd = 2.e0_d**2.e0_d
+  real(e),    parameter :: rde = 2.e0_e**2.e0_d
+  complex(s), parameter :: cds = (2.e0_s,1.e0_s)**2.e0_d
+  complex(d), parameter :: cdd = (2.e0_d,1.e0_d)**2.e0_d
+  complex(e), parameter :: cde = (2.e0_e,1.e0_e)**2.e0_d
+
+  real(s), parameter :: eps_s = 1.e-5_s
+  real(d), parameter :: eps_d = 1.e-10_d
+  real(e), parameter :: eps_e = 1.e-10_e
+
+  if (abs(ris - 4) > eps_s) call abort
+  if (abs(rid - 4) > eps_d) call abort
+  if (abs(rie - 4) > eps_e) call abort
+  if (abs(real(cis, s) - 3) > eps_s .or. abs(aimag(cis) - 4) > eps_s) call abort
+  if (abs(real(cid, d) - 3) > eps_d .or. abs(aimag(cid) - 4) > eps_d) call abort
+  if (abs(real(cie, e) - 3) > eps_e .or. abs(aimag(cie) - 4) > eps_e) call abort
+
+  if (abs(rrs - 4) > eps_s) call abort
+  if (abs(rrd - 4) > eps_d) call abort
+  if (abs(rre - 4) > eps_e) call abort
+  if (abs(real(crs, s) - 3) > eps_s .or. abs(aimag(crs) - 4) > eps_s) call abort
+  if (abs(real(crd, d) - 3) > eps_d .or. abs(aimag(crd) - 4) > eps_d) call abort
+  if (abs(real(cre, e) - 3) > eps_e .or. abs(aimag(cre) - 4) > eps_e) call abort
+
+  if (abs(rds - 4) > eps_s) call abort
+  if (abs(rdd - 4) > eps_d) call abort
+  if (abs(rde - 4) > eps_e) call abort
+  if (abs(real(cds, s) - 3) > eps_s .or. abs(aimag(cds) - 4) > eps_s) call abort
+  if (abs(real(cdd, d) - 3) > eps_d .or. abs(aimag(cdd) - 4) > eps_d) call abort
+  if (abs(real(cde, e) - 3) > eps_e .or. abs(aimag(cde) - 4) > eps_e) call abort
+
+end program power
diff --git a/gcc/testsuite/gfortran.dg/power2.f90 b/gcc/testsuite/gfortran.dg/power2.f90
new file mode 100644
index 000000000..5e2cf0440
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/power2.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! PR fortran/46794
+
+! Check that results of powers of integers with kinds 1 and 2 are
+! correctly converted back; this used to ICE because a conversion
+! from kind 4 to the correct one was missing.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  INTEGER(KIND=1) :: k1
+  INTEGER(KIND=2) :: k2
+
+  k1 = 1_1
+  k2 = 1_2
+
+  k1 = 1_1 + 1_1**k1
+  k2 = 1_2 + 1_2**k2
+
+  k2 = 1_1 + 1_1**k2
+  k2 = 1_1 + 1_2**k1
+  k2 = 1_1 + 1_2**k2
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/pr12884.f b/gcc/testsuite/gfortran.dg/pr12884.f
new file mode 100644
index 000000000..425604c02
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr12884.f
@@ -0,0 +1,25 @@
+c { dg-do run }
+c pr 12884
+c test namelist with input file containg / before namelist. Also checks
+c non-standard use of $ instead of &
+c Based on example provided by jean-pierre.flament@univ-lille1.fr
+
+      program pr12884
+      integer ispher,nosym,runflg,noprop
+      namelist /cntrl/ ispher,nosym,runflg,noprop
+      ispher = 0
+      nosym = 0
+      runflg = 0
+      noprop = 0 
+      open (10, status = "scratch")
+      write (10, '(A)') " $FILE"
+      write (10, '(A)') "   pseu  dir/file"
+      write (10, '(A)') " $END"
+      write (10, '(A)') " $cntrl ispher=1,nosym=2,"
+      write (10, '(A)') " runflg=3,noprop=4,$END"
+      write (10, '(A)')"/"
+      rewind (10)
+      read (10, cntrl)
+      if ((ispher.ne.1).or.(nosym.ne.2).or.(runflg.ne.3).or.
+     &  (noprop.ne.4)) call abort ()
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr15129.f90 b/gcc/testsuite/gfortran.dg/pr15129.f90
new file mode 100644
index 000000000..df3854d7a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr15129.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR 15129: we used to share the character length between A and B in the 
+! subroutine.
+CHARACTER*10 A
+CHARACTER*8 B
+A = 'gfortran'
+B = 'rocks!'
+CALL T(A,B)
+contains
+SUBROUTINE T(A,B)
+CHARACTER*(*) A,B
+if(len(a)/=10) call abort()
+if(len(b)/=8) call abort()
+END SUBROUTINE
+end
diff --git a/gcc/testsuite/gfortran.dg/pr15140.f90 b/gcc/testsuite/gfortran.dg/pr15140.f90
new file mode 100644
index 000000000..0f566dcd1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr15140.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! PR 15140: we used to fail an assertion, because we don't use the
+! argument of the subroutine directly, but instead use a copy of it.
+function M(NAMES)
+  CHARACTER*(*) NAMES(*)
+  if (any(names(1:2).ne."asdfg")) call abort
+  m = LEN(NAMES(1))
+END function M
+
+character(5) :: c(2)
+c = "asdfg"
+if(m(c).ne.5) call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/pr15164.f90 b/gcc/testsuite/gfortran.dg/pr15164.f90
new file mode 100644
index 000000000..f8098710b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr15164.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! I couldn't reproduce the failure with a compiler built from the
+! 2004-09-26 sources
+      module specfiles
+      contains
+      subroutine split(instring,outstrings,lenout,n,i)
+      integer(kind=4),intent(in) :: lenout,n
+      character(len=*),intent(in) :: instring
+      character(len=lenout),dimension(n),intent(out) :: outstrings
+      integer(kind=4) :: i,j,k
+      j=1; k=1
+       outstrings(j)(k:k)=instring(i:i)
+      return
+      end subroutine split
+      end module specfiles
+
+! { dg-final { cleanup-modules "specfiles" } }
diff --git a/gcc/testsuite/gfortran.dg/pr15324.f90 b/gcc/testsuite/gfortran.dg/pr15324.f90
new file mode 100644
index 000000000..d918717e7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr15324.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! PR 15234
+! tests for passing arrays of assumed length characters
+program strarray_6
+character(5), dimension(:), allocatable :: c
+n = 3
+allocate(c(-1:n-2))
+c = "BLUBB"
+call foo(c)
+call bar(c,n)
+deallocate(c)
+contains
+subroutine foo(x)
+  character (len = *), dimension(:) :: x
+  if (any (x .ne. "BLUBB")) CALL abort()
+end subroutine foo
+end
+
+subroutine bar(x,n)
+  character (len = *), dimension(n) :: x
+  if (any (x .ne. "BLUBB")) CALL abort()
+end subroutine bar
diff --git a/gcc/testsuite/gfortran.dg/pr15332.f b/gcc/testsuite/gfortran.dg/pr15332.f
new file mode 100644
index 000000000..813e30188
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr15332.f
@@ -0,0 +1,14 @@
+! PR libfortran/15332
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+      character*12 c
+
+      write (c,100) 0, 1
+      if (c .ne. 'i = 0, j = 1') call abort
+      
+      write (c,100) 0
+      if (c .ne. 'i = 0       ') call abort
+
+ 100  format ('i = ',i1,:,', j = ',i1)
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr15754.f90 b/gcc/testsuite/gfortran.dg/pr15754.f90
new file mode 100644
index 000000000..1b9259e80
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr15754.f90
@@ -0,0 +1,7 @@
+! we didn't give a warning if the RHS of an assignment was NULL
+! { dg-do compile }
+INTEGER, POINTER :: P
+I = NULL() ! { dg-error "NULL appears" "Assignment non-pointer = NULL" }
+P = NULL() ! { dg-error "NULL appears" "Assignment pointer = NULL" }
+P => NULL()
+END
diff --git a/gcc/testsuite/gfortran.dg/pr15957.f90 b/gcc/testsuite/gfortran.dg/pr15957.f90
new file mode 100644
index 000000000..b1439131f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr15957.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! PR 15957
+! we used to return the wrong shape when the order parameter was used
+! in reshape.
+!
+INTEGER, parameter :: i(2,3) = reshape ((/1,2,3,4,5,6/), (/2,3/)), &
+     j(2,4) = reshape ((/1,2,3,4,5,6/), (/2,4/), (/0,0/), (/2,1/))
+
+integer :: k(2,3), m(2,4), n(2,3), o(2,4)
+
+k(1,:) = (/ 1, 3, 5 /)
+k(2,:) = (/ 2, 4, 6 /)
+
+m(1,:) = (/ 1, 2, 3, 4 /)
+m(2,:) = (/ 5, 6, 0, 0 /)
+
+! check that reshape does the right thing while constant folding
+if (any(i /= k)) call abort()
+if (any(j /= m)) call abort()
+
+! check that reshape does the right thing at runtime
+n = reshape ((/1,2,3,4,5,6/), (/2,3/))
+if (any(n /= k)) call abort()
+o = reshape ((/1,2,3,4,5,6/), (/2,4/), (/0,0/), (/2,1/))
+if (any(o /= m)) call abort()
+end 
+
diff --git a/gcc/testsuite/gfortran.dg/pr15959.f90 b/gcc/testsuite/gfortran.dg/pr15959.f90
new file mode 100644
index 000000000..c28dce525
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr15959.f90
@@ -0,0 +1,5 @@
+! { dg-do run }
+! Test initializer of character array. PR15959
+character (*), parameter :: a (1:2) = (/'ab ', 'abc'/)
+if (a(2) .ne. 'abc') call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/pr16433.f b/gcc/testsuite/gfortran.dg/pr16433.f
new file mode 100644
index 000000000..cb3dcec5e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr16433.f
@@ -0,0 +1,6 @@
+! { dg-do compile }
+      real x
+      double precision dx
+      data x/x'2ffde'/ ! { dg-warning "Hexadecimal constant | used to initialize non-integer" } 
+      dx = x  ! { dg-bogus "exadecimal constant" "Hex constant where there is none" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr16597.f90 b/gcc/testsuite/gfortran.dg/pr16597.f90
new file mode 100644
index 000000000..c29147411
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr16597.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! pr 16597
+! libgfortran
+! reading a direct access record after it was written did
+! not always return the correct data.
+
+      program gfbug4
+      implicit none
+
+      integer      strlen
+      parameter    (strlen = 4)
+
+      integer      iunit 
+      character    string *4
+
+      iunit = 99
+      open (UNIT=iunit,FORM='unformatted',ACCESS='direct',RECL=strlen)
+      write (iunit, rec=1) 'ABCD'
+      read (iunit, rec=1) string
+      close (iunit)
+      if (string.ne.'ABCD') call abort
+
+      open (UNIT=iunit,FORM='unformatted',ACCESS='direct',STATUS='scratch',RECL=strlen)
+      write (iunit, rec=1) 'ABCD'
+      read (iunit, rec=1) string
+      close (iunit)
+      if (string.ne.'ABCD') call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr16861.f90 b/gcc/testsuite/gfortran.dg/pr16861.f90
new file mode 100644
index 000000000..88f89fa78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr16861.f90
@@ -0,0 +1,34 @@
+! PR fortran/16861
+! { dg-do run }
+module foo
+  integer :: i
+end module foo
+
+module bar
+contains
+  subroutine baz(j)
+    use foo
+    integer, dimension(i) :: j
+    integer :: n
+
+    do n = 1, i
+      if (j(n) /= n**2) call abort
+    end do
+  end subroutine baz
+end module bar
+
+subroutine quus()
+  use foo
+  use bar
+
+  i = 2
+  call baz ((/1,4/))
+  i = 7
+  call baz ((/1,4,9,16,25,36,49/))
+end subroutine quus
+
+program test
+  call quus
+end program test
+
+! { dg-final { cleanup-modules "foo bar" } }
diff --git a/gcc/testsuite/gfortran.dg/pr16935.f90 b/gcc/testsuite/gfortran.dg/pr16935.f90
new file mode 100644
index 000000000..b7dd236fd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr16935.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+! pr16935
+! segfault at run time on open statement
+       program bug2
+       implicit none
+       open( 1 , file = "str_500.txt", position = "REWIND" )
+       close( 1 , status = "DELETE" )
+       end
diff --git a/gcc/testsuite/gfortran.dg/pr16938.f90 b/gcc/testsuite/gfortran.dg/pr16938.f90
new file mode 100644
index 000000000..8a9c286ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr16938.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! We used to get an internal error in the backend when trying to compile this
+! Added some code which verifies that we're actually doing the right thing.
+  program Array_List 
+    implicit none 
+ 
+    type :: Compound 
+      integer                       :: Count 
+      character (len = 4)           :: Name 
+    end type Compound 
+
+    type :: Table 
+      type (Compound)               :: Data (2)  
+      integer :: L_Size  
+    end type Table 
+ 
+    type (Table) :: ElementTable
+    ElementTable%Data(1) = Compound(1,"one")
+    ElementTable%Data(2) = Compound(2,"two")
+    ElementTable%L_size  = 2 
+
+    if (elementtable%data(1)%count /= 1) call abort
+    if (elementtable%data(2)%count /= 2) call abort
+    if (elementtable%data(1)%name /= "one ") call abort
+    if (elementtable%data(2)%name /= "two ") call abort
+    if (elementtable%l_size /= 2) call abort
+  end program Array_List
diff --git a/gcc/testsuite/gfortran.dg/pr17090.f90 b/gcc/testsuite/gfortran.dg/pr17090.f90
new file mode 100644
index 000000000..6a685c2ed
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr17090.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! pr 17090 Runtime I/O error
+! bdavis9659@comcast.net 
+! 9/12/2004
+! list directed read with spaces between the last data item and the
+! eoln cause missed data items.
+! this is a libgfortran test case
+       implicit none
+       integer i,sum
+       real a(14)
+       data sum / 0 /
+       open(unit=9,status='SCRATCH')
+       write(9,*)1.0,2.0,3.0,4.0,'      '
+       write(9,*)5.0,6.0,7.0,8.0,'      '
+       write(9,*)9.0,10.0,11.0,12.0,13.0,14.0,'      '
+       rewind(9)
+       read(9,*)a
+       do i = 1,14
+          sum = sum + a(i)
+       end do
+       if (sum.ne.105) call abort
+       end
diff --git a/gcc/testsuite/gfortran.dg/pr17143.f90 b/gcc/testsuite/gfortran.dg/pr17143.f90
new file mode 100644
index 000000000..4423eab73
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr17143.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! pr17143
+! does not print 2*63 correctly
+       character*25 l
+       integer(kind=8) i
+       data i /1/
+       do j = 1,63
+          i = i * 2
+       end do
+       write(l,*)i
+       if (l.ne.' -9223372036854775808') then
+!                ^
+!         the space is required before a number
+          call abort
+       endif 
+       end
+
diff --git a/gcc/testsuite/gfortran.dg/pr17164.f90 b/gcc/testsuite/gfortran.dg/pr17164.f90
new file mode 100644
index 000000000..c9b4d4537
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr17164.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! pr17164
+! index aborts when substring is longer than string
+      implicit none
+      character*5 x
+      integer i
+      x='12345'
+      i=index(x,'blablabl')
+      if (i.ne.0) call abort
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/pr17229.f b/gcc/testsuite/gfortran.dg/pr17229.f
new file mode 100644
index 000000000..65f72b04d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr17229.f
@@ -0,0 +1,24 @@
+! PR fortran/17229
+! { dg-do run }
+
+      integer i
+      logical l
+
+      l = .false.
+      i = -1
+      if (l) if (i) 999,999,999 ! { dg-warning "Obsolescent feature" }
+
+      l = .true.
+      if (l) if (i) 10,999,999 ! { dg-warning "Obsolescent feature" }
+      go to 999
+
+   10 i = 0
+      if (l) if (i) 999,20,999 ! { dg-warning "Obsolescent feature" }
+      go to 999
+
+   20 i = 1
+      if (l) if (i) 999,999,30 ! { dg-warning "Obsolescent feature" }
+      go to 999
+
+  999 call abort
+   30 end
diff --git a/gcc/testsuite/gfortran.dg/pr17285.f90 b/gcc/testsuite/gfortran.dg/pr17285.f90
new file mode 100644
index 000000000..58aee327a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr17285.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! pr 17285
+! Test that namelist can read its own output.
+! At the same time, check arrays and different terminations
+! Based on example provided by paulthomas2@wanadoo.fr
+
+program pr17285
+  implicit none
+  integer, dimension(10) :: number = 42
+  integer                :: ctr, ierr
+  namelist /mynml/ number
+  open (10, status = "scratch")
+  write (10,'(A)') &
+    "&mynml number(:)=42,42,42,42,42,42,42,42,42,42,/ "
+  write (10,mynml)
+  write (10,'(A)') "&mynml number(1:10)=10*42 &end"
+  rewind (10)
+  do ctr = 1,3
+    number = 0
+    read (10, nml = mynml, iostat = ierr)
+    if ((ierr /= 0) .or. (any (number /= 42))) &
+      call abort ()
+  end do
+  close(10)
+end program pr17285
diff --git a/gcc/testsuite/gfortran.dg/pr17286.f90 b/gcc/testsuite/gfortran.dg/pr17286.f90
new file mode 100644
index 000000000..e9beb6d37
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr17286.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+! PR17286
+! Namelist read failed when spaces exist between the '=' and the numbers
+! This is a libgfortran bug
+! Derived from testcase provided by Paul Thomas <paulthomas2@wanadoo.fr>
+       program bug3
+       integer num1 , num2 , num3 , num4 
+       data num3  / 42 /
+       data num4  / 56 /
+       namelist /mynml1/ num1,num2
+       namelist /mynml2/ num3,num4
+       logical dbg
+       data dbg / .FALSE. /
+       open(unit=10,status='SCRATCH')
+       write(10,'(A)') "&mynml1,num1= 16,num2=32,&end"
+!
+! write mynml2
+!
+       write(10,mynml2)
+       rewind(10)
+!
+! now read back
+!
+       num1 = -1
+       num2 = -1
+       read(10,mynml1)
+       if (num1.eq.16.and.num2.eq.32) then
+          if (dbg) write(*,mynml1)
+       else
+          if (dbg) print *, 'expected 16 32 got ',num1,num2
+          call abort
+       endif
+       num3 = -1
+       num4 = -1
+       read(10,mynml2)
+       if (num3.eq.42.and.num4.eq.56) then
+          if (dbg) write(*,mynml2)
+       else
+          if (dbg) print *, 'expected 42 56 got ',num3,num4
+          call abort
+       endif
+
+       close(10)
+       end
diff --git a/gcc/testsuite/gfortran.dg/pr17472.f b/gcc/testsuite/gfortran.dg/pr17472.f
new file mode 100644
index 000000000..4a1ecd937
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr17472.f
@@ -0,0 +1,12 @@
+c { dg-do run }
+c pr 17472
+c test namelist handles arrays
+c Based on example provided by thomas.koenig@online.de
+
+       integer a(10), ctr
+       data a / 1,2,3,4,5,6,7,8,9,10 /
+       namelist /ints/ a
+       do ctr = 1,10
+         if (a(ctr).ne.ctr) call abort ()
+       end do
+       end
diff --git a/gcc/testsuite/gfortran.dg/pr17612.f90 b/gcc/testsuite/gfortran.dg/pr17612.f90
new file mode 100644
index 000000000..1b6853269
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr17612.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+! PR 17612
+! We used to not determine the length of character-valued expressions
+! correctly, leading to a segfault.
+program prog
+  character(len=2), target :: c(4)
+  type pseudo_upf 
+     character(len=2), pointer :: els(:)
+  end type pseudo_upf
+  type (pseudo_upf) :: p
+  type t
+    character(5) :: s(2)
+  end type
+  type (t) v
+  ! A full arrays.
+  c = (/"ab","cd","ef","gh"/)
+  call n(p)
+  if (any (c /= p%els)) call abort
+  ! An array section that needs a new array descriptor.
+  v%s(1) = "hello"
+  v%s(2) = "world"
+  call test (v%s)
+contains 
+
+  subroutine n (upf) 
+    type (pseudo_upf), intent(inout) :: upf 
+    upf%els => c
+    return 
+  end subroutine n
+
+  subroutine test(s)
+    character(len=*) :: s(:)
+    if ((len (s) .ne. 5) .or. (any (s .ne. (/"hello", "world"/)))) call abort
+  end subroutine
+end program
+  
+
diff --git a/gcc/testsuite/gfortran.dg/pr17615.f90 b/gcc/testsuite/gfortran.dg/pr17615.f90
new file mode 100644
index 000000000..76676182f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr17615.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! we didn't look at the right symbol when genrating code. This broke
+! when array valued functions came into play.
+module module_vec3d
+  INTERFACE cross_product
+     MODULE PROCEDURE cross_product3_R4_R8
+  END INTERFACE
+CONTAINS
+  FUNCTION cross_product3_R4_R8 ()
+    real(8) :: cross_product3_r4_r8(3)
+    cross_product3_r4_r8 = 0
+  END FUNCTION cross_product3_R4_R8
+END MODULE module_vec3d
+
+PROGRAM TEST
+  use module_vec3d, only: cross_product
+  real(8) :: c(3)
+  c = cross_product()
+END PROGRAM TEST
+
+! { dg-final { cleanup-modules "module_vec3d" } }
diff --git a/gcc/testsuite/gfortran.dg/pr17706.f90 b/gcc/testsuite/gfortran.dg/pr17706.f90
new file mode 100644
index 000000000..5ddda3d35
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr17706.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fno-sign-zero" }
+! PR17706
+! this is a libgfortran test
+! output value -0.00 is not standard compliant
+! derived from NIST F77 test FM406, with extra bits added.
+program pr17706
+  implicit none
+  character(len=10) :: s
+  character(len=10), parameter :: x = "xxxxxxxxxx"
+  real, parameter :: small = -0.0001
+
+  s = x
+  write (s, '(F4.1)') small
+  ! The plus is optional.  We choose not to display it.
+  if (s .ne. " 0.0") call abort
+
+  s = x
+  write (s, '(SS,F4.1)') small
+  if (s .ne. " 0.0") call abort
+
+  s = x
+  write (s, '(SP,F4.1)') small
+  if (s .ne. "+0.0") call abort
+end program
diff --git a/gcc/testsuite/gfortran.dg/pr18025.f90 b/gcc/testsuite/gfortran.dg/pr18025.f90
new file mode 100644
index 000000000..26d5c01e0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr18025.f90
@@ -0,0 +1,8 @@
+! PR libfortran/18025  <coudert@clipper.ens.fr>
+! { dg-do run }
+  character(len=80) :: c
+  write(c, "('#',F0.2,'#')") 1.23
+  if (c /= '#1.23#') call abort
+  write(c, "('#',F0.2,'#')") -1.23
+  if (c /= '#-1.23#') call abort
+  end
diff --git a/gcc/testsuite/gfortran.dg/pr18122.f90 b/gcc/testsuite/gfortran.dg/pr18122.f90
new file mode 100644
index 000000000..3907f0ae1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr18122.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+! test namelist with scalars and arrays.
+! Based on example provided by thomas.koenig@online.de
+
+program sechs_w
+  implicit none
+
+  integer, parameter :: dr=selected_real_kind(15)
+
+  integer, parameter :: nkmax=6
+  real (kind=dr) :: rb(nkmax)
+  integer :: z
+
+  real (kind=dr) :: dg
+  real (kind=dr) :: a
+  real (kind=dr) :: da
+  real (kind=dr) :: delta
+  real (kind=dr) :: s,t
+  integer :: nk
+  real (kind=dr) alpha0
+
+  real (kind=dr) :: phi, phi0, rad, rex, zk, z0, drdphi, dzdphi
+
+  namelist /schnecke/ z, dg, a, t, delta, s, nk, rb, alpha0
+
+  open (10,status="scratch")
+  write (10, *)  "&SCHNECKE"
+  write (10, *)    " z=1,"
+  write (10, *)    " dg=58.4,"
+  write (10, *)    " a=48.,"
+  write (10, *)    " delta=0.4,"
+  write (10, *)    " s=0.4,"
+  write (10, *)    " nk=6,"
+  write (10, *)    " rb=60, 0, 40,"
+  write (10, *)    " alpha0=20.,"
+  write (10, *)    "/"
+
+  rewind (10)
+  read (10,schnecke)
+  close (10)
+  if ((z /= 1)       .or. (dg /= 58.4_dr)  .or. (a /= 48.0_dr)   .or. &
+    (delta /= 0.4_dr).or. (s /= 0.4_dr)    .or. (nk /= 6)        .or. &
+    (rb(1) /= 60._dr).or. (rb(2) /= 0.0_dr).or. (rb(3) /=40.0_dr).or. &
+    (alpha0 /= 20.0_dr)) call abort ()
+end program sechs_w
diff --git a/gcc/testsuite/gfortran.dg/pr18210.f90 b/gcc/testsuite/gfortran.dg/pr18210.f90
new file mode 100644
index 000000000..85c5afa3e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr18210.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! Names in upper case and object names starting column 2
+! Based on example provided by thomas.koenig@online.de
+
+program pr18210
+
+  real :: a
+  character*80 :: buffer
+  namelist /foo/ a
+
+  a = 1.4
+  open (10, status = "scratch")
+  write (10,foo)
+  rewind (10)
+  read (10, '(a)') buffer
+  if (buffer(2:4) /= "FOO") call abort ()
+  read (10, '(a)') buffer
+  if (buffer(1:2) /= " A") call abort ()
+  close (10)
+
+end program pr18210
diff --git a/gcc/testsuite/gfortran.dg/pr18392.f90 b/gcc/testsuite/gfortran.dg/pr18392.f90
new file mode 100644
index 000000000..de156f5a5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr18392.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! pr 18392
+! test namelist with derived types
+! Based on example provided by thomas.koenig@online.de
+
+program pr18392
+  implicit none
+  type foo
+     integer a
+     real b
+  end type foo
+  type(foo) :: a
+  namelist /nl/ a
+  open (10, status="scratch")
+  write (10,*) " &NL"
+  write (10,*) " A%A = 10,"
+  write (10,*) "/"
+  rewind (10)
+  read (10,nl)
+  close (10)
+  IF (a%a /= 10.0) call abort ()
+end program pr18392
diff --git a/gcc/testsuite/gfortran.dg/pr19155.f b/gcc/testsuite/gfortran.dg/pr19155.f
new file mode 100644
index 000000000..770b008f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr19155.f
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR libfortran/19155
+! We accept 'E+00' as a valid real number. The standard says it is not,
+! but doesn't require us to issue an error. Since g77 accepts this as zero,
+! we do the same.
+      real a
+      character*10 c
+      a = 42
+      open (19,status='scratch')
+      write (19,'(A15)') 'E+00'
+      rewind (19)
+      read (19,'(E15.8)') a
+      if (a .ne. 0) call abort
+      close (19)
+
+      c = "+         "
+      read (c,"(F10.4)") a
+      if (a /= 0) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr19216.f b/gcc/testsuite/gfortran.dg/pr19216.f
new file mode 100644
index 000000000..76c393836
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr19216.f
@@ -0,0 +1,18 @@
+! PR libfortran/19216
+! { dg-do run }
+       integer dat(3), i, j
+       data dat / 3,2,1 /
+
+       open (20, status='scratch')
+       write (20,'(A)') '/ 10 20 30'
+       write (20,'(A)') '1 2 3 4'
+       write (20,'(A)') '5 6 7 8'
+       rewind (20)
+       read (20,*) (dat(i), i=1,3)
+       if (dat(1).ne.3 .or. dat(2).ne.2 .or. dat(3).ne.1) call abort
+       read (20,*) I,J
+       if (i .ne. 1 .or. j .ne. 2) call abort
+       read (20,*) I,J
+       if (i .ne. 5 .or. j .ne. 6) call abort
+       close(20)
+       end
diff --git a/gcc/testsuite/gfortran.dg/pr19467.f90 b/gcc/testsuite/gfortran.dg/pr19467.f90
new file mode 100644
index 000000000..ab4fa99c4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr19467.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! pr 19467
+! test namelist with character arrays
+! Based on example provided by paulthomas2@wanadoo.fr
+
+program pr19467
+  implicit none
+  integer             :: ier
+  character(len=2)    :: ch(2)
+  character(len=2)    :: dh(2)=(/"aa","bb"/)
+  namelist /a/ ch
+  open (10, status = "scratch")
+  write (10, *) "&A ch = 'aa' , 'bb' /"
+  rewind (10)
+  READ (10,nml=a, iostat = ier)
+  close (10)
+  if ((ier /= 0) .or. (any (ch /= dh))) call abort ()
+end program pr19467
diff --git a/gcc/testsuite/gfortran.dg/pr19657.f b/gcc/testsuite/gfortran.dg/pr19657.f
new file mode 100644
index 000000000..1fe32ac74
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr19657.f
@@ -0,0 +1,21 @@
+c { dg-do run }
+c pr 19657
+c test namelist not skipped if ending with logical.
+c Based on example provided by fuyuki@ccsr.u-tokyo.ac.jp
+
+      program pr19657
+      implicit none
+      logical   l
+      integer   i, ctr
+      namelist /nm/ i, l
+      open (10, status = "scratch")
+      write (10,*) "&nm i=1,l=t &end"
+      write (10,*) "&nm i=2 &end"
+      write (10,*) "&nm i=3 &end"
+      rewind (10)
+      do ctr = 1,3
+        read (10,nm,end=190)
+        if (i.ne.ctr) call abort ()
+      enddo
+ 190  continue 
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr19926.f90 b/gcc/testsuite/gfortran.dg/pr19926.f90
new file mode 100644
index 000000000..ae70d5b0f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr19926.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+module b
+  type cat
+     integer :: i = 0
+  end type cat
+end module b
+
+program a
+  use b
+  type(cat) z
+  integer :: i = 0, j(4,3,2) = 0
+  call string_comp(i)
+  if (i /= 3) call abort
+  call string_comp(z%i)
+  if (z%i /= 3) call abort
+  call string_comp(j(1,2,1))
+  if (j(1,2,1) /= 3) call abort
+end program a
+
+subroutine string_comp(i)
+   integer, parameter :: map(0:50) = 3
+   integer :: i
+   i = map(42)
+end subroutine string_comp
+
+! { dg-final { cleanup-modules "b" } }
diff --git a/gcc/testsuite/gfortran.dg/pr19928-1.f90 b/gcc/testsuite/gfortran.dg/pr19928-1.f90
new file mode 100644
index 000000000..a8b04d8e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr19928-1.f90
@@ -0,0 +1,11 @@
+! PR 19928.  Check the use of constant substring indexes in a
+! scalarization loop.
+! { dg-do run }
+program main
+  implicit none
+  character (len = 5), dimension (2) :: a
+  character (len = 3), dimension (2) :: b
+  a = (/ 'abcde', 'ghijk' /)
+  b = a(:)(2:4)
+  if (b(1) .ne. 'bcd' .or. b(2) .ne. 'hij') call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/pr19928-2.f90 b/gcc/testsuite/gfortran.dg/pr19928-2.f90
new file mode 100644
index 000000000..6bfdd0f30
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr19928-2.f90
@@ -0,0 +1,23 @@
+! Related to PR 19928.  Check that foo() is only called once per statement.
+! { dg-do run }
+program main
+  implicit none
+  type t
+    integer, dimension (5) :: field
+  end type t
+  type (t), dimension (2) :: a
+  integer :: calls, i, j
+
+  forall (i = 1:2, j = 1:5) a(i)%field(j) = i * 100 + j
+  calls = 0
+  if (sum (a%field(foo(calls))) .ne. 304) call abort
+  if (calls .ne. 1) call abort
+  if (sum (a(foo(calls))%field) .ne. 1015) call abort
+  if (calls .ne. 2) call abort
+contains
+  function foo (calls)
+    integer :: calls, foo
+    calls = calls + 1
+    foo = 2
+  end function foo 
+end program main
diff --git a/gcc/testsuite/gfortran.dg/pr19936_1.f90 b/gcc/testsuite/gfortran.dg/pr19936_1.f90
new file mode 100644
index 000000000..440c1d9d7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr19936_1.f90
@@ -0,0 +1,5 @@
+! { dg-do compile }
+program pr19936_1
+  integer, parameter :: i=4
+  print *,(/(i,i=1,4)/) ! { dg-error "variable definition context" }
+end program pr19936_1
diff --git a/gcc/testsuite/gfortran.dg/pr19936_2.f90 b/gcc/testsuite/gfortran.dg/pr19936_2.f90
new file mode 100644
index 000000000..ad43c943f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr19936_2.f90
@@ -0,0 +1,5 @@
+! { dg-do compile }
+program pr19936_2
+  integer i
+  print *,(/(i,i=1a,4)/) ! { dg-error "Syntax error in iterator" }
+end program pr19936_2
diff --git a/gcc/testsuite/gfortran.dg/pr19936_3.f90 b/gcc/testsuite/gfortran.dg/pr19936_3.f90
new file mode 100644
index 000000000..6f6f8ba37
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr19936_3.f90
@@ -0,0 +1,5 @@
+! { dg-do compile }
+program pr19936_3
+  integer, parameter :: i = 4
+  print *,(/(i,i,4)/) ! { dg-error "Syntax error in COMPLEX" }
+end program pr19936_3
diff --git a/gcc/testsuite/gfortran.dg/pr20086.f90 b/gcc/testsuite/gfortran.dg/pr20086.f90
new file mode 100644
index 000000000..26b53276d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr20086.f90
@@ -0,0 +1,16 @@
+! { dg-do run }     
+! { dg-options "-std=legacy" }
+!
+! PR 20086 - Missing characters in output with hollerith strings
+      implicit none
+      character*80 line
+      write(line,2070)
+      if (line.ne.'  stiffness reformed for this high step')call abort
+      write(line,2090)
+      if (line.ne.'  stiffness reformed for hello hello')call abort 
+      stop
+
+ 2070  format (2x,37hstiffness reformed for this high step)
+ 2090  format (2x,34hstiffness reformed for hello hello)
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr20124.f90 b/gcc/testsuite/gfortran.dg/pr20124.f90
new file mode 100644
index 000000000..5d05abf6e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr20124.f90
@@ -0,0 +1,10 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! pr 20124
+      character*80 line
+      x = -.01
+      y = .01
+      write(line,'(2f10.2)') x, y
+      if (line.ne.'     -0.01      0.01') call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr20163-2.f b/gcc/testsuite/gfortran.dg/pr20163-2.f
new file mode 100644
index 000000000..0638aeaf9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr20163-2.f
@@ -0,0 +1,5 @@
+       open(10,status="foo",err=100) ! { dg-warning "STATUS specifier in OPEN statement .* has invalid value" }
+       call abort
+  100  continue
+       open(10,status="scratch")
+       end
diff --git a/gcc/testsuite/gfortran.dg/pr20257.f90 b/gcc/testsuite/gfortran.dg/pr20257.f90
new file mode 100644
index 000000000..aebfc0354
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr20257.f90
@@ -0,0 +1,10 @@
+! { dg-do run }
+! { dg-skip-if "Too big for local store" { spu-*-* } { "*" } { "" } }
+  integer,parameter :: n = 10000
+  real(8) array(10000)
+
+  array(:) = 0
+  open (10, status='scratch')
+  write (10,*) array
+  close (10)
+end
diff --git a/gcc/testsuite/gfortran.dg/pr20480.f90 b/gcc/testsuite/gfortran.dg/pr20480.f90
new file mode 100644
index 000000000..12e53009d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr20480.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! PR libfortran/20480
+! fxcoudert@gcc.gnu.org
+  character(len=80) c
+  write (c,'(ES12.3)') 0.0
+  if (trim(adjustl(c)) .ne. '0.000E+00') call abort ()
+  write (c,'(EN12.3)') 0.0
+  if (trim(adjustl(c)) .ne. '0.000E+00') call abort ()
+  end
diff --git a/gcc/testsuite/gfortran.dg/pr20755.f b/gcc/testsuite/gfortran.dg/pr20755.f
new file mode 100644
index 000000000..4a9b69cad
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr20755.f
@@ -0,0 +1,12 @@
+! PR libfortran/20755
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+      character*30 s
+      
+      write (s,2000) 0.0, 0.02
+      if (s .ne. "    0.00       2.000E-02") call abort
+      write (s,2000) 0.01, 0.02
+      if (s .ne. "   1.000E-02   2.000E-02") call abort
+ 2000 format (1PG12.3,G12.3)
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr20865.f90 b/gcc/testsuite/gfortran.dg/pr20865.f90
new file mode 100644
index 000000000..e99eb0bed
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr20865.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! PR fortran/20865
+  subroutine tt(j)
+   integer :: j
+  end subroutine
+
+  integer :: i, st
+  st(i) = (i*i+2)
+  call tt(st) ! { dg-error "Statement function .* is not allowed as an actual argument|Invalid procedure argument" }
+  end
diff --git a/gcc/testsuite/gfortran.dg/pr20950.f b/gcc/testsuite/gfortran.dg/pr20950.f
new file mode 100644
index 000000000..942696c61
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr20950.f
@@ -0,0 +1,9 @@
+! PR libfortran/20950
+! Original bug-report by Walt Brainerd, The Fortran Company
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+      character*20 c
+      inquire (33, sequential = c)
+      if (c .ne. "UNKNOWN") call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr20954.f b/gcc/testsuite/gfortran.dg/pr20954.f
new file mode 100644
index 000000000..be820c1e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr20954.f
@@ -0,0 +1,12 @@
+      ! { dg-do run }
+      ! { dg-options "-fdefault-integer-8" }
+      ! Program to test character length type
+      Program pr20954
+      character*16 string (5)
+      character*5 filename
+      character*80 line
+      filename = 'input'
+      open (2,file=filename)
+      write (line, '(5a16)') (string(i),i=1,5)
+      close (2, status='delete')
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr21177.f90 b/gcc/testsuite/gfortran.dg/pr21177.f90
new file mode 100644
index 000000000..48d353123
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr21177.f90
@@ -0,0 +1,55 @@
+! { dg-do run }
+! PR fortran/21177
+module mymod
+  interface tt
+    module procedure tt_i, tt_r, tt_l, tt_c4, tt_c8
+  end interface tt
+contains
+  function tt_l(x) result(y)
+    integer :: y
+    logical, pointer :: x
+    y = 0
+  end function
+  function tt_i(x) result(y)
+    integer :: y
+    integer, pointer :: x
+    y = 1
+  end function
+  function tt_r(x) result(y)
+    integer :: y
+    real, pointer :: x
+    y = 2
+  end function
+  function tt_c4(x) result(y)
+    integer :: y
+    complex(4), pointer :: x
+    y = 3
+  end function
+  function tt_c8(x) result(y)
+    integer :: y
+    complex(8), pointer :: x
+    y = 4
+  end function
+end module mymod
+
+program test
+  use mymod
+  logical, pointer :: l
+  integer, pointer :: i
+  real, pointer :: r
+  complex(4), pointer :: c4
+  complex(8), pointer :: c8
+  
+  if (tt(l) /= 0) call abort()
+  if (tt(i) /= 1) call abort()
+  if (tt(r) /= 2) call abort()
+  if (tt(c4) /= 3) call abort()
+  if (tt(c8) /= 4) call abort()
+  if (tt(null(l)) /= 0) call abort()
+  if (tt(null(i)) /= 1) call abort()
+  if (tt(null(r)) /= 2) call abort()
+  if (tt(null(c4)) /= 3) call abort()
+  if (tt(null(c8)) /= 4) call abort()
+end program test
+
+! { dg-final { cleanup-modules "mymod" } }
diff --git a/gcc/testsuite/gfortran.dg/pr21730.f b/gcc/testsuite/gfortran.dg/pr21730.f
new file mode 100644
index 000000000..1fe19edfa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr21730.f
@@ -0,0 +1,13 @@
+! PR fortran/21730
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+      character*2 a
+      character*4 b
+      character*6 c
+      parameter (a="12")
+      parameter (b = a)
+      write (c,'("#",A,"#")') b
+      if (c .ne. '#12  #') call abort
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/pr22491.f b/gcc/testsuite/gfortran.dg/pr22491.f
new file mode 100644
index 000000000..70210f6b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr22491.f
@@ -0,0 +1,13 @@
+! PR fortran/21730
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+      character*2 a (1)
+      character*4 b (1)
+      character*6 c
+      parameter (a="12")
+      parameter (b = a)
+      write (c,'("#",A,"#")') b
+      if (c .ne. '#12  #') call abort
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/pr23095.f b/gcc/testsuite/gfortran.dg/pr23095.f
new file mode 100644
index 000000000..06b78b348
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr23095.f
@@ -0,0 +1,22 @@
+      ! { dg-do compile { target { { i?86-*-* x86_64-*-* } && ilp32 } } }
+      ! { dg-options "-w -O2 -ffloat-store -fgcse-after-reload" }
+      !
+      ! GCSE after reload made a stack register live across an abnormal
+      ! edges for one of the computed jumps.  This bombed in reg-stack.
+      function foo(n) 
+      real(kind=8) foo 
+      integer ix, n, next 
+      real(kind=8) xmax, absx 
+      foo  = 0.0d0 
+      assign 20 to next 
+      do ix = 1,n 
+         go to next,(10, 30) 
+   10    assign 40 to next 
+         go to 40 
+   20    if (absx .gt. 8.232d-11) go to 40 
+   30    if (absx .le. xmax) go to 40 
+         xmax = absx 
+   40    go to next,(10, 30) 
+      end do 
+      return 
+      end 
diff --git a/gcc/testsuite/gfortran.dg/pr24823.f b/gcc/testsuite/gfortran.dg/pr24823.f
new file mode 100644
index 000000000..1b6f448d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr24823.f
@@ -0,0 +1,78 @@
+!     { dg-do compile }
+!     { dg-options "-O2" }
+!     PR24823 Flow didn't handle a PARALLEL as destination of a SET properly.
+      SUBROUTINE ZLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
+     $     RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER,
+     $     PACK, A, LDA, IWORK, INFO )
+      COMPLEX*16         A( LDA, * ), D( * ), DL( * ), DR( * )
+      LOGICAL            BADPVT, DZERO, FULBND
+      COMPLEX*16         ZLATM2, ZLATM3
+      IF( IGRADE.EQ.4 .AND. MODEL.EQ.0 ) THEN
+      END IF
+      IF( IPVTNG.GT.0 ) THEN
+      END IF
+      IF( M.LT.0 ) THEN
+      ELSE IF( IPACK.EQ.-1 .OR. ( ( IPACK.EQ.1 .OR. IPACK.EQ.2 .OR.
+     $        IPACK.EQ.5 .OR. IPACK.EQ.6 ) .AND. ISYM.EQ.1 ) .OR.
+     $        ( IPACK.EQ.3 .AND. ISYM.EQ.1 .AND. ( KL.NE.0 .OR. M.NE.
+     $        6 ) .AND. LDA.LT.KUU+1 ) .OR.
+     $        ( IPACK.EQ.7 .AND. LDA.LT.KLL+KUU+1 ) ) THEN
+         INFO = -26
+      END IF
+      IF( INFO.NE.0 ) THEN
+         RETURN
+      END IF
+      IF( KUU.EQ.N-1 .AND. KLL.EQ.M-1 )
+     $     FULBND = .TRUE.
+      IF( MODE.NE.0 .AND. MODE.NE.-6 .AND. MODE.NE.6 ) THEN
+         TEMP = ABS( D( 1 ) )
+         IF( TEMP.EQ.ZERO .AND. DMAX.NE.CZERO ) THEN
+            INFO = 2
+         END IF
+      END IF
+      IF( ISYM.EQ.0 ) THEN
+      END IF
+      IF( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR. IGRADE.EQ.
+     $     5 .OR. IGRADE.EQ.6 ) THEN
+         IF( INFO.NE.0 ) THEN
+         END IF
+      END IF
+      IF( FULBND ) THEN
+         IF( IPACK.EQ.0 ) THEN
+            IF( ISYM.EQ.0 ) THEN
+               CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
+     $              IWORK, SPARSE )
+               DO 120 I = 1, M
+                  CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
+     $                 IWORK, SPARSE )
+ 120           CONTINUE
+            END IF
+            IF( I.LT.1 ) THEN
+               IF( ISYM.EQ.0 ) THEN
+                  A( J-I+1, I ) = DCONJG( ZLATM2( M, N, I, J, KL,
+     $                 DR, IPVTNG, IWORK, SPARSE ) )
+               ELSE
+                  A( J-I+1, I ) = ZLATM2( M, N, I, J, KL, KU,
+     $                 IPVTNG, IWORK, SPARSE )
+               END IF
+            END IF
+            IF( ISYM.NE.1 ) THEN
+               IF( I.GE.1 .AND. I.NE.J ) THEN
+                  IF( ISYM.EQ.0 ) THEN
+                  END IF
+               END IF
+               A( I-J+KUU+1, J ) = ZLATM2( M, N, I, J, KL, KU,
+     $              DR, IPVTNG, IWORK, SPARSE )
+            END IF
+         END IF
+      END IF
+      IF( IPACK.EQ.0 ) THEN
+         ONORM = ZLANGB( 'M', N, KLL, KUU, A, LDA, TEMPA )
+      END IF
+      IF( ANORM.GE.ZERO ) THEN
+         IF( ANORM.GT.ZERO .AND. ONORM.EQ.ZERO ) THEN
+            IF( IPACK.LE.2 ) THEN
+            END IF
+         END IF
+      END IF
+      END
diff --git a/gcc/testsuite/gfortran.dg/pr25603.f b/gcc/testsuite/gfortran.dg/pr25603.f
new file mode 100644
index 000000000..fbcbdf51a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr25603.f
@@ -0,0 +1,102 @@
+C { dg-do run }
+C
+C PR rtl-optimization/25603
+C Check if reload handles REG_INC notes correctly.
+      PROGRAM BAR
+      IMPLICIT REAL (A-H, O-Z)
+      DIMENSION WORK(250)
+
+      XSTART = 201.0
+
+      CALL BAR1(NX,NY,NZ,NT,NTIME,NWINDX,NWINDY,NSINKS,NFILT,
+     *XSTART,YSTART,ZSTART,TSTART,DELTAX,DELTAY,DELTAZ,DELTAT,PHI,DL,
+     *DX,DY,DZ,WORK,IB,IK,ITY,NCOUNT,NPRINT,NGRAPH,NPSTEP,NGSTEP)
+      STOP
+      END
+
+      SUBROUTINE BAR2(NX,NY,NZ,NT,NTIME,NWINDX,ISH,NSMT,NFILT,
+     * XSTART,YSTART,ZSTART,TSTART,DELTAX,DELTAY,DELTAZ,DELTAT,PHI,DL,
+     * DX,DY,DZ,IB,IK,ITY,NCOUNT,NPRINT,NGRAPH,NPSTEP,NGSTEP,LFINAL,
+     * C,STEPC,POTT,STEPT,UX,STEPU,VY,STEPV,WZ,PRES,STEPP,Q,DKZM,DKZH,
+     * ELEV,ELEVX,ELEVY,Z0,HMIX,STEPH,TAVR,OBUK,USTR,TSTR,VDEP,DEP,
+     * ZET,HVAR,UM,VM,UG,VG,TM,DKM,DCDX,DCDY,AN,BN,CN,HELP,HELPA)
+      IMPLICIT REAL (A-H, O-Z)
+
+      DIMENSION  C(*),STEPC(*),POTT(*),STEPT(*),UX(*),STEPU(*),
+     * VY(*),STEPV(*),WZ(*),PRES(*),STEPP(*),Q(*),DKZM(*),DKZH(*),
+     * ELEV(*),ELEVX(*),ELEVY(*),Z0(*),HMIX(*),STEPH(*),TAVR(*),
+     * OBUK(*),USTR(*),TSTR(*),VDEP(*), DEP(*),ZET(*),HVAR(*),
+     * UM(*),VM(*),UG(*),VG(*),TM(*),DKM(*), DCDX(*),DCDY(*),
+     * AN(*),BN(*),CN(*),HELP(*),HELPA(*)
+C
+
+      RETURN
+      END
+
+      SUBROUTINE BAR1(NX,NY,NZ,NT,NTIME,NWINDX,NWINDY,NSINKS,NFILT,
+     *XSTART,YSTART,ZSTART,TSTART,DELTAX,DELTAY,DELTAZ,DELTAT,PHI,DL,
+     *DX,DY,DZ,WORK,IB,IK,ITY,NCOUNT,NPRINT,NGRAPH,NPSTEP,NGSTEP)
+
+      IMPLICIT REAL (A-H, O-Z)
+      DIMENSION  WORK(*)
+
+      if (XSTART .NE. 201.0) then
+       call abort
+      endif
+
+      LHELPA = 1
+      LHELP = 1
+      LCN = 1
+      LBN = 1
+      LAN = 1
+      LDCDY = 1
+      LDCDX = 1
+      LKM = 1
+      LTM = 1
+      LVG = 1
+      LUG = 1
+      LVM = 1
+      LUM = 1
+      LHVAR = 1
+      LZET = 1
+      LDEP = 1
+      LVDEP = 1
+      LTSTR = 1
+      LUSTR = 1
+      LOBUK = 1
+      LTAVR = 1
+      LSTEPH = 1
+      LHMIX = 1
+      LZ0 = 1
+      LELEVY = 1
+      LELEVX = 1
+      LELEV = 1
+      LDKZH = 1
+      LDKZM = 1
+      LQ = 1
+      LPSTEP = 1
+      LPI = 1
+      LWZ = 1
+      LVSTEP = 1
+      LVY = 1
+      LUSTEP = 1
+      LUX = 1
+      LTSTEP = 1
+      LPOT = 1
+      LCSTEP = 1
+      LC = 1
+
+      CALL BAR2(NX,NY,NZ,NT,NTIME,NWINDX,NWINDY,NSINKS,NFILT,XSTART,
+     * YSTART,ZSTART,TSTART,DELTAX,DELTAY,DELTAZ,DELTAT,PHI,DL,
+     * DX,DY,DZ,IB,IK,ITY,NCOUNT,NPRINT,NGRAPH,NPSTEP,NGSTEP,LAST,
+     * WORK(LC),WORK(LCSTEP),WORK(LPOT),WORK(LTSTEP),WORK(LUX),
+     * WORK(LUSTEP),WORK(LVY),WORK(LVSTEP),WORK(LWZ),WORK(LPI),
+     * WORK(LPSTEP),WORK(LQ),WORK(LDKZM),WORK(LDKZH),WORK(LELEV),
+     * WORK(LELEVX),WORK(LELEVY),WORK(LZ0),WORK(LHMIX),WORK(LSTEPH),
+     * WORK(LTAVR),WORK(LOBUK),WORK(LUSTR),WORK(LTSTR),WORK(LVDEP),
+     * WORK(LDEP),WORK(LZET),WORK(LHVAR),WORK(LUM),WORK(LVM),WORK(LUG),
+     * WORK(LVG),WORK(LTM),WORK(LKM),WORK(LDCDX),WORK(LDCDY),WORK(LAN),
+     * WORK(LBN),WORK(LCN),WORK(LHELP),WORK(LHELPA))
+
+      RETURN
+      END
diff --git a/gcc/testsuite/gfortran.dg/pr25923.f90 b/gcc/testsuite/gfortran.dg/pr25923.f90
new file mode 100644
index 000000000..e0df5b0c8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr25923.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-O -Wuninitialized" }
+
+module foo
+implicit none
+
+  type bar
+    integer :: yr
+  end type
+
+contains
+
+  function baz(arg) result(res) ! { dg-bogus "res.yr' may be" }
+    type(bar), intent(in) :: arg
+    type(bar) :: res
+    logical, external:: some_func
+    if (.not. some_func(arg)) then
+      call fatal('arg not valid')
+    else
+      res = arg
+    end if
+  end function baz ! { dg-warning "res.yr' may be" }
+
+end module foo
+
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/pr26246_1.f90 b/gcc/testsuite/gfortran.dg/pr26246_1.f90
new file mode 100644
index 000000000..e35bcaca3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr26246_1.f90
@@ -0,0 +1,19 @@
+! PR fortran/26246
+! { dg-options "-fdump-tree-original" }
+! { dg-do compile }
+
+module pr26246_1
+  implicit none
+  contains
+    function foo(string)
+    character(*), intent(in) :: string
+    character(len=len(string)+2) :: foo
+    if (index(trim(string), '"').ne.0) then
+      foo = "'" // trim(string) // "'"
+    end if
+  end function foo
+end module pr26246_1
+
+! { dg-final { scan-tree-dump-times "static int" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-modules "pr26246_1" } }
diff --git a/gcc/testsuite/gfortran.dg/pr26246_2.f90 b/gcc/testsuite/gfortran.dg/pr26246_2.f90
new file mode 100644
index 000000000..440e86856
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr26246_2.f90
@@ -0,0 +1,13 @@
+! PR fortran/26246
+! { dg-options "-fdump-tree-original -fno-automatic" }
+! { dg-do compile }
+
+subroutine foo(string, n)
+  implicit none
+  integer :: n
+  character(len=n + 6), intent(in) :: string
+  if (string .eq. 'abc') call abort
+end subroutine foo
+
+! { dg-final { scan-tree-dump-times "static int" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/pr26524.f b/gcc/testsuite/gfortran.dg/pr26524.f
new file mode 100644
index 000000000..399747742
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr26524.f
@@ -0,0 +1,16 @@
+C PR tree-optimization/26524
+C { dg-do compile }
+C { dg-options "-O2 -ffast-math" }
+      SUBROUTINE CLATM5( PRTYPE, M, N, A, LDA, B, LDB, C, LDC, D, LDD,
+     $                   E, LDE, F, LDF, R, LDR, L, LDL, ALPHA, QBLCKA,
+     $                   QBLCKB )
+      COMPLEX            A( LDA, * ), B( LDB, * ), C( LDC, * ),
+     $                   L( LDL, * ), R( LDR, * )
+      COMPLEX            IMEPS, REEPS
+         DO 240 I = 1, M
+               IF( MOD( I, 2 ).NE.0 .AND. I.LT.M ) THEN
+                  A( I, I-1 ) = -IMEPS*2
+               END IF
+  240    CONTINUE
+      END
+
diff --git a/gcc/testsuite/gfortran.dg/pr28158.f90 b/gcc/testsuite/gfortran.dg/pr28158.f90
new file mode 100644
index 000000000..4556ecd76
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr28158.f90
@@ -0,0 +1,7 @@
+! { dg-do compile { target i?86-*-* x86_64-*-* } }
+! { dg-require-effective-target ilp32 }
+! { dg-options "-O -msse -mfpmath=sse" }
+    subroutine yhalf(z)
+    complex cdexpj,z
+    z=cdexpj((0.d0,1.d0)*z)
+    end
diff --git a/gcc/testsuite/gfortran.dg/pr28971.f90 b/gcc/testsuite/gfortran.dg/pr28971.f90
new file mode 100644
index 000000000..23045fce4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr28971.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! This caused an ICE for gfortrans of July 2006 vintage.  It was a regression
+! that "fixed" itself.  The cause and the fix are mysteries.  This test is intended
+! to signal any further regression, should it occur.
+!
+! Contributed by Oskar Enoksson  <enok@lysator.liu.se>
+
+SUBROUTINE BUG(A,B)
+  IMPLICIT NONE
+  
+  INTEGER   :: A
+  INTEGER   :: B(2)
+  
+  INTEGER, PARAMETER :: C(2) = (/ 1,2 /)
+  
+  WHERE (C(:).EQ.A)
+    B = -1
+  END WHERE
+END SUBROUTINE BUG
+
diff --git a/gcc/testsuite/gfortran.dg/pr29067.f b/gcc/testsuite/gfortran.dg/pr29067.f
new file mode 100644
index 000000000..516711480
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr29067.f
@@ -0,0 +1,18 @@
+      ! { dg-do compile }
+      ! PR fortran/29067
+      implicit none
+      integer :: n, i
+      character(len=16),parameter :: s = "", s2 = "1234567890123456"
+
+      i = 0 ; n = 9
+      print *, s(9:16)
+      print *, s2(9:16)
+      if (s(9:16) == "90123456") then
+      endif
+      if (i > 0) then
+        write (i,*) n
+        call foo(0)
+      endif
+      do i = 1, n
+      end do
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr29713.f90 b/gcc/testsuite/gfortran.dg/pr29713.f90
new file mode 100644
index 000000000..e60904395
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr29713.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+      character*2 a
+      character*4 b
+      parameter (a="12")
+      parameter (b = a(1:2))
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr30391-1.f90 b/gcc/testsuite/gfortran.dg/pr30391-1.f90
new file mode 100644
index 000000000..28ca75427
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr30391-1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-O1" }
+SUBROUTINE check_for_overlap (cell_length)
+  REAL, DIMENSION(1:3), INTENT(IN), OPTIONAL :: cell_length
+  REAL, DIMENSION(1:3) :: abc, box_length
+
+  IF (PRESENT(cell_length)) THEN
+    box_length(1:3)=abc(1:3)
+  ENDIF
+END SUBROUTINE check_for_overlap
diff --git a/gcc/testsuite/gfortran.dg/pr30667.f b/gcc/testsuite/gfortran.dg/pr30667.f
new file mode 100644
index 000000000..0f1af29d1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr30667.f
@@ -0,0 +1,10 @@
+! { dg-do compile { target i?86-*-* x86_64-*-* } }
+! { dg-require-effective-target ilp32 }
+! { dg-options "-O2 -msse -ftree-vectorize" }
+      subroutine cblank_cvb(a,ndim)
+      character*(*) a
+      character*1 blank
+      data blank/' '/
+      do 100 i=1,ndim
+100   a(i:i)=blank
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr31025.f90 b/gcc/testsuite/gfortran.dg/pr31025.f90
new file mode 100644
index 000000000..53fecf864
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr31025.f90
@@ -0,0 +1,9 @@
+! { dg-options "-O2" }
+real*8 function f(x)
+t1 = g(0)
+if(x .eq. 0) then
+  f = 0
+else if(x .eq. 1) then
+  f = t1 *log( t1 )
+end if
+end
diff --git a/gcc/testsuite/gfortran.dg/pr32136.f90 b/gcc/testsuite/gfortran.dg/pr32136.f90
new file mode 100644
index 000000000..304b7b4a2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr32136.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+! Tests PR32136, which went away!
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+real(kind(0d0)), parameter :: r(1) = &
+    transfer(transfer(sqrt(2d0), (/ .true. /) ), (/ 0d0 /), 1)
+    if (r(1) .ne. sqrt(2d0)) call abort ()
+end
+
diff --git a/gcc/testsuite/gfortran.dg/pr32222.f90 b/gcc/testsuite/gfortran.dg/pr32222.f90
new file mode 100644
index 000000000..1daac1ef1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr32222.f90
@@ -0,0 +1,18 @@
+!PR fortran/32222
+! { dg-do compile }
+! { dg-final { cleanup-modules "splinemod" } }
+
+module splinemod
+implicit none
+integer, parameter :: dl = KIND(1.d0)
+Type lSamples
+  integer l(10)
+end Type lSamples
+end module splinemod
+
+subroutine InterpolateClArr(lSet)
+use splinemod
+type (lSamples), intent(in) :: lSet
+real(dl) xl(10)
+xl = real(lSet%l,dl)
+end subroutine InterpolateClArr
diff --git a/gcc/testsuite/gfortran.dg/pr32238.f90 b/gcc/testsuite/gfortran.dg/pr32238.f90
new file mode 100644
index 000000000..2c88b3565
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr32238.f90
@@ -0,0 +1,22 @@
+!PR fortran/32238
+! { dg-do compile }
+! { dg-final { cleanup-modules "bug_test" } }
+
+module bug_test
+
+contains
+  subroutine bug(c)
+
+  implicit none
+
+  integer, parameter :: fp = selected_real_kind(13)
+  complex(kind=fp)              :: c(:,:)
+  where( abs( aimag( c ) ) < 1.e-10_fp )                             &
+  &    c = cmplx( real( c , fp ) , 0._fp , fp )
+  where( abs( real( c , fp ) ) < 1.e-10_fp )                         &
+  &    c = cmplx( 0._fp , aimag( c ) , fp )
+
+  return
+  end subroutine bug
+
+end module bug_test
diff --git a/gcc/testsuite/gfortran.dg/pr32242.f90 b/gcc/testsuite/gfortran.dg/pr32242.f90
new file mode 100644
index 000000000..21ecdd178
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr32242.f90
@@ -0,0 +1,40 @@
+!PR fortran/32242
+! { dg-do compile }
+! { dg-options "-Wreturn-type" }
+! { dg-final { cleanup-modules "kahan_sum" } }
+
+MODULE kahan_sum
+  INTEGER, PARAMETER :: dp=KIND(0.0D0)
+  INTERFACE accurate_sum
+    MODULE PROCEDURE kahan_sum_d1, kahan_sum_z1
+  END INTERFACE accurate_sum
+  TYPE pw_grid_type
+     REAL (KIND=dp), DIMENSION ( : ), POINTER :: gsq
+  END TYPE pw_grid_type
+  TYPE pw_type
+     REAL (KIND=dp), DIMENSION ( : ), POINTER :: cr
+     COMPLEX (KIND=dp), DIMENSION ( : ), POINTER :: cc
+     TYPE ( pw_grid_type ), POINTER :: pw_grid
+  END TYPE pw_type
+CONTAINS
+ FUNCTION kahan_sum_d1(array,mask) RESULT(ks)         ! { dg-warning "not set" }
+   REAL(KIND=dp), DIMENSION(:), INTENT(IN)  :: array
+   LOGICAL, DIMENSION(:), INTENT(IN), &
+     OPTIONAL                               :: mask
+   REAL(KIND=dp)                            :: ks
+ END FUNCTION kahan_sum_d1
+  FUNCTION kahan_sum_z1(array,mask) RESULT(ks)        ! { dg-warning "not set" }
+    COMPLEX(KIND=dp), DIMENSION(:), &
+      INTENT(IN)                             :: array
+    LOGICAL, DIMENSION(:), INTENT(IN), &
+      OPTIONAL                               :: mask
+    COMPLEX(KIND=dp)                         :: ks
+  END FUNCTION kahan_sum_z1
+
+FUNCTION pw_integral_a2b ( pw1, pw2 ) RESULT ( integral_value )
+    TYPE(pw_type), INTENT(IN)                :: pw1, pw2
+    REAL(KIND=dp)                            :: integral_value
+     integral_value = accurate_sum ( REAL ( CONJG ( pw1 % cc ( : ) ) &
+          *  pw2 % cc ( : ) ,KIND=dp) * pw1 % pw_grid % gsq ( : ) )
+END FUNCTION pw_integral_a2b
+END MODULE
diff --git a/gcc/testsuite/gfortran.dg/pr32533.f90 b/gcc/testsuite/gfortran.dg/pr32533.f90
new file mode 100644
index 000000000..c312415eb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr32533.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-O2 -ftree-vectorize -ffast-math" }
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+SUBROUTINE T(nsubcell,sab_max,subcells)
+  INTEGER, PARAMETER :: dp=KIND(0.0D0)
+  REAL(dp) :: sab_max(3), subcells,nsubcell(3)
+  nsubcell(:) = MIN(MAX(1,NINT(0.5_dp*subcells/sab_max(:))),20)
+END SUBROUTINE T
+
+INTEGER, PARAMETER :: dp=KIND(0.0D0)
+REAL(dp) :: sab_max(3), subcells,nsubcell(3)
+subcells=2.0_dp
+sab_max=0.590060749244805_dp
+CALL T(nsubcell,sab_max,subcells)
+IF (ANY(nsubcell.NE.2.0_dp)) CALL ABORT()
+END
diff --git a/gcc/testsuite/gfortran.dg/pr32535.f90 b/gcc/testsuite/gfortran.dg/pr32535.f90
new file mode 100644
index 000000000..43ea48e04
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr32535.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+!
+! PR32535: namelist with private items contained in sub-sub-procedure of a module rejected
+!
+! Contributed by Janus Weil <jaydub66@gmail.com> 
+
+module mo
+implicit none
+real, private:: a,b,c
+
+contains
+
+  subroutine sub
+    implicit none
+    namelist /nl1/ a,b,c
+
+    contains
+
+    subroutine subsub
+      implicit none
+      namelist /nl2/ a,b,c
+    end subroutine subsub
+  end subroutine sub
+end module mo
+
+! { dg-final { cleanup-modules "mo" } }
diff --git a/gcc/testsuite/gfortran.dg/pr32599.f03 b/gcc/testsuite/gfortran.dg/pr32599.f03
new file mode 100644
index 000000000..fa8aa68f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr32599.f03
@@ -0,0 +1,40 @@
+! { dg-do compile }
+! PR fortran/32599
+! Verifies that character string arguments to a bind(c) procedure have length 
+! 1, or no len is specified.  
+module pr32599
+  interface
+     subroutine destroy(path) BIND(C) ! { dg-error "must be length 1" }
+       use iso_c_binding
+       implicit none
+       character(len=*,kind=c_char), intent(IN) :: path 
+     end subroutine destroy
+
+     subroutine create(path) BIND(C) ! { dg-error "must be length 1" }
+       use iso_c_binding
+       implicit none
+       character(len=5,kind=c_char), intent(IN) :: path 
+     end subroutine create
+
+     ! This should be valid.
+     subroutine create1(path) BIND(C)
+       use iso_c_binding
+       implicit none
+       character(len=1,kind=c_char), intent(IN) :: path 
+     end subroutine create1
+
+     ! This should be valid.
+     subroutine create2(path) BIND(C)
+       use iso_c_binding
+       implicit none
+       character(kind=c_char), intent(IN) :: path
+     end subroutine create2
+
+     ! This should be valid.
+     subroutine create3(path) BIND(C)
+       use iso_c_binding
+       implicit none
+       character(kind=c_char), dimension(*), intent(IN) :: path
+     end subroutine create3
+  end interface
+end module pr32599
diff --git a/gcc/testsuite/gfortran.dg/pr32601.f03 b/gcc/testsuite/gfortran.dg/pr32601.f03
new file mode 100644
index 000000000..90fa6b3f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr32601.f03
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! PR fortran/32601
+module pr32601
+use, intrinsic :: iso_c_binding, only: c_int
+contains
+  function get_ptr()
+    integer(c_int), pointer :: get_ptr
+    integer(c_int), target :: x
+    get_ptr = x
+  end function get_ptr
+end module pr32601
+
+USE ISO_C_BINDING, only: c_null_ptr, c_ptr, c_loc
+use pr32601
+implicit none
+
+type(c_ptr) :: t
+t = c_null_ptr
+
+! Next two lines should be errors if -pedantic or -std=f2003
+print *, c_null_ptr, t  ! { dg-error "has PRIVATE components" }
+print *, t ! { dg-error "has PRIVATE components" }
+
+print *, c_loc(get_ptr()) ! { dg-error "has PRIVATE components" }
+
+end
+! { dg-final { cleanup-modules "pr32601" } }  
diff --git a/gcc/testsuite/gfortran.dg/pr32601_1.f03 b/gcc/testsuite/gfortran.dg/pr32601_1.f03
new file mode 100644
index 000000000..3e9aa7384
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr32601_1.f03
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! PR fortran/32601
+use, intrinsic :: iso_c_binding, only: c_loc, c_ptr
+implicit none
+
+! This was causing an ICE, but is an error because the argument to C_LOC 
+! needs to be a variable.
+print *, c_loc(4) ! { dg-error "not a variable" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/pr32627.f03 b/gcc/testsuite/gfortran.dg/pr32627.f03
new file mode 100644
index 000000000..f8695e006
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr32627.f03
@@ -0,0 +1,32 @@
+! { dg-do run }
+! { dg-additional-sources pr32627_driver.c }
+! Verify that c_f_pointer exists for string arguments.
+program main
+  use iso_c_binding
+  implicit none
+  interface
+     function get_c_string() bind(c)
+       use, intrinsic :: iso_c_binding, only: c_ptr
+       type(c_ptr) :: get_c_string
+     end function get_c_string
+  end interface
+
+  type, bind( c ) :: A
+    integer( c_int ) :: xc, yc
+    type( c_ptr )    :: str
+  end type
+  type( c_ptr )               :: x
+  type( A ), pointer          :: fptr
+  type( A ), target           :: my_a_type
+  character( len=9 ), pointer :: strptr
+
+  fptr => my_a_type
+
+  fptr%str = get_c_string()
+
+  call c_f_pointer( fptr%str, strptr )
+
+  print *, 'strptr is: ', strptr
+end program main
+
+  
diff --git a/gcc/testsuite/gfortran.dg/pr32627_driver.c b/gcc/testsuite/gfortran.dg/pr32627_driver.c
new file mode 100644
index 000000000..24b7872ed
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr32627_driver.c
@@ -0,0 +1,4 @@
+char *get_c_string()
+{
+  return "c_string";
+}
diff --git a/gcc/testsuite/gfortran.dg/pr32635.f b/gcc/testsuite/gfortran.dg/pr32635.f
new file mode 100644
index 000000000..f052651da
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr32635.f
@@ -0,0 +1,51 @@
+C { dg-do run }
+C PR 32635 - this used to call an ICE in verify_ssa at -O2.
+C An empty main program ensures that we cycle through all
+C the options.
+
+      program main
+      end
+
+      subroutine aled7(ix,ib,itable,ip,ip2,imat,nummat,
+     1                 mx0,k,numnp,numel,iadj)
+
+      implicit double precision (a-h,o-z)                                    dp
+
+      common/cale6/fst(16,4),ist(256,14)
+c
+      dimension ib(*),itable(*),ip(3,*),ip2(*),ix(6,*),imat(nummat+1,*)
+c
+c
+      ipnt=1
+      do 20 i=1,numel
+      if (imat(ix(5,i),mx0).ne.1) go to 20
+   20 continue
+c
+      k=0
+      kflg=0
+   25 do 30 i=1,ipnt
+      if (ip(1,i).eq.0) go to 30
+      ii=i
+      go to 40
+   30 continue
+c
+   40 k=k+1
+      iel=ip(3,ii)
+      ib(k+iadj)=i1
+      if (kflg.eq.1) ip(1,ii)=0
+      kflg=1
+c
+      isum=0
+      do 50 i=1,ipnt
+      if (ip(1,i).eq.0) isum=isum+1
+      if (ip(1,i).eq.0.or.ip(1,i).ne.i2) go to 50
+      ii=i
+      if (ip(3,i).eq.iel) go to 40
+   50 continue
+c
+      if (ip(1,ii).eq.i2) go to 40
+      kflg=0
+      if (isum.ne.ipnt) go to 25
+c
+      return
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr32738.f90 b/gcc/testsuite/gfortran.dg/pr32738.f90
new file mode 100644
index 000000000..bee6f184c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr32738.f90
@@ -0,0 +1,46 @@
+! { dg-do compile }
+! PR fortran/32738 
+!
+! A regression that mysteriously appeared and disappeared again.
+! Added to the testsuite "just in case".
+!
+! Contributed by Michael Richmond <michael DOT a DOT richmond AT nasa DT gov>
+!
+
+module cluster_definition
+  implicit none
+  integer, parameter, public:: cluster_size = 1000
+end module cluster_definition
+module cluster_tree
+  use cluster_definition, only: ct_cluster_size => cluster_size
+  implicit none
+  private
+  private:: ct_initialize, ct_dealloc, ct_tree_size
+  public:: initialize, dealloc, tree_size
+  interface initialize
+     module procedure ct_initialize
+  end interface
+  interface dealloc
+     module procedure ct_dealloc
+  end interface
+  interface tree_size
+     module procedure ct_tree_size
+  end interface
+contains
+  subroutine ct_initialize()
+  end subroutine ct_initialize
+  subroutine ct_dealloc()
+  end subroutine ct_dealloc
+  function ct_tree_size(t) result(s)
+    integer :: t
+    integer :: s
+    s = 0
+  end function ct_tree_size
+end module cluster_tree
+program example
+  use cluster_tree
+  implicit none
+     print *, tree_size(1)
+end program example
+
+! { dg-final { cleanup-modules "cluster_definition cluster_tree" } }
diff --git a/gcc/testsuite/gfortran.dg/pr32801.f03 b/gcc/testsuite/gfortran.dg/pr32801.f03
new file mode 100644
index 000000000..10439240e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr32801.f03
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! Verify that C_PTR is auto generated because it's needed by C_LOC.
+! This tests that PR 32801 is fixed.
+PROGRAM c_loc_prob
+  USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_LOC 
+END PROGRAM c_loc_prob
diff --git a/gcc/testsuite/gfortran.dg/pr32921.f b/gcc/testsuite/gfortran.dg/pr32921.f
new file mode 100644
index 000000000..544665051
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr32921.f
@@ -0,0 +1,50 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-lim" }
+! gfortran -c -m32 -O2 -S junk.f
+!
+      MODULE LES3D_DATA
+
+      IMPLICIT REAL*8 (A-H,O-Z)
+
+      PARAMETER ( NSPECI = 1, ND = 7 + NSPECI )
+
+      INTEGER IMAX
+
+      DOUBLE PRECISION,ALLOCATABLE,DIMENSION(:,:,:) ::
+     >         UAV,QAV
+
+
+      END MODULE LES3D_DATA
+!---------------------------------------------------------------------
+!------------------------------------------------------------------------
+      SUBROUTINE FLUXI()
+
+      USE LES3D_DATA
+      IMPLICIT REAL*8(A-H,O-Z)
+
+      ALLOCATABLE QS(:)
+
+      ALLOCATE( QS(0:IMAX))
+      QS=0D0
+
+      RETURN
+      END
+!------------------------------------------------------------------------
+!------------------------------------------------------------------------
+      SUBROUTINE EXTRAPI()
+
+      USE LES3D_DATA
+      IMPLICIT REAL*8(A-H,O-Z)
+
+      I1 = 0
+      I2 = IMAX - 1
+
+            DO I = I1, I2
+               UAV(I,1,2) = QAV(I,1,2)
+            END DO
+
+      RETURN
+      END
+! { dg-final { scan-tree-dump-times "stride" 4 "lim1" } }
+! { dg-final { cleanup-tree-dump "lim\[1-2\]" } }
+! { dg-final { cleanup-modules "LES3D_DATA" } }
diff --git a/gcc/testsuite/gfortran.dg/pr33074.f90 b/gcc/testsuite/gfortran.dg/pr33074.f90
new file mode 100644
index 000000000..3538d6588
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr33074.f90
@@ -0,0 +1,8 @@
+! PR middle-end/33074
+! { dg-do compile }
+! { dg-options "-O" }
+
+subroutine pr33074(a, w)
+  real a(1), w(1)
+  a(1) = 2.0**int(w(1))
+end
diff --git a/gcc/testsuite/gfortran.dg/pr33449.f90 b/gcc/testsuite/gfortran.dg/pr33449.f90
new file mode 100644
index 000000000..98480b13e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr33449.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-O2 -ftree-vectorize" }
+!
+! Testcase for vectorization (see PR33449).
+!
+subroutine dlarre (w, iblock, work)
+  integer m, i, iblock(*)
+  double precision w(*), work(*)
+
+  m = 0
+  do jblk = 1, 10
+    do i = 1, 10
+      m = m + 1
+      w(m) = -work(i)
+      iblock(m) = 0
+    end do
+  end do
+end
diff --git a/gcc/testsuite/gfortran.dg/pr33646.f90 b/gcc/testsuite/gfortran.dg/pr33646.f90
new file mode 100644
index 000000000..13f65cb06
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr33646.f90
@@ -0,0 +1,59 @@
+! { dg-do compile }
+! PR fortran/33646
+!
+!
+
+module BAR_MODULE
+   implicit none
+   private
+   public    create_
+   interface create_
+      module procedure create
+   end interface
+   type system_type
+       integer(kind=kind(1)) :: max_memory_used
+   end type
+
+contains
+
+   subroutine create(self)
+    type(system_type) :: self
+      pointer :: self
+      allocate(self)
+   end subroutine
+
+end
+
+module FOO_MODULE
+   use BAR_MODULE
+   implicit none
+   private
+   public    create_
+   interface create_
+      module procedure create
+   end interface
+
+   public    create_copy_
+   interface create_copy_
+      module procedure create_copy
+   end interface
+contains
+
+   subroutine create(self)
+    character(*) :: self
+      pointer :: self
+      nullify(self)
+      allocate(self)
+
+      self = " "
+   end subroutine
+
+   subroutine create_copy(self,s)
+    character(*) :: self
+      pointer :: self
+      character(*) :: s
+      call create_(self)
+   end subroutine
+end
+
+! { dg-final { cleanup-modules "BAR_MODULE FOO_MODULE" } }
diff --git a/gcc/testsuite/gfortran.dg/pr33794.f90 b/gcc/testsuite/gfortran.dg/pr33794.f90
new file mode 100644
index 000000000..a2425cec3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr33794.f90
@@ -0,0 +1,50 @@
+! { dg-do run }
+! { dg-options "-O2 -ffast-math -mfpmath=387" { target { { i?86-*-* x86_64-*-* } && lp64 } } }
+! { dg-options "-O2 -ffast-math" }
+
+module scc_m
+  implicit none
+  integer, parameter :: dp = selected_real_kind(15,90)
+contains
+  subroutine self_ind_cir_coil (r, l, turns, mu, self_l)
+  implicit none
+  real (kind = dp), intent(in) :: r, l, turns, mu
+  real (kind = dp), intent(out) :: self_l
+  real (kind = dp) :: alpha, modulus, pk, ak, bk, ae, be, elliptice, elliptick
+  real (kind = dp) :: expected
+  alpha = atan(2.0_dp*r/l)
+  modulus = sin(alpha)
+  pk = 1.0_dp - modulus**2
+  ak = (((0.01451196212_dp*pk+0.03742563713_dp)*pk+ &
+         0.03590092383_dp)*pk+0.09666344259_dp)*pk+1.38629436112_dp
+  bk = (((0.00441787012_dp*pk+0.03328355346_dp)*pk+ &
+         0.06880248576_dp)*pk+0.12498593597_dp)*pk+0.5_dp
+  elliptick = ak - bk * log(pk)
+  ae = (((0.01736506451_dp*pk+0.04757383546_dp)*pk+ &
+         0.0626060122_dp)*pk+0.44325141463_dp)*pk+1.0_dp
+  be = (((0.00526449639_dp*pk+0.04069697526_dp)*pk+ &
+         0.09200180037_dp)*pk+0.2499836831_dp)*pk
+  elliptice = ae - be * log(pk)
+  self_l = (mu * turns**2 * l**2 * 2.0_dp * r)/3.0_dp * &
+           (((tan(alpha)**2-1.0_dp)*elliptice+elliptick)/sin(alpha) - &
+            tan(alpha)**2)
+  expected = 3.66008420600434162E-002_dp
+  if (abs(self_l - expected) / expected > 1e-3) &
+        call abort
+  end subroutine self_ind_cir_coil
+end module scc_m
+
+program test
+  use scc_m
+  implicit none
+
+  real (kind = dp) :: mu, turns, r, l, self_l
+  mu = 1.25663706143591729E-006_dp
+  turns = 166666.66666666666_dp
+  l = 3.00000000000000006E-003_dp
+  r = 2.99999999999999989E-002_dp
+
+  call self_ind_cir_coil (r, l, turns, mu, self_l)
+end program test
+
+! { dg-final { cleanup-modules "scc_m" } }
diff --git a/gcc/testsuite/gfortran.dg/pr34163.f90 b/gcc/testsuite/gfortran.dg/pr34163.f90
new file mode 100644
index 000000000..642617736
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr34163.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-O2 -fpredictive-commoning -fdump-tree-pcom-details" }
+subroutine trisolve2(x,i1,i2,nxyz)
+integer :: nxyz
+real,dimension(nxyz):: au1
+real,allocatable,dimension(:) :: gi
+integer :: i1 , i2
+real,dimension(i2)::x
+integer :: i
+allocate(gi(nxyz))
+do i = i1+1 , i2
+   x(i) = gi(i)*(x(i)-au1(i-1)*x(i-1))
+enddo
+end subroutine trisolve2
+! { dg-final { scan-tree-dump "Executing predictive commoning" "pcom" } }
+! { dg-final { cleanup-tree-dump "pcom" } }
diff --git a/gcc/testsuite/gfortran.dg/pr35662.f90 b/gcc/testsuite/gfortran.dg/pr35662.f90
new file mode 100644
index 000000000..33095f002
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr35662.f90
@@ -0,0 +1,20 @@
+! PR target/35662
+! { dg-do run }
+! { dg-options "-O1" }
+
+subroutine f(x, y, z)
+  real, intent (in) :: x
+  real, intent (out) :: y, z
+  y = sin (x)
+  z = cos (x)
+end subroutine f
+
+program pr35662
+  real :: x, y, z
+  x = 3.1415926535897932384626433832795029
+  call f (x, y, z)
+  if (abs (y) > 1.0e-5 .or. abs (z + 1.0) > 1.0e-5) call abort
+  x = x / 2.0
+  call f (x, y, z)
+  if (abs (y - 1.0) > 1.0e-5 .or. abs (z) > 1.0e-5) call abort
+end program pr35662
diff --git a/gcc/testsuite/gfortran.dg/pr35944-1.f90 b/gcc/testsuite/gfortran.dg/pr35944-1.f90
new file mode 100644
index 000000000..76521cad9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr35944-1.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+
+  implicit none
+  integer i
+  real rda1(10), rda(10), rval
+  double precision dda1(10), dda(10), dval
+
+  rda = (/ 1,2,3,4,5,6,7,8,9,10 /)
+  rDA1 = MOD (1.1*(rDA(1)-5.0), P=(rDA-2.5))
+  DO i = 1, 10
+    rVAL = MOD (1.1*(rDA(1)-5.0), P=(rDA(i)-2.5))
+    if (rval /= rda1(i)) call abort
+  enddo
+
+  dda = (/ 1,2,3,4,5,6,7,8,9,10 /)
+  dDA1 = MOD (1.1d0*(dDA(1)-5.0d0), P=(dDA-2.5d0))
+  DO i = 1, 10
+    dVAL = MOD (1.1d0*(dDA(1)-5.0d0), P=(dDA(i)-2.5d0))
+    if (dval /= dda1(i)) call abort
+  enddo
+
+end
diff --git a/gcc/testsuite/gfortran.dg/pr35944-2.f90 b/gcc/testsuite/gfortran.dg/pr35944-2.f90
new file mode 100644
index 000000000..976332ded
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr35944-2.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+
+  implicit none
+  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+  integer :: i
+  real(k) :: qda1(10), qda(10), qval
+
+  qda = (/ 1,2,3,4,5,6,7,8,9,10 /)
+  QDA1 = MOD (1.1_k*(QDA(1)-5.0_k), P=(QDA-2.5_k))
+  DO i = 1, 10
+    QVAL = MOD (1.1_k*(QDA(1)-5.0_k), P=(QDA(i)-2.5_k))
+    if (qval /= qda1(i)) call abort
+  enddo
+end
diff --git a/gcc/testsuite/gfortran.dg/pr35983.f90 b/gcc/testsuite/gfortran.dg/pr35983.f90
new file mode 100644
index 000000000..5cc385502
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr35983.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+!
+! PR fortran/35983
+! C_LOC expanded to a NULL_PTR expr if called from a structure constructor
+!
+! Contributed by François-Xavier Coudert
+
+program main
+   use ISO_C_BINDING
+   implicit none
+   type, bind(C) :: descr
+      type(C_PTR) :: address
+   end type descr
+   type(descr) :: DD
+   double precision, target :: buf(1)
+   integer (C_INTPTR_T) :: i, j
+
+   buf = (/ 0 /)
+   DD = descr(c_loc(buf))
+   i = transfer (DD%address, 0_c_intptr_t)
+   j = transfer (c_loc(buf), 0_c_intptr_t)
+   if (any((/ i,j /) == 0_c_intptr_t)) call abort
+   if (i /= j) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/pr36006-1.f90 b/gcc/testsuite/gfortran.dg/pr36006-1.f90
new file mode 100644
index 000000000..ad33d947d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr36006-1.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+subroutine test4
+  integer, parameter :: wp = 4
+  complex(wp), parameter :: i = (0._wp, 1._wp)
+  complex(wp) :: c(12)
+  integer :: m, N
+
+  N = 12
+  c = (/(exp(i*m),m=1,N)/)
+  print *, c(1)
+end
+
+subroutine test8
+  integer, parameter :: wp = 8
+  complex(wp), parameter :: i = (0._wp, 1._wp)
+  complex(wp) :: c(12)
+  integer :: m, N
+
+  N = 12
+  c = (/(exp(i*m),m=1,N)/)
+  print *, c(1)
+end
diff --git a/gcc/testsuite/gfortran.dg/pr36006-2.f90 b/gcc/testsuite/gfortran.dg/pr36006-2.f90
new file mode 100644
index 000000000..f422e09a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr36006-2.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-require-effective-target fortran_large_real }
+!
+subroutine test_large
+  integer, parameter :: wp = selected_real_kind (precision (0.0_8) + 1)
+  complex(wp), parameter :: i = (0._wp, 1._wp)
+  complex(wp) :: c(12)
+  integer :: m, N
+
+  N = 12
+  c = (/(exp(i*m),m=1,N)/)
+  print *, c(1)
+end
diff --git a/gcc/testsuite/gfortran.dg/pr36206.f b/gcc/testsuite/gfortran.dg/pr36206.f
new file mode 100644
index 000000000..7b0b56639
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr36206.f
@@ -0,0 +1,95 @@
+! { dg-do compile }
+! { dg-options "-O3" }
+! PR fortran/36206
+
+      SUBROUTINE SSPR(UPLO,N,ALPHA,X,INCX,AP)
+      REAL ALPHA
+      INTEGER INCX,N
+      CHARACTER UPLO
+      REAL AP(*),X(*)
+      REAL ZERO
+      PARAMETER (ZERO=0.0E+0)
+      REAL TEMP
+      INTEGER I,INFO,IX,J,JX,K,KK,KX
+      LOGICAL LSAME
+      EXTERNAL LSAME
+      EXTERNAL XERBLA
+
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (N.LT.0) THEN
+          INFO = 2
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 5
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('SSPR  ',INFO)
+          RETURN
+      END IF
+      IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+      KK = 1
+      IF (LSAME(UPLO,'U')) THEN
+          IF (INCX.EQ.1) THEN
+              DO 20 J = 1,N
+                  IF (X(J).NE.ZERO) THEN
+                      TEMP = ALPHA*X(J)
+                      K = KK
+                      DO 10 I = 1,J
+                          AP(K) = AP(K) + X(I)*TEMP
+                          K = K + 1
+   10                 CONTINUE
+                  END IF
+                  KK = KK + J
+   20         CONTINUE
+          ELSE
+              JX = KX
+              DO 40 J = 1,N
+                  IF (X(JX).NE.ZERO) THEN
+                      TEMP = ALPHA*X(JX)
+                      IX = KX
+                      DO 30 K = KK,KK + J - 1
+                          AP(K) = AP(K) + X(IX)*TEMP
+                          IX = IX + INCX
+   30                 CONTINUE
+                  END IF
+                  JX = JX + INCX
+                  KK = KK + J
+   40         CONTINUE
+          END IF
+      ELSE
+          IF (INCX.EQ.1) THEN
+              DO 60 J = 1,N
+                  IF (X(J).NE.ZERO) THEN
+                      TEMP = ALPHA*X(J)
+                      K = KK
+                      DO 50 I = J,N
+                          AP(K) = AP(K) + X(I)*TEMP
+                          K = K + 1
+   50                 CONTINUE
+                  END IF
+                  KK = KK + N - J + 1
+   60         CONTINUE
+          ELSE
+              JX = KX
+              DO 80 J = 1,N
+                  IF (X(JX).NE.ZERO) THEN
+                      TEMP = ALPHA*X(JX)
+                      IX = JX
+                      DO 70 K = KK,KK + N - J
+                          AP(K) = AP(K) + X(IX)*TEMP
+                          IX = IX + INCX
+   70                 CONTINUE
+                  END IF
+                  JX = JX + INCX
+                  KK = KK + N - J + 1
+   80         CONTINUE
+          END IF
+      END IF
+      RETURN
+      END
diff --git a/gcc/testsuite/gfortran.dg/pr36967.f b/gcc/testsuite/gfortran.dg/pr36967.f
new file mode 100644
index 000000000..4f8589771
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr36967.f
@@ -0,0 +1,25 @@
+! { dg-options "-O2 -fpredictive-commoning" }
+      subroutine foo(x,y,n)
+      integer n
+      real*8 y(n,n,n),x(n,n,n)
+      integer k, j, i
+      do k = 2, n-1
+        do j = 2, n-1
+          do I = 2, n-1
+            y(i,j,k) = y(i,j,k)
+     +        + (x(i-1,j-1,k)
+     +           +  x(i,j-1,k-1)
+     +           +  x(i,j+1,k-1)
+     +           +  x(i,j+1,k+1)
+     +           +  x(i+1,j,k+1))
+     +        + (x(i-1,j-1,k-1)
+     +           +  x(i+1,j-1,k-1)
+     +           +  x(i-1,j+1,k-1)
+     +           +  x(i+1,j+1,k-1)
+     +           +  x(i-1,j+1,k+1)
+     +           +  x(i+1,j+1,k+1))
+          enddo
+        enddo
+      enddo
+      return
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr37243.f b/gcc/testsuite/gfortran.dg/pr37243.f
new file mode 100644
index 000000000..0a606ad77
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr37243.f
@@ -0,0 +1,65 @@
+! PR rtl-optimization/37243
+! { dg-do run }
+! { dg-add-options ieee }
+! Check if register allocator handles IR flattening correctly.
+      SUBROUTINE SCHMD(V,M,N,LDV)
+      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
+      LOGICAL GOPARR,DSKWRK,MASWRK
+      DIMENSION V(LDV,N)
+      COMMON /IOFILE/ IR,IW,IP,IS,IPK,IDAF,NAV,IODA(400)
+      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
+      PARAMETER (ZERO=0.0D+00, ONE=1.0D+00, TOL=1.0D-10)
+      IF (M .EQ. 0) GO TO 180
+      DO 160 I = 1,M
+      DUMI = ZERO
+      DO 100 K = 1,N
+  100 DUMI = DUMI+V(K,I)*V(K,I)
+      DUMI = ONE/ SQRT(DUMI)
+      DO 120 K = 1,N
+  120 V(K,I) = V(K,I)*DUMI
+      IF (I .EQ. M) GO TO 160
+      I1 = I+1
+      DO 140 J = I1,M
+      DUM = -DDOT(N,V(1,J),1,V(1,I),1)
+      CALL DAXPY(N,DUM,V(1,I),1,V(1,J),1)
+  140 CONTINUE
+  160 CONTINUE
+      IF (M .EQ. N) RETURN
+  180 CONTINUE
+      I = M
+      J = 0
+  200 I0 = I
+      I = I+1
+      IF (I .GT. N) RETURN
+  220 J = J+1
+      IF (J .GT. N) GO TO 320
+      DO 240 K = 1,N
+  240 V(K,I) = ZERO
+      CALL DAXPY(N,DUM,V(1,I),1,V(1,I),1)
+  260 CONTINUE
+      DUMI = ZERO
+      DO 280 K = 1,N
+  280 DUMI = DUMI+V(K,I)*V(K,I)
+      IF ( ABS(DUMI) .LT. TOL) GO TO 220
+      DO 300 K = 1,N
+  300 V(K,I) = V(K,I)*DUMI
+      GO TO 200
+  320 END
+      program main
+      DOUBLE PRECISION V
+      DIMENSION V(18, 18)
+      common // v
+
+      call schmd(V, 1, 18, 18)
+      end
+
+      subroutine DAXPY(N,D,V,M,W,L)
+      INTEGER :: N, M, L
+      DOUBLE PRECISION D, V(1,1), W(1,1)
+      end
+
+      FUNCTION DDOT (N,V,M,W,L)
+      INTEGER :: N, M, L
+      DOUBLE PRECISION DDOT, V(1,1), W(1,1)
+      DDOT = 1
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr37286.f90 b/gcc/testsuite/gfortran.dg/pr37286.f90
new file mode 100644
index 000000000..75c681441
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr37286.f90
@@ -0,0 +1,58 @@
+! { dg-do compile }
+
+module general_rand
+  implicit none
+  private
+
+  integer, public, parameter :: GNDP = kind(1.0d0)
+
+  real(kind = GNDP), save :: &
+    gnc = 362436.0 / 16777216.0, &
+    gncd = 7654321.0 / 16777216.0, &
+    gncm = 16777213.0 / 16777216.0
+  integer, save :: &
+    gni97 = 97, &
+    gnj97 = 33
+
+  real(kind = GNDP), save :: gnu(97)
+
+contains
+  subroutine gn_fatal(message)
+    character(len = *), intent(in) :: message
+
+    stop 1 
+  end subroutine gn_fatal
+
+  function gn_monte_rand(min, max) result(monte)
+    real(kind = GNDP), intent(in) :: min 
+    real(kind = GNDP), intent(in) :: max
+    real(kind = GNDP) :: monte
+
+    real :: monte_temp
+
+    if (min > max) then
+      call gn_fatal('gn_monte_rand: min > max')
+    else if (min == max) then
+      call gn_fatal('gn_monte_rand: min = max: returning min')
+      monte_temp = min
+    else
+
+      monte_temp = gnu(gni97) - gnu(gnj97)
+      if (monte_temp < 0.0) then
+        monte_temp = monte_temp + 1.0
+      end if
+
+      gnu(gni97) = monte_temp
+      gni97 = gni97 - 1
+      if (gni97 == 0) then
+        gni97 = 97
+      end if
+    end if
+
+    monte = min + monte_temp * (max - min)
+
+  end function gn_monte_rand
+
+end module general_rand
+
+! { dg-final { cleanup-modules "general_rand" } }
diff --git a/gcc/testsuite/gfortran.dg/pr37287-1.f90 b/gcc/testsuite/gfortran.dg/pr37287-1.f90
new file mode 100644
index 000000000..629966fe9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr37287-1.f90
@@ -0,0 +1,16 @@
+! PR debug/37287
+! { dg-do link }
+! { dg-options "-g -DPR37287_1" }
+! { dg-additional-sources pr37287-2.F90 }
+module pr37287_1
+  use iso_c_binding, only : c_ptr, c_associated, c_null_ptr
+  implicit none
+contains
+  subroutine set_null(ptr)
+      type(c_ptr), intent(out) :: ptr
+      ptr = c_null_ptr
+  end subroutine set_null
+end module pr37287_1
+end
+! { dg-final { cleanup-modules "pr37287_1" } }
+! { dg-final { cleanup-modules "pr37287_2" } }
diff --git a/gcc/testsuite/gfortran.dg/pr37287-2.F90 b/gcc/testsuite/gfortran.dg/pr37287-2.F90
new file mode 100644
index 000000000..330ab42cd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr37287-2.F90
@@ -0,0 +1,10 @@
+! PR debug/37287
+! { dg-do compile }
+! { dg-options "-g" }
+module pr37287_2
+#ifdef PR37287_1
+  use pr37287_1
+#endif
+  implicit none
+end module pr37287_2
+! { dg-final { cleanup-modules "pr37287_2" } }
diff --git a/gcc/testsuite/gfortran.dg/pr38722.f90 b/gcc/testsuite/gfortran.dg/pr38722.f90
new file mode 100644
index 000000000..7a4f63e86
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr38722.f90
@@ -0,0 +1,38 @@
+! PR rtl-optimization/38722
+! { dg-do compile }
+! { dg-options "-O1" }
+SUBROUTINE foo(x, n, ga, gc, vr)
+  TYPE pt
+    DOUBLE PRECISION, DIMENSION (:, :, :), POINTER :: cr
+  END TYPE pt
+  TYPE pu
+    TYPE(pt), POINTER :: pw
+  END TYPE pu
+  LOGICAL, INTENT(in) :: x, ga, gc
+  INTEGER :: i, n
+  LOGICAL :: dd, ep, fe
+  TYPE(pu) :: vr
+  TYPE(pu), DIMENSION(:), POINTER :: v
+  IF (.NOT. fe) THEN
+     IF (ga) THEN
+        CALL bar (dd, ep, gc)
+     END IF
+     IF (x .AND. .NOT. ga) THEN
+        IF (gc) THEN
+          DO i=1,n
+            CALL baz (v(i), x, gc)
+            v(i)%pw%cr = 1.0
+          END DO
+          DO i=1,n
+             IF (ep) THEN
+                IF (dd) THEN
+                   IF (i==1) THEN
+                      v(i)%pw%cr=v(i)%pw%cr + vr%pw%cr
+                   ENDIF
+                END IF
+             END IF
+          END DO
+        END IF
+     ENDIF
+  END IF
+END SUBROUTINE foo
diff --git a/gcc/testsuite/gfortran.dg/pr38868.f b/gcc/testsuite/gfortran.dg/pr38868.f
new file mode 100644
index 000000000..6acd52b18
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr38868.f
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-rtl-expand" }
+      PROGRAM testcase
+      IMPLICIT NONE
+
+      CHARACTER*4 ANER(18)
+      CHARACTER*80 LINE
+      aner = ''
+      ANER(1)='A   '
+      ANER(2)='    '
+      LINE=' '
+      LINE(78:80)='xyz'
+      WRITE(*,'(A82)') "'"//LINE//"'"
+      END
+
+! { dg-final { scan-rtl-dump-times "line\\\+80" 0 "expand" } }
+! { dg-final { cleanup-rtl-dump "expand" } } */
diff --git a/gcc/testsuite/gfortran.dg/pr39152.f b/gcc/testsuite/gfortran.dg/pr39152.f
new file mode 100644
index 000000000..477200f35
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr39152.f
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-O2" }
+      SUBROUTINE CASHES(E,HESS,FC,FA,NORB,NPR)
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER (MXAO=2047)
+      DIMENSION HESS(NPR),E(NORB,*),FC(*),FA(*)
+      COMMON /IJPAIR/ IA(MXAO)
+      COMMON /MCPAR / NFZC,NCORBS,NCI,NORBS,NORBX,NUM
+      K=0
+      DO 200 IU = 1,NORB - NCORBS
+         I = IU + NCORBS
+         II=IA(I)+I
+         DO 100 J = 1,NCORBS
+            IF (I.GT.NORBS) THEN
+               HESS(K)=FC(II) + FA(II) - E(J,J)
+            ELSE
+               HESS(K)=FA(II) - E(I,I) - E(J,J) + FC(JJ) + FA(JJ)
+            END IF
+  100    CONTINUE
+  200 CONTINUE
+      RETURN
+      END
diff --git a/gcc/testsuite/gfortran.dg/pr39666-1.f90 b/gcc/testsuite/gfortran.dg/pr39666-1.f90
new file mode 100644
index 000000000..31840ec1d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr39666-1.f90
@@ -0,0 +1,14 @@
+! PR middle-end/39666
+! { dg-do compile }
+! { dg-options "-O2 -Wuninitialized" }
+
+FUNCTION f(n)
+  INTEGER, INTENT(in) :: n
+  REAL                :: f
+
+  SELECT CASE (n)
+    CASE (:-1); f = -1.0
+    CASE (0);   f =  0.0
+    CASE (1:);  f =  1.0
+  END SELECT
+END FUNCTION
diff --git a/gcc/testsuite/gfortran.dg/pr39666-2.f90 b/gcc/testsuite/gfortran.dg/pr39666-2.f90
new file mode 100644
index 000000000..633d0ba79
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr39666-2.f90
@@ -0,0 +1,14 @@
+! PR middle-end/39666
+! { dg-do compile }
+! { dg-options "-O2 -Wuninitialized" }
+
+FUNCTION f(n)
+  INTEGER, INTENT(in) :: n
+  REAL                :: f
+
+  SELECT CASE (n)
+    CASE (:-1); f = -1.0
+    CASE (0);   f =  0.0
+    CASE (2:);  f =  1.0
+  END SELECT
+END FUNCTION	! { dg-warning "may be used uninitialized" }
diff --git a/gcc/testsuite/gfortran.dg/pr39865.f90 b/gcc/testsuite/gfortran.dg/pr39865.f90
new file mode 100644
index 000000000..fac343674
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr39865.f90
@@ -0,0 +1,84 @@
+! PR fortran/39865
+! { dg-do run }
+
+subroutine f1 (a)
+  character(len=1) :: a(7:)
+  character(len=12) :: b
+  character(len=1) :: c(2:10)
+  write (b, a) 'Hell', 'o wo', 'rld!'
+  if (b .ne. 'Hello world!') call abort
+  write (b, a(:)) 'hell', 'o Wo', 'rld!'
+  if (b .ne. 'hello World!') call abort
+  write (b, a(8:)) 'Hell', 'o wo', 'rld!'
+  if (b .ne. 'Hello world!') call abort
+  c(2) = ' '
+  c(3) = '('
+  c(4) = '3'
+  c(5) = 'A'
+  c(6) = '4'
+  c(7) = ')'
+  write (b, c) 'hell', 'o Wo', 'rld!'
+  if (b .ne. 'hello World!') call abort
+  write (b, c(:)) 'Hell', 'o wo', 'rld!'
+  if (b .ne. 'Hello world!') call abort
+  write (b, c(3:)) 'hell', 'o Wo', 'rld!'
+  if (b .ne. 'hello World!') call abort
+end subroutine f1
+
+subroutine f2 (a)
+  character(len=1) :: a(10:,20:)
+  character(len=12) :: b
+  write (b, a) 'Hell', 'o wo', 'rld!'
+  if (b .ne. 'Hello world!') call abort
+  write (b, a) 'hell', 'o Wo', 'rld!'
+  if (b .ne. 'hello World!') call abort
+end subroutine f2
+
+function f3 ()
+  character(len=1) :: f3(5)
+  f3(1) = '('
+  f3(2) = '3'
+  f3(3) = 'A'
+  f3(4) = '4'
+  f3(5) = ')'
+end function f3
+
+  interface
+    subroutine f1 (a)
+      character(len=1) :: a(:)
+    end
+  end interface
+  interface
+    subroutine f2 (a)
+      character(len=1) :: a(:,:)
+    end
+  end interface
+  interface
+    function f3 ()
+      character(len=1) :: f3(5)
+    end
+  end interface
+  integer :: i, j
+  character(len=1) :: e (6, 7:9), f (3,2), g (10)
+  character(len=12) :: b
+  e = 'X'
+  e(2,8) = ' '
+  e(3,8) = '('
+  e(4,8) = '3'
+  e(2,9) = 'A'
+  e(3,9) = '4'
+  e(4,9) = ')'
+  f = e(2:4,8:9)
+  g = 'X'
+  g(2) = ' '
+  g(3) = '('
+  g(4) = '3'
+  g(5) = 'A'
+  g(6) = '4'
+  g(7) = ')'
+  call f1 (g(2:7))
+  call f2 (f)
+  call f2 (e(2:4,8:9))
+  write (b, f3 ()) 'Hell', 'o wo', 'rld!'
+  if (b .ne. 'Hello world!') call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/pr40587.f b/gcc/testsuite/gfortran.dg/pr40587.f
new file mode 100644
index 000000000..0761d9d7e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr40587.f
@@ -0,0 +1,17 @@
+C PR traget/40587
+C { dg-do compile }
+C { dg-options "-O2" }
+      subroutine TEST(i, r, result)
+      implicit none
+      integer i
+      REAL*8 r
+      REAL*8 result
+      REAL*8 r2
+      if(i.eq.0) then
+         r2 = r
+      else
+         call ERROR()
+      endif
+      result = r2
+      return
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr40839.f90 b/gcc/testsuite/gfortran.dg/pr40839.f90
new file mode 100644
index 000000000..92285295c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr40839.f90
@@ -0,0 +1,5 @@
+! PR fortran/40839
+! { dg-do compile }
+write(fmt='(a)'), 'abc'         ! { dg-error "UNIT not specified" }
+write(fmt='()')                 ! { dg-error "UNIT not specified" }
+end
diff --git a/gcc/testsuite/gfortran.dg/pr40999.f b/gcc/testsuite/gfortran.dg/pr40999.f
new file mode 100644
index 000000000..b6fa85ad5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr40999.f
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-O3 -fwhole-file" }
+
+      SUBROUTINE ZLARFG( ALPHA )
+        COMPLEX*16 ZLADIV
+        ALPHA = ZLADIV( DCMPLX( 1.0D+0 ) )
+      END
+      COMPLEX*16 FUNCTION ZLADIV( X )
+        COMPLEX*16         X
+        CALL DLADIV( DBLE( X ), DIMAG( X ) )
+      END
+
diff --git a/gcc/testsuite/gfortran.dg/pr41011.f b/gcc/testsuite/gfortran.dg/pr41011.f
new file mode 100644
index 000000000..4ad4a8fc5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr41011.f
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-O3 -fwhole-file" }
+      CALL UVSET(NX,NY,NZ,HVAR,ZET,NP,DZ,DKM,UM,VM,UG,VG,TM,DCDX, ! { dg-warning "Rank mismatch" }
+     *ITY,ISH,NSMT,F)
+         CALL DCTDX(NX,NY,NX1,NFILT,C(MLAG),DCDX(MLAG),HELP,HELPA,
+     *   HELP,HELPA,FY,FYC,SAVEY)
+      END
+      SUBROUTINE PADEC(DKS,DKDS,HVAR,WM,WG,FN,NS,AN,BN,CN,IT)
+      COMPLEX*16 WM(*),WG(*),FN(*),AN(*),BN(*),CN(*)
+         BN(J)=F4+AS+GAMMA*F2
+         CN(J)=F4-AS+GAMMA*F2
+         FN(J)=(AS+F4-GAMMA*F2)*H2+(F4-AS-GAMMA*F2)*H0+
+     *   H1*(F3-GAMMA/3.D0)+GAMMA*WG(J)-CONST
+      END
+      SUBROUTINE UVSET(NX,NY,NZ,HVAR,ZET,NP,DZ,DKM,UM,VM,UG,VG,TM,
+     *WORK,ITY,IH,NSMT,F)
+      DIMENSION HVAR(*),ZET(*),TM(*),DKM(*),UM(*),VM(*),UG(*),VG(*),
+     *WORK(*)
+      IF(IH.EQ.0) THEN
+         CALL PADEC(DKM,VM,HVAR,WORK(LWM),WORK(LWG), ! { dg-warning "Rank mismatch" }
+     *   WORK(LF),NZ,WORK(LA),WORK(LB),WORK(LC),ITY)
+      ENDIF
+      END
diff --git a/gcc/testsuite/gfortran.dg/pr41043.f90 b/gcc/testsuite/gfortran.dg/pr41043.f90
new file mode 100644
index 000000000..fab428b4d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr41043.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-O2" }
+      subroutine foo
+      implicit none
+
+      integer :: i
+
+      call gee_i(int(i**huge(0_8),kind=kind(i)))
+
+      end subroutine foo
+
diff --git a/gcc/testsuite/gfortran.dg/pr41126.f90 b/gcc/testsuite/gfortran.dg/pr41126.f90
new file mode 100644
index 000000000..a43758ead
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr41126.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+SUBROUTINE write_cputime( checkpoint  )
+  CHARACTER(LEN=*), INTENT(IN)             :: checkpoint
+  CHARACTER(LEN=LEN_TRIM(checkpoint)+7)    :: string1
+    string1 = ADJUSTL(string1)
+END SUBROUTINE write_cputime
diff --git a/gcc/testsuite/gfortran.dg/pr41162.f b/gcc/testsuite/gfortran.dg/pr41162.f
new file mode 100644
index 000000000..eea3c55f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr41162.f
@@ -0,0 +1,5 @@
+! { dg-do compile }
+! PRs 41154/41162
+      write (*,'(1PD24.15,F4.2,0P)') 1.0d0
+      write (*,'(1PD24.15,F4.2,0P/)') 1.0d0
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr41212.f90 b/gcc/testsuite/gfortran.dg/pr41212.f90
new file mode 100644
index 000000000..4bdae6dad
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr41212.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-options "-O2" }
+program m
+   double precision :: y,z
+   call b(1.0d0,y,z)
+   if (ABS (z - 1.213) > 0.1) call abort
+contains
+     subroutine b( x, y, z)
+       implicit none
+       double precision :: x,y,z
+       integer :: i, k
+       double precision :: h, r
+
+       y = 1.0d0
+       z = 0.0d0
+
+       h = 0
+       DO k = 1,10
+          h = h + 1.0d0/k
+
+          r = 1
+          DO i = 1,k
+             r = (x/(2*i) ) * r
+          END DO
+
+          y = y + (-1)**k * r
+          z = z + (-1)**(k+1) * h * r
+
+          IF ( ABS(2*k/x*r) < 1d-6 ) EXIT
+       END DO
+
+       z = 2*y
+     end subroutine b
+end program m
diff --git a/gcc/testsuite/gfortran.dg/pr41225.f90 b/gcc/testsuite/gfortran.dg/pr41225.f90
new file mode 100644
index 000000000..54daf4d1e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr41225.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-O2 -ffast-math -funroll-loops -ftree-vectorize -g" }
+  SUBROUTINE block_15_1_1_1(kbd,kbc,kad,kac,pbd,pbc,pad,pac,prim,scale)
+    INTEGER, PARAMETER :: dp=8
+    REAL(KIND=dp) :: kbd(1*1), kbc(1*1), kad(15*1), kac(15*1), pbd(1*1), &
+      pbc(1*1), pad(15*1), pac(15*1), prim(15*1*1*1), scale
+    INTEGER                                  :: ma, mb, mc, md, p_index
+      DO md = 1,1
+        DO mc = 1,1
+          DO mb = 1,1
+            DO ma = 1,15
+              p_index=p_index+1
+              tmp = scale*prim(p_index)
+              ks_bd = ks_bd + tmp* pac((mc-1)*15+ma)
+            END DO
+            kbd((md-1)*1+mb) = kbd((md-1)*1+mb) - ks_bd
+          END DO
+        END DO
+      END DO
+  END SUBROUTINE block_15_1_1_1
diff --git a/gcc/testsuite/gfortran.dg/pr41229.f90 b/gcc/testsuite/gfortran.dg/pr41229.f90
new file mode 100644
index 000000000..9f6e566fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr41229.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-O2 -g" }
+SUBROUTINE cp_fm_triangular_multiply()
+    INTEGER, PARAMETER :: dp=KIND(0.0D0)
+    REAL(dp), ALLOCATABLE, DIMENSION(:)      :: tau, work
+    REAL(KIND=dp), DIMENSION(:, :), POINTER  :: a
+    ndim = SIZE(a,2)
+    ALLOCATE(tau(ndim),STAT=istat)
+    ALLOCATE(work(2*ndim),STAT=istat)
+END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/pr41347.f90 b/gcc/testsuite/gfortran.dg/pr41347.f90
new file mode 100644
index 000000000..e8ceef5f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr41347.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-O3" }
+module hsl_ma41_m
+
+   implicit none
+
+   contains
+
+      subroutine solve_ma41
+         integer, dimension(20) :: info
+         call prininfo(15, info)
+      end subroutine solve_ma41
+
+      subroutine prininfo (ni, info)
+         integer, intent(in) ::  ni
+         integer, intent(in), dimension(:) :: info
+
+         integer i
+
+         call prinfo
+
+         contains
+
+            subroutine prinfo
+               do i = 1, ni
+                  write(*,'(i5,1x,i0)') i, info(i)
+               end do
+            end subroutine prinfo
+
+      end subroutine prininfo
+
+end module hsl_ma41_m
+! { dg-final { cleanup-modules "hsl_ma41_m" } }
diff --git a/gcc/testsuite/gfortran.dg/pr41928.f90 b/gcc/testsuite/gfortran.dg/pr41928.f90
new file mode 100644
index 000000000..2805c2d7d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr41928.f90
@@ -0,0 +1,264 @@
+! { dg-do compile }
+! { dg-options "-O -fbounds-check -w" }
+MODULE kinds
+  INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND ( 14, 200 )
+  INTEGER, DIMENSION(:), ALLOCATABLE     :: nco,ncoset,nso,nsoset
+  INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: co,coset
+END MODULE kinds
+MODULE ai_moments
+  USE kinds
+CONTAINS
+  SUBROUTINE cossin(la_max,npgfa,zeta,rpgfa,la_min,&
+                    lb_max,npgfb,zetb,rpgfb,lb_min,&
+                    rac,rbc,kvec,cosab,sinab)
+    REAL(KIND=dp), DIMENSION(ncoset(la_max),&
+      ncoset(lb_max))                        :: sc, ss
+    DO ipgf=1,npgfa
+      DO jpgf=1,npgfb
+        IF (la_max > 0) THEN
+          DO la=2,la_max
+            DO ax=2,la
+              DO ay=0,la-ax
+                sc(coset(ax,ay,az),1) = rap(1)*sc(coset(ax-1,ay,az),1) +&
+                              f2 *          kvec(1)*ss(coset(ax-1,ay,az),1)
+                ss(coset(ax,ay,az),1) = rap(1)*ss(coset(ax-1,ay,az),1) +&
+                              f2 *          kvec(1)*sc(coset(ax-1,ay,az),1)
+              END DO
+            END DO
+          END DO
+          IF (lb_max > 0) THEN
+            DO lb=2,lb_max
+              ss(1,coset(0,0,lb)) = rbp(3)*ss(1,coset(0,0,lb-1)) +&
+                           f2 *         kvec(3)*sc(1,coset(0,0,lb-1))
+              DO bx=2,lb
+                DO by=0,lb-bx
+                  ss(1,coset(bx,by,bz)) = rbp(1)*ss(1,coset(bx-1,by,bz)) +&
+                               f2 *           kvec(1)*sc(1,coset(bx-1,by,bz))
+                END DO
+              END DO
+            END DO
+          END IF
+        END IF
+       DO j=ncoset(lb_min-1)+1,ncoset(lb_max)
+        END DO
+      END DO
+    END DO
+  END SUBROUTINE cossin
+  SUBROUTINE moment(la_max,npgfa,zeta,rpgfa,la_min,&
+                    lb_max,npgfb,zetb,rpgfb,&
+                    lc_max,rac,rbc,mab)
+    REAL(KIND=dp), DIMENSION(:), INTENT(IN)  :: zeta, rpgfa
+    REAL(KIND=dp), DIMENSION(:), INTENT(IN)  :: zetb, rpgfb
+    REAL(KIND=dp), DIMENSION(:, :, :), &
+      INTENT(INOUT)                          :: mab
+    REAL(KIND=dp), DIMENSION(3)              :: rab, rap, rbp, rpc
+    REAL(KIND=dp), DIMENSION(ncoset(la_max),&
+      ncoset(lb_max), ncoset(lc_max))        :: s
+    DO ipgf=1,npgfa
+      DO jpgf=1,npgfb
+        IF (rpgfa(ipgf) + rpgfb(jpgf) < dab) THEN
+          DO k=1, ncoset(lc_max)-1
+            DO j=nb+1,nb+ncoset(lb_max)
+              DO i=na+1,na+ncoset(la_max)
+                mab(i,j,k) = 0.0_dp
+              END DO
+            END DO
+          END DO
+        END IF
+        rpc = zetp*(zeta(ipgf)*rac+zetb(jpgf)*rbc)
+        DO l=2, ncoset(lc_max)
+          lx = indco(1,l)
+          l2 = 0
+          IF ( lz > 0 ) THEN
+            IF ( lz > 1 ) l2 = coset(lx,ly,lz-2)
+          ELSE IF ( ly > 0 ) THEN
+            IF ( ly > 1 ) l2 = coset(lx,ly-2,lz)
+            IF ( lx > 1 ) l2 = coset(lx-2,ly,lz)
+          END IF
+          s(1,1,l) = rpc(i)*s(1,1,l1)
+          IF ( l2 > 0 ) s(1,1,l) = s(1,1,l) + f2*REAL(ni,dp)*s(1,1,l2)
+        END DO
+        DO l = 1, ncoset(lc_max)
+          IF ( lx > 0 ) THEN 
+            lx1 = coset(lx-1,ly,lz)
+          END IF
+          IF ( ly > 0 ) THEN 
+            ly1 = coset(lx,ly-1,lz)
+          END IF
+          IF (la_max > 0) THEN
+            DO la=2,la_max
+              IF ( lz1 > 0 ) s(coset(0,0,la),1,l) = s(coset(0,0,la),1,l) + &
+                             f2z*s(coset(0,0,la-1),1,lz1)
+              IF ( ly1 > 0 ) s(coset(0,1,az),1,l) = s(coset(0,1,az),1,l) + &
+                             f2y*s(coset(0,0,az),1,ly1)
+              DO ay=2,la
+                s(coset(0,ay,az),1,l) = rap(2)*s(coset(0,ay-1,az),1,l) +&
+                                       f2*REAL(ay-1,dp)*s(coset(0,ay-2,az),1,l)
+                IF ( ly1 > 0 ) s(coset(0,ay,az),1,l) = s(coset(0,ay,az),1,l) + &
+                             f2y*s(coset(0,ay-1,az),1,ly1)
+              END DO
+              DO ay=0,la-1
+                IF ( lx1 > 0 ) s(coset(1,ay,az),1,l) = s(coset(1,ay,az),1,l) + &
+                             f2x*s(coset(0,ay,az),1,lx1)
+              END DO
+              DO ax=2,la
+                DO ay=0,la-ax
+                  s(coset(ax,ay,az),1,l) = rap(1)*s(coset(ax-1,ay,az),1,l) +&
+                                          f3*s(coset(ax-2,ay,az),1,l) 
+                  IF ( lx1 > 0 ) s(coset(ax,ay,az),1,l) = s(coset(ax,ay,az),1,l) + &
+                                 f2x*s(coset(ax-1,ay,az),1,lx1)
+                END DO
+              END DO
+            END DO
+            IF (lb_max > 0) THEN
+              DO j=2,ncoset(lb_max)
+                DO i=1,ncoset(la_max)
+                  s(i,j,l) = 0.0_dp
+                END DO
+              END DO
+              DO la=la_start,la_max-1
+                DO ax=0,la
+                  DO ay=0,la-ax
+                    s(coset(ax,ay,az),2,l) = s(coset(ax+1,ay,az),1,l) -&
+                                           rab(1)*s(coset(ax,ay,az),1,l)
+                    s(coset(ax,ay,az),4,l) = s(coset(ax,ay,az+1),1,l) -&
+                                           rab(3)*s(coset(ax,ay,az),1,l)
+                  END DO
+                END DO
+              END DO
+              DO ax=0,la_max
+                DO ay=0,la_max-ax
+                  IF (ax == 0) THEN
+                    s(coset(ax,ay,az),2,l) = rbp(1)*s(coset(ax,ay,az),1,l)
+                  ELSE
+                    s(coset(ax,ay,az),2,l) = rbp(1)*s(coset(ax,ay,az),1,l) +&
+                                            fx*s(coset(ax-1,ay,az),1,l)
+                  END IF
+                  IF (lx1 > 0) s(coset(ax,ay,az),2,l) = s(coset(ax,ay,az),2,l) +&
+                        f2x*s(coset(ax,ay,az),1,lx1)
+                  IF (ay == 0) THEN
+                    s(coset(ax,ay,az),3,l) = rbp(2)*s(coset(ax,ay,az),1,l)
+                  ELSE
+                    s(coset(ax,ay,az),3,l) = rbp(2)*s(coset(ax,ay,az),1,l) +&
+                                            fy*s(coset(ax,ay-1,az),1,l)
+                  END IF
+                  IF (ly1 > 0) s(coset(ax,ay,az),3,l) = s(coset(ax,ay,az),3,l) +&
+                        f2y*s(coset(ax,ay,az),1,ly1)
+                  IF (az == 0) THEN
+                    s(coset(ax,ay,az),4,l) = rbp(3)*s(coset(ax,ay,az),1,l)
+                  ELSE
+                    s(coset(ax,ay,az),4,l) = rbp(3)*s(coset(ax,ay,az),1,l) +&
+                                            fz*s(coset(ax,ay,az-1),1,l)
+                  END IF
+                  IF (lz1 > 0) s(coset(ax,ay,az),4,l) = s(coset(ax,ay,az),4,l) +&
+                        f2z*s(coset(ax,ay,az),1,lz1)
+                END DO
+              END DO
+              DO lb=2,lb_max
+                DO la=la_start,la_max-1
+                  DO ax=0,la
+                    DO ay=0,la-ax
+                      s(coset(ax,ay,az),coset(0,0,lb),l) =&
+                        rab(3)*s(coset(ax,ay,az),coset(0,0,lb-1),l)
+                      DO bx=1,lb
+                        DO by=0,lb-bx
+                          s(coset(ax,ay,az),coset(bx,by,bz),l) =&
+                            rab(1)*s(coset(ax,ay,az),coset(bx-1,by,bz),l)
+                        END DO
+                      END DO
+                    END DO
+                  END DO
+                END DO
+                DO ax=0,la_max
+                  DO ay=0,la_max-ax
+                    IF (az == 0) THEN
+                      s(coset(ax,ay,az),coset(0,0,lb),l) =&
+                        rbp(3)*s(coset(ax,ay,az),coset(0,0,lb-1),l) +&
+                        f3*s(coset(ax,ay,az),coset(0,0,lb-2),l)
+                    END IF
+                    IF (lz1 > 0) s(coset(ax,ay,az),coset(0,0,lb),l) =&
+                                 f2z*s(coset(ax,ay,az),coset(0,0,lb-1),lz1)
+                    IF (ay == 0) THEN
+                      IF (ly1 > 0) s(coset(ax,ay,az),coset(0,1,bz),l) =&
+                                 f2y*s(coset(ax,ay,az),coset(0,0,bz),ly1)
+                      DO by=2,lb
+                        s(coset(ax,ay,az),coset(0,by,bz),l) =&
+                          f3*s(coset(ax,ay,az),coset(0,by-2,bz),l)
+                        IF (ly1 > 0) s(coset(ax,ay,az),coset(0,by,bz),l) =&
+                                 f2y*s(coset(ax,ay,az),coset(0,by-1,bz),ly1)
+                      END DO
+                      s(coset(ax,ay,az),coset(0,1,bz),l) =&
+                        fy*s(coset(ax,ay-1,az),coset(0,0,bz),l)
+                    END IF
+                    IF (ax == 0) THEN
+                      DO by=0,lb-1
+                        IF (lx1 > 0) s(coset(ax,ay,az),coset(1,by,bz),l) =&
+                                 f2x*s(coset(ax,ay,az),coset(0,by,bz),lx1)
+                      END DO
+                      DO bx=2,lb
+                        DO by=0,lb-bx
+                          s(coset(ax,ay,az),coset(bx,by,bz),l) =&
+                            f3*s(coset(ax,ay,az),coset(bx-2,by,bz),l)
+                          IF (lx1 > 0) s(coset(ax,ay,az),coset(bx,by,bz),l) =&
+                                 f2x*s(coset(ax,ay,az),coset(bx-1,by,bz),lx1)
+                        END DO
+                      END DO
+                      DO by=0,lb-1
+                        IF (lx1 > 0) s(coset(ax,ay,az),coset(1,by,bz),l) =&
+                                 f2x*s(coset(ax,ay,az),coset(0,by,bz),lx1)
+                      END DO
+                      DO bx=2,lb
+                        DO by=0,lb-bx
+                          s(coset(ax,ay,az),coset(bx,by,bz),l) =&
+                            f3*s(coset(ax,ay,az),coset(bx-2,by,bz),l)
+                          IF (lx1 > 0) s(coset(ax,ay,az),coset(bx,by,bz),l) =&
+                                 f2x*s(coset(ax,ay,az),coset(bx-1,by,bz),lx1)
+                        END DO
+                      END DO
+                    END IF
+                  END DO
+                END DO
+              END DO
+            END IF
+            IF (lb_max > 0) THEN
+              DO lb=2,lb_max
+                IF (lz1 > 0) s(1,coset(0,0,lb),l) = s(1,coset(0,0,lb),l) +&
+                             f2z*s(1,coset(0,0,lb-1),lz1)
+                IF (ly1 > 0) s(1,coset(0,1,bz),l) = s(1,coset(0,1,bz),l) +&
+                             f2y*s(1,coset(0,0,bz),ly1)
+              DO by=2,lb
+                s(1,coset(0,by,bz),l) = rbp(2)*s(1,coset(0,by-1,bz),l) +&
+                                       f2*REAL(by-1,dp)*s(1,coset(0,by-2,bz),l)
+                IF (lx1 > 0) s(1,coset(1,by,bz),l) = s(1,coset(1,by,bz),l) +&
+                             f2x*s(1,coset(0,by,bz),lx1)
+              END DO
+              DO bx=2,lb
+                DO by=0,lb-bx
+                  IF (lx1 > 0) s(1,coset(bx,by,bz),l) = s(1,coset(bx,by,bz),l) +&
+                               f2x*s(1,coset(bx-1,by,bz),lx1)
+                END DO
+              END DO
+            END DO
+          END IF
+        END IF
+        END DO
+        DO k=2,ncoset(lc_max)
+          DO j=1,ncoset(lb_max)
+          END DO
+        END DO
+      END DO
+    END DO
+  END SUBROUTINE moment
+  SUBROUTINE diff_momop(la_max,npgfa,zeta,rpgfa,la_min,&
+                    order,rac,rbc,difmab,mab_ext)
+    REAL(KIND=dp), DIMENSION(:, :, :), &
+      OPTIONAL, POINTER                      :: mab_ext
+    REAL(KIND=dp), ALLOCATABLE, &
+      DIMENSION(:, :, :)                     :: difmab_tmp
+    DO imom = 1,ncoset(order)-1
+      CALL adbdr(la_max,npgfa,rpgfa,la_min,&
+                 difmab_tmp(:,:,2), difmab_tmp(:,:,3))
+    END DO
+  END SUBROUTINE diff_momop
+END MODULE ai_moments
+! { dg-final { cleanup-modules "ai_moments" } }
diff --git a/gcc/testsuite/gfortran.dg/pr42051.f03 b/gcc/testsuite/gfortran.dg/pr42051.f03
new file mode 100644
index 000000000..308c1e722
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr42051.f03
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! { dg-options "-fno-whole-file" }
+!
+! PR fortran/42051
+! PR fortran/44064
+! Access to freed symbols
+!
+! Testcase provided by Damian Rouson <damian@rouson.net>,
+! reduced by Janus Weil <janus@gcc.gnu.org>.
+
+module grid_module
+  implicit none 
+  type grid
+  end type
+  type field
+    type(grid) :: mesh
+  end type
+contains
+  real function return_x(this)
+    class(grid) :: this
+  end function
+end module 
+
+module field_module
+  use grid_module, only: field,return_x
+  implicit none 
+contains
+  subroutine output(this)
+    class(field) :: this
+    print *,return_x(this%mesh)
+  end subroutine
+end module
+
+end
+
+! { dg-final { cleanup-modules "grid_module field_module" } }
diff --git a/gcc/testsuite/gfortran.dg/pr42108.f90 b/gcc/testsuite/gfortran.dg/pr42108.f90
new file mode 100644
index 000000000..e97dc3756
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr42108.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-fre" }
+
+subroutine  eval(foo1,foo2,foo3,foo4,x,n,nnd)
+  implicit real*8 (a-h,o-z)
+  dimension foo3(n),foo4(n),x(nnd)
+  nw=0
+  foo3(1)=foo2*foo4(1)
+  do i=2,n
+    foo3(i)=foo2*foo4(i)
+    do  j=1,i-1
+      temp=0.0d0
+      jmini=j-i
+      do  k=i,nnd,n
+        temp=temp+(x(k)-x(k+jmini))**2
+      end do
+      temp = sqrt(temp+foo1)
+      foo3(i)=foo3(i)+temp*foo4(j)
+      foo3(j)=foo3(j)+temp*foo4(i)
+    end do
+  end do
+end subroutine eval
+
+! There should be only one load from n left
+
+! { dg-final { scan-tree-dump-times "\\*n_" 1 "fre" } }
+! { dg-final { cleanup-tree-dump "fre" } }
diff --git a/gcc/testsuite/gfortran.dg/pr42119.f90 b/gcc/testsuite/gfortran.dg/pr42119.f90
new file mode 100644
index 000000000..f848e9e9f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr42119.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+
+module Test
+use ISO_C_BINDING
+
+contains
+
+subroutine Callback(arg) bind(C)
+  integer(C_INT)  :: arg
+end subroutine Callback
+
+subroutine Check(proc)
+  type(C_FUNPTR)  :: proc
+end subroutine Check
+
+end module Test
+
+
+program Main
+  use Test
+  type(C_FUNPTR)  :: proc
+
+  call Check(C_FUNLOC(Callback))
+end program Main
diff --git a/gcc/testsuite/gfortran.dg/pr42166.f90 b/gcc/testsuite/gfortran.dg/pr42166.f90
new file mode 100644
index 000000000..910a08c36
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr42166.f90
@@ -0,0 +1,21 @@
+! { dg-options "-O2 -g" }
+
+MODULE powell
+  INTEGER, PARAMETER :: dp=8
+CONTAINS
+  SUBROUTINE newuob (n,  bmat,  ndim,  d,  vlag,  w, npt)
+    REAL(dp), DIMENSION(ndim, *), INTENT(inout) :: bmat
+    REAL(dp), DIMENSION(*), INTENT(inout)    :: d, vlag, w
+    REAL(dp) :: sum
+    INTEGER, INTENT(in) :: npt
+    DO j=1,n
+       jp=npt+j
+       DO k=1,n
+          sum=sum+bmat(jp,k)*d(k)
+       END DO
+       vlag(jp)=sum
+    END DO
+  END SUBROUTINE newuob
+END MODULE powell
+
+! { dg-final { cleanup-modules "powell" } }
diff --git a/gcc/testsuite/gfortran.dg/pr42246-2.f b/gcc/testsuite/gfortran.dg/pr42246-2.f
new file mode 100644
index 000000000..885e3a4ab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr42246-2.f
@@ -0,0 +1,21 @@
+C PR rtl-optimization/42246
+C { dg-do compile { target powerpc*-*-* ia64-*-* x86_64-*-* } }
+C { dg-options "-O2 -fselective-scheduling -fsel-sched-pipelining -fsel-sched-pipelining-outer-loops" }
+
+      subroutine distance(x,clo)
+      implicit real*8 (a-h,o-z)
+      dimension x(2,6),x1(2,6),clo(6)
+      do 60 i=1,2
+        do 20 j=1,6
+          x(i,j)=clo(j)
+   20   continue
+        do 40 iq=1,6
+          x1(i,iq)=0.0d0
+   40   continue
+        do 50 j=1,6
+          x(i,j)=x1(i,j)
+   50   continue
+   60 continue
+      return
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/pr42294.f b/gcc/testsuite/gfortran.dg/pr42294.f
new file mode 100644
index 000000000..946437908
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr42294.f
@@ -0,0 +1,41 @@
+C PR rtl-optimization/42294
+C { dg-do compile { target powerpc*-*-* ia64-*-* x86_64-*-* } }
+C { dg-options "-O2 -fselective-scheduling2 -fsel-sched-pipelining -funroll-all-loops" }
+
+      SUBROUTINE ORIEN(IW,NATOT,NTOTORB,NATORB,P,T)
+      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
+      DIMENSION NATORB(NATOT),P(NTOTORB*(NTOTORB+1)/2)
+      DIMENSION T(NTOTORB,NTOTORB)
+      DO 9000 IATOM=1,NATOT
+         ILAST = NTOTORB
+         IF (IATOM.NE.NATOT) ILAST=NATORB(IATOM+1)-1
+         DO 8000 IAOI=NATORB(IATOM),ILAST
+            DO 7000 IAOJ = IAOI+1,ILAST
+               R2 = 0.0D+00
+               R3 = 0.0D+00
+               DO 6000 INOTA=1,NATOT
+                  DO 5000 IK=NATORB(INOTA),NTOTORB
+                     IMAI=MAX(IK,IAOI)
+                     IMII=MIN(IK,IAOI)
+                     IMAJ=MAX(IK,IAOJ)
+                     IMIJ=MIN(IK,IAOJ)
+                     IKI=(IMAI*(IMAI-1))/2 + IMII
+                     IKJ=(IMAJ*(IMAJ-1))/2 + IMIJ
+                     PIKI=P(IKI)
+                     PIKJ=P(IKJ)
+                     R2 = R2 + (PIKI**4)-6*(PIKI*PIKI*PIKJ*PIKJ)+(PIKJ)
+ 5000             CONTINUE
+ 6000          CONTINUE
+               R2 = (R2/4.0D+00)
+               Q = SQRT(R2*R2 + R3*R3)
+               IF (Q.LT.1.0D-08) GO TO 7000
+               A = COS(THETA)
+               B = -SIN(THETA)
+               CALL ROT1INT(NTOTORB,IAOI,IAOJ,A,B,P)
+ 7000       CONTINUE
+ 8000    CONTINUE
+ 9000 CONTINUE
+      RETURN
+      END
+
+
diff --git a/gcc/testsuite/gfortran.dg/pr43229.f90 b/gcc/testsuite/gfortran.dg/pr43229.f90
new file mode 100644
index 000000000..361ea9455
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr43229.f90
@@ -0,0 +1,10 @@
+! PR debug/43229
+! { dg-do compile }
+! { dg-options "-g -O3 -ffast-math" }
+! { dg-options "-g -O3 -ffast-math -msse3" { target { i?86-*-* x86_64-*-* } } }
+
+function foo (c, d)
+  real(8) :: c(6), d(6), foo
+  x = sum (c * d)
+  foo = exp (-x)
+end function foo
diff --git a/gcc/testsuite/gfortran.dg/pr43475.f90 b/gcc/testsuite/gfortran.dg/pr43475.f90
new file mode 100644
index 000000000..72c0d1834
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr43475.f90
@@ -0,0 +1,14 @@
+! PR middle-end/43475
+! { dg-do compile }
+! { dg-options "-O2" }
+subroutine ss(w)
+  implicit none
+  integer :: w(:)
+  integer :: b,c,d
+  b = w(8)
+  c = 5
+  d = 3
+  call s1(c)
+  call s2(b+c)
+  call s3(w(b))
+end subroutine ss
diff --git a/gcc/testsuite/gfortran.dg/pr43505.f90 b/gcc/testsuite/gfortran.dg/pr43505.f90
new file mode 100644
index 000000000..b912c9ff0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr43505.f90
@@ -0,0 +1,44 @@
+ MODULE MAIN1
+      INTEGER , PARAMETER :: MXGLVL = 87
+      CHARACTER(8) :: SRCTYP
+      REAL :: GRIDWS(MXGLVL)
+      REAL :: ZI, HS
+    END MODULE MAIN1
+
+    PROGRAM TEST
+      USE MAIN1
+      IF (HS >= ZI) THEN
+      ELSEIF (      SRCTYP == 'AREA'     &
+               .OR. SRCTYP == 'AREAPOLY' &
+               .OR. SRCTYP == 'AREACIRC' &
+               .OR. SRCTYP == 'OPENPIT'   ) THEN
+         CALL ANYAVG (MXGLVL, GRIDWS)
+         CALL ANYAVG (MXGLVL, GRIDWS)
+      ELSE
+         IF ( HS > 0.0 ) THEN
+            CALL ANYAVG (MXGLVL, GRIDWS)
+            CALL ANYAVG (MXGLVL, GRIDWS)
+            CALL ANYAVG (MXGLVL, GRIDWS)
+         ENDIF
+      ENDIF
+      IF (HS.LT.ZI) THEN
+         ZI = HS
+      ENDIF
+    contains
+      SUBROUTINE ANYAVG(NLVLS,HTS)
+        INTEGER NLVLS
+        REAL HTS(NLVLS)
+        IF (5.LT.NLVLS) THEN
+           CALL GINTRP (HTS(5),HTS(5+1))
+        ENDIF
+        CALL GINTRP (HTS(5-1), HTS(5))
+      END SUBROUTINE ANYAVG
+
+      subroutine gintrp (x1, x2)
+        print *, x1, x2
+      end subroutine
+
+    END PROGRAM TEST
+! { dg-final { cleanup-modules "main1" } }
+
+
diff --git a/gcc/testsuite/gfortran.dg/pr43688.f90 b/gcc/testsuite/gfortran.dg/pr43688.f90
new file mode 100644
index 000000000..face02212
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr43688.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-O0 -fipa-reference" }
+
+  subroutine sub
+    type :: a
+      integer :: i = 42
+    end type a
+    type(a), target :: dt(2)
+    integer, pointer :: ip(:)
+    ip => dt%i
+  end subroutine
diff --git a/gcc/testsuite/gfortran.dg/pr43793.f90 b/gcc/testsuite/gfortran.dg/pr43793.f90
new file mode 100644
index 000000000..c30f8422b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr43793.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+! PR fortran/30073
+! PR fortran/43793
+!
+! Original code by Joost VandeVondele 
+! Reduced and corrected code by Steven G. Kargl
+!
+module fft_tools
+  implicit none
+  integer, parameter :: lp = 8
+contains
+  subroutine sparse_alltoall (rs, rq, rcount)
+    complex(kind=lp), dimension(:, :), pointer :: rs, rq
+    integer, dimension(:) :: rcount
+    integer :: pos
+    pos = 1
+    if (rcount(pos) /= 0) then
+       rq(1:rcount(pos),pos) = rs(1:rcount(pos),pos)
+    end if
+  end subroutine sparse_alltoall
+end module fft_tools
+! { dg-final { cleanup-modules "fft_tools" } }
diff --git a/gcc/testsuite/gfortran.dg/pr43796.f90 b/gcc/testsuite/gfortran.dg/pr43796.f90
new file mode 100644
index 000000000..2e98d7ca8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr43796.f90
@@ -0,0 +1,51 @@
+! { dg-do compile }
+! { dg-options "-O2 -fcheck=bounds" }
+
+    FUNCTION F06FKFN(N,W,INCW,X,INCX)
+       IMPLICIT NONE
+       INTEGER, PARAMETER :: WP = KIND(0.0D0)
+       REAL (KIND=WP)                  :: F06FKFN
+       REAL (KIND=WP), PARAMETER       :: ONE = 1.0E+0_WP
+       REAL (KIND=WP), PARAMETER       :: ZERO = 0.0E+0_WP
+       INTEGER, INTENT (IN)            :: INCW, INCX, N
+       REAL (KIND=WP), INTENT (IN)     :: W(*), X(*)
+       REAL (KIND=WP)                  :: ABSYI, NORM, SCALE, SSQ
+       INTEGER                         :: I, IW, IX
+       REAL (KIND=WP), EXTERNAL        :: F06BMFN
+       INTRINSIC                          ABS, SQRT
+       IF (N<1) THEN
+          NORM = ZERO
+       ELSE IF (N==1) THEN
+          NORM = SQRT(W(1))*ABS(X(1))
+       ELSE
+          IF (INCW>0) THEN
+             IW = 1
+          ELSE
+             IW = 1 - (N-1)*INCW
+          END IF
+          IF (INCX>0) THEN
+             IX = 1
+          ELSE
+             IX = 1 - (N-1)*INCX
+          END IF
+          SCALE = ZERO
+          SSQ = ONE
+          DO I = 1, N
+             IF ((W(IW)/=ZERO) .AND. (X(IX)/=ZERO)) THEN
+                ABSYI = SQRT(W(IW))*ABS(X(IX))
+                IF (SCALE<ABSYI) THEN
+                   SSQ = 1 + SSQ*(SCALE/ABSYI)**2
+                   SCALE = ABSYI
+                ELSE
+                   SSQ = SSQ + (ABSYI/SCALE)**2
+                END IF
+             END IF
+             IW = IW + INCW
+             IX = IX + INCX
+          END DO
+          NORM = F06BMFN(SCALE,SSQ)
+       END IF
+       F06FKFN = NORM
+       RETURN
+    END FUNCTION F06FKFN
+
diff --git a/gcc/testsuite/gfortran.dg/pr43808.f90 b/gcc/testsuite/gfortran.dg/pr43808.f90
new file mode 100644
index 000000000..97de62892
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr43808.f90
@@ -0,0 +1,18 @@
+! PR target/43808
+! { dg-do run }
+! { dg-options "-O0 -fipa-reference -fschedule-insns -fstrict-aliasing" }
+
+  type :: a
+    integer, allocatable :: i(:)
+  end type a
+  type :: b
+    type (a), allocatable :: j(:)
+  end type b
+  type(a) :: x(2)
+  type(b) :: y(2)
+  x(1) = a((/1,2,3,4/))
+  x(2) = a((/1,2,3,4/)+10)
+  y(1) = b((/x(1),x(2)/))
+  y(2) = b((/x(1),x(2)/))
+  if (y(1)%j(1)%i(1) .ne. 1) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/pr43866.f90 b/gcc/testsuite/gfortran.dg/pr43866.f90
new file mode 100644
index 000000000..abfdaa155
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr43866.f90
@@ -0,0 +1,44 @@
+! PR middle-end/43866
+! { dg-do run }
+! { dg-options "-funswitch-loops -fbounds-check" }
+
+MODULE PR43866
+  IMPLICIT NONE
+  TYPE TT
+    REAL(KIND=4), DIMENSION(:,:), POINTER :: A
+    REAL(KIND=8), DIMENSION(:,:), POINTER :: B
+  END TYPE
+CONTAINS
+  SUBROUTINE FOO(M,X,Y,T)
+    TYPE(TT), POINTER :: M
+    INTEGER, INTENT(IN) :: Y, X
+    INTEGER :: C, D
+    LOGICAL :: T
+    REAL(KIND = 4), DIMENSION(:,:), POINTER :: P
+    REAL(KIND = 8), DIMENSION(:,:), POINTER :: Q
+
+    Q => M%B
+    P => M%A
+    DO C=1,X
+      DO D=C+1,Y
+        IF (T) THEN
+          P(D,C)=P(C,D)
+        ELSE
+          Q(D,C)=Q(C,D)
+        ENDIF
+      ENDDO
+    ENDDO
+  END SUBROUTINE FOO
+END MODULE PR43866
+
+  USE PR43866
+  TYPE(TT), POINTER :: Q
+  INTEGER, PARAMETER :: N=17
+  ALLOCATE (Q)
+  NULLIFY (Q%A)
+  ALLOCATE (Q%B(N,N))
+  Q%B=0
+  CALL FOO (Q,N,N,.FALSE.)
+END
+
+! { dg-final { cleanup-modules "pr43866" } }
diff --git a/gcc/testsuite/gfortran.dg/pr43984.f90 b/gcc/testsuite/gfortran.dg/pr43984.f90
new file mode 100644
index 000000000..40c81b84c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr43984.f90
@@ -0,0 +1,56 @@
+! { dg-do compile }
+! { dg-options "-O2 -fno-tree-dominator-opts -fdump-tree-pre" }
+module test
+
+   type shell1quartet_type
+
+   integer(kind=kind(1)) :: ab_l_sum
+   integer(kind=kind(1)), dimension(:), pointer :: ab_form_3dints_x_indices => NULL()
+   integer(kind=kind(1)), dimension(:), pointer :: ab_form_3dints_yz_rms_indices => NULL()
+
+    end type
+
+contains
+subroutine make_esss(self,esss)
+  type(shell1quartet_type) :: self
+  intent(in) :: self
+  real(kind=kind(1.0d0)), dimension(:), intent(out) :: esss
+  real(kind=kind(1.0d0)), dimension(:), pointer :: Izz
+  real(kind=kind(1.0d0)), dimension(:,:), pointer :: Ix,Iy,Iz,Iyz
+  integer(kind=kind(1)), dimension(:), pointer  :: e_x,ii_ivec
+  integer(kind=kind(1)) :: dim, dim1, nroots, ii,z,y
+
+    dim = self%ab_l_sum+1
+    dim1 = self%ab_l_sum+2
+    nroots = (dim1) / 2
+    call create_(Ix,nroots,dim)
+    call create_(Iy,nroots,dim)
+    call create_(Iz,nroots,dim)
+    call create_(Iyz,nroots,dim*dim1/2)
+
+    e_x => self%ab_form_3dints_x_indices
+    ii_ivec => self%ab_form_3dints_yz_rms_indices
+
+    call foo(Ix)
+    call foo(Iy)
+    call foo(Iz)
+
+    esss = ZERO
+    ii = 0
+    do z=1,dim
+      Izz => Iz(:,z)
+      do y=1,dim1-z
+        ii = ii + 1
+        Iyz(:,ii) = Izz * Iy(:,y)
+      end do
+    end do
+    esss = esss + sum(Ix(:,e_x) * Iyz(:,ii_ivec),1)
+
+end subroutine
+
+end
+
+! There should be three loads from iyz.data, not four.
+
+! { dg-final { scan-tree-dump-times "= iyz.data" 3 "pre" } }
+! { dg-final { cleanup-tree-dump "pre" } }
diff --git a/gcc/testsuite/gfortran.dg/pr44592.f90 b/gcc/testsuite/gfortran.dg/pr44592.f90
new file mode 100644
index 000000000..8b043ba33
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr44592.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-options "-O3" }
+! From forall_12.f90
+! Fails with loop reversal at -O3
+!
+  character(len=1) :: b(4) = (/"1","2","3","4"/), c(4)
+  c = b
+  i = 1
+  ! This statement must be here for the abort below
+  b(1:3)(i:i) = b(2:4)(i:i)
+
+  b = c
+  b(4:2:-1)(i:i) = b(3:1:-1)(i:i)
+
+  ! This fails.  If the condition is printed, the result is F F F F
+  if (any (b .ne. (/"1","1","2","3"/))) i = 2
+  print *, b
+  print *, b .ne. (/"1","1","2","3"/)
+  if (i == 2) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/pr44691.f b/gcc/testsuite/gfortran.dg/pr44691.f
new file mode 100644
index 000000000..dc57c4458
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr44691.f
@@ -0,0 +1,41 @@
+C PR rtl-optimization/44691
+C { dg-do compile { target powerpc*-*-* ia64-*-* x86_64-*-* } }
+C { dg-options "-O2 -fselective-scheduling2" }
+
+      SUBROUTINE ORIEN(IW,NATOT,NTOTORB,NATORB,P,T)
+      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
+      DIMENSION NATORB(NATOT),P(NTOTORB*(NTOTORB+1)/2)
+      DIMENSION T(NTOTORB,NTOTORB)
+      DO 9000 IATOM=1,NATOT
+         ILAST = NTOTORB
+         IF (IATOM.NE.NATOT) ILAST=NATORB(IATOM+1)-1
+         DO 8000 IAOI=NATORB(IATOM),ILAST
+            DO 7000 IAOJ = IAOI+1,ILAST
+               R2 = 0.0D+00
+               R3 = 0.0D+00
+               DO 6000 INOTA=1,NATOT
+                  DO 5000 IK=NATORB(INOTA),NTOTORB
+                     IMAI=MAX(IK,IAOI)
+                     IMII=MIN(IK,IAOI)
+                     IMAJ=MAX(IK,IAOJ)
+                     IMIJ=MIN(IK,IAOJ)
+                     IKI=(IMAI*(IMAI-1))/2 + IMII
+                     IKJ=(IMAJ*(IMAJ-1))/2 + IMIJ
+                     PIKI=P(IKI)
+                     PIKJ=P(IKJ)
+                     R2 = R2 + (PIKI**4)-6*(PIKI*PIKI*PIKJ*PIKJ)+(PIKJ)
+ 5000             CONTINUE
+ 6000          CONTINUE
+               R2 = (R2/4.0D+00)
+               Q = SQRT(R2*R2 + R3*R3)
+               IF (Q.LT.1.0D-08) GO TO 7000
+               A = COS(THETA)
+               B = -SIN(THETA)
+               CALL ROT1INT(NTOTORB,IAOI,IAOJ,A,B,P)
+ 7000       CONTINUE
+ 8000    CONTINUE
+ 9000 CONTINUE
+      RETURN
+      END
+
+
diff --git a/gcc/testsuite/gfortran.dg/pr44882.f90 b/gcc/testsuite/gfortran.dg/pr44882.f90
new file mode 100644
index 000000000..ac22459dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr44882.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-O3 -ffast-math -funroll-loops -w" }
+
+      SUBROUTINE TRUDGE(KDIR)
+! There is a type mismatch here for TRUPAR which caused an ICE
+      COMMON /TRUPAR/ DR(10),V(10,10)
+      DO 110 I=1,NDIR
+  110 DR(I)=V(I,JDIR)
+      END
+      SUBROUTINE TRUSRC(LEAVE)
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      COMMON /TRUPAR/ DX(10),V(10,10)
+      END
+
diff --git a/gcc/testsuite/gfortran.dg/pr45308.f03 b/gcc/testsuite/gfortran.dg/pr45308.f03
new file mode 100644
index 000000000..ba96104b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr45308.f03
@@ -0,0 +1,9 @@
+! PR fortran/45308
+! { dg-do run }
+ character(len=36) :: date, time
+ date = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa'
+ time = 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa'
+ call date_and_time (date, time)
+ if (index (date, 'a') /= 0 .or. index (time, 'a') /= 0) &
+   call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/pr45578.f90 b/gcc/testsuite/gfortran.dg/pr45578.f90
new file mode 100644
index 000000000..da8863dc6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr45578.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+!*==CENTCM.spg  processed by SPAG 6.55Dc at 09:26 on 23 Sep 2005
+      SUBROUTINE CENTCM
+      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
+      PARAMETER (NM=16384)
+      PARAMETER (NG=100)
+      PARAMETER (NH=100)
+      PARAMETER (MU=20)
+      PARAMETER (NL=1)
+      PARAMETER (LL=10*NM)
+      PARAMETER (KP=2001,KR=2001,KG=2001)
+      COMMON /LCS   / X0(3,-2:NM) , X(3,-2:NM,5) , XIN(3,-2:NM)
+      COMMON /MOLEC / LPBc(3) , MOLsp , MOLsa , NBX , NBY , NBZ , NPLa ,&
+     &                LPBcsm
+      cm1 = 0.D0
+      cm2 = 0.D0
+      cm3 = 0.D0
+      DO i = 1 , MOLsa
+         cm1 = cm1 + X0(1,i)
+         cm2 = cm2 + X0(2,i)
+         cm3 = cm3 + X0(3,i)
+      ENDDO
+      cm1 = cm1/MOLsa
+      cm2 = cm2/MOLsa
+      cm3 = cm3/MOLsa
+      IF ( (cm1.EQ.0.D0) .AND. (cm2.EQ.0.D0) .AND. (cm3.EQ.0.D0) )      &
+     &     RETURN
+      DO i = 1 , MOLsa
+        X0(1,i) = X0(1,i) - cm1
+        X0(2,i) = X0(2,i) - cm2
+        X0(3,i) = X0(3,i) - cm3
+        XIN(1,i) = XIN(1,i) - cm1
+        XIN(2,i) = XIN(2,i) - cm2
+        XIN(3,i) = XIN(3,i) - cm3
+      ENDDO
+      CONTINUE
+      END
+      PROGRAM test
+      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
+      PARAMETER (NM=16384)
+      PARAMETER (NG=100)
+      PARAMETER (NH=100)
+      PARAMETER (MU=20)
+      PARAMETER (NL=1)
+      PARAMETER (LL=10*NM)
+      PARAMETER (KP=2001,KR=2001,KG=2001)
+      COMMON /LCS   / X0(3,-2:NM) , X(3,-2:NM,5) , XIN(3,-2:NM)
+      COMMON /MOLEC / LPBc(3) , MOLsp , MOLsa , NBX , NBY , NBZ , NPLa ,&
+     &                LPBcsm
+      MOLsa = 10
+      X0 = 1.
+      CALL CENTCM
+      END
diff --git a/gcc/testsuite/gfortran.dg/pr45636.f90 b/gcc/testsuite/gfortran.dg/pr45636.f90
new file mode 100644
index 000000000..24447e837
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr45636.f90
@@ -0,0 +1,14 @@
+! PR fortran/45636
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-forwprop2" }
+! PR 45636 - make sure no memset is needed for a short right-hand side.
+program main
+  character(len=2), parameter :: x='a '
+  character(len=1), parameter :: y='b'
+  character(len=4) :: a, b
+  a = x
+  b = y
+  call sub(a, b)
+end program main
+! { dg-final { scan-tree-dump-times "memset" 0 "forwprop2" } }
+! { dg-final { cleanup-tree-dump "forwprop2" } }
diff --git a/gcc/testsuite/gfortran.dg/pr46190.f90 b/gcc/testsuite/gfortran.dg/pr46190.f90
new file mode 100644
index 000000000..15fad0416
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr46190.f90
@@ -0,0 +1,64 @@
+! { dg-do compile }
+! { dg-options "-O2 -ftree-vectorize" }
+
+      TYPE :: spot_weld_type                                            
+        CHARACTER(8)     PLACE      ! Keyword "NODE" or "POSITION"         
+      END TYPE                                                          
+      TYPE (spot_weld_type),  DIMENSION(:), ALLOCATABLE :: SPOT_WELD    
+      INTEGER, PARAMETER :: LSRT = 12 ! Length of sorted-element-distance array
+      INTEGER                    &
+     &          IETYP(LSRT)        ! -/- Sort array for closest el's, 0/1=tri/qu
+      REAL(KIND(0D0))                                                          &
+     &          DSQRD(LSRT)        ! -/- Sort array for closest el's, d**2
+      LOGICAL                                                                  &
+     &          COINCIDENT,                                                    &
+     &          INSIDE_ELEMENT
+      IF (SPOT_WELD(NSW)%PLACE .EQ. 'POSITION') THEN
+        DO n = 1,LSRT
+        ENDDO
+        DO i = 1,NUMP3
+          DO WHILE (Distance_Squared .GT. DSQRD(n) .AND. n .LE. LSRT)
+          ENDDO
+          IF (n .LT. LSRT) THEN
+            DO k = LSRT-1,n,-1
+              DSQRD(k+1) = DSQRD(k)
+              IETYP(k+1) = IETYP(k)
+            ENDDO
+          ENDIF
+          DO n = 1,LSRT
+            IF (IETYP(n) .EQ. 0) THEN
+              INSIDE_ELEMENT =                                                 &
+     &          Xi1EL(n) .GE. 0.0 .AND. Xi2EL(n) .GE. 0.0
+              IF (DSQRD(n) .LT. Dmin) THEN
+              ENDIF
+            ENDIF
+          ENDDO
+        ENDDO
+        IF (Icount .GT. 0) THEN
+          DO i = 1,Icount
+            CALL USER_MESSAGE                                                  &
+     &          (                                                              &
+     &          )
+          ENDDO
+          CALL USER_MESSAGE                                                    &
+     &          (                                                              &
+     &          )
+        ENDIF
+        IF                                                                     &
+     &          (                                                              &
+     &          .NOT.COINCIDENT                                                &
+     &          )                                                              &
+     &    THEN
+          IF (NP1 .GT. 0) THEN
+            IF (NP1 .GT. 0) THEN
+            ENDIF
+          ENDIF
+        ENDIF
+        IF (.NOT.COINCIDENT) THEN
+          DO i = 1,3
+            IF (NP(i) .GT. 0) THEN
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDIF
+      END
diff --git a/gcc/testsuite/gfortran.dg/pr46259.f b/gcc/testsuite/gfortran.dg/pr46259.f
new file mode 100644
index 000000000..d74e549a2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr46259.f
@@ -0,0 +1,19 @@
+! PR tree-optimization/46259
+! { dg-do compile }
+! { dg-options "-O3" }
+      SUBROUTINE RDSTFR(FRGMNT,IFRAG,PROVEC,FOCKMA,
+     *                  MXBF,MXMO,MXMO2,NTMOF)
+      PARAMETER (MXPT=100, MXFRG=50, MXFGPT=MXPT*MXFRG)
+      CHARACTER*8 WORD,MNAME,PNAME,RNAME
+      COMMON /FRGSTD/ CORD(3,MXPT),PCORD(3,MXPT),POLT(9,MXPT),
+     *                INLPR(4*MXPT),IKFR(MXPT),IKLR(MXPT),
+     *                MNAME(MXPT),PNAME(MXPT),RNAME(MXPT)
+      DO 10 I=1,MXPT
+         INLPR(4*(I-1)+1)=0
+         INLPR(4*(I-1)+2)=0
+         INLPR(4*(I-1)+3)=0
+         INLPR(4*(I-1)+4)=0
+         IKLR(I)=0
+         RNAME(I)='        '
+   10 CONTINUE
+      END
diff --git a/gcc/testsuite/gfortran.dg/pr46297.f b/gcc/testsuite/gfortran.dg/pr46297.f
new file mode 100644
index 000000000..333576064
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr46297.f
@@ -0,0 +1,25 @@
+! { dg-options "-Os -fno-asynchronous-unwind-tables" }
+! { dg-do run }
+
+      real r1(5), r2(5), r3(5)
+      real s1(2), s2(2), s3(2)
+      double precision d1, d2, d3
+      equivalence (r3, s3(2))
+      equivalence (d3, r3(2))
+      s1(1) = 1.
+      s3(1) = 3.
+      r3(1) = 3.
+      d3 = 30.
+      i3 = 3
+      call x (s1, r1, d1, i1, s2, r2, d2, i2, s3, r3, d3, i3)
+      end
+      subroutine x (s1, r1, d1, i1, s2, r2, d2, i2, s3, r3, d3, i3)
+      real r1(5), r2(5), r3(5)
+      real s1(2), s2(2), s3(2)
+      double precision d1, d2, d3
+      if (s1(1) .ne. 1.) call abort
+      if (s3(1) .ne. 3.) call abort
+      if (r3(1) .ne. 3.) call abort
+      if (d3 .ne. 30.) call abort
+      if (i3 .ne. 3) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr46519-1.f b/gcc/testsuite/gfortran.dg/pr46519-1.f
new file mode 100644
index 000000000..51c64b87d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr46519-1.f
@@ -0,0 +1,46 @@
+! { dg-do compile { target i?86-*-* x86_64-*-* } }
+! { dg-options "-O3 -mavx -mvzeroupper -mtune=generic -dp" }
+
+      PROGRAM MG3XDEMO 
+      INTEGER LM, NM, NV, NR, NIT
+
+
+      PARAMETER( LM=7 )
+C      PARAMETER( NIT=40 )
+      PARAMETER( NM=2+2**LM, NV=NM**3 )
+      PARAMETER( NR = (8*(NM**3+NM**2+5*NM-23+7*LM))/7 )
+C
+C
+C If commented line is used than there is no penalty
+C	COMMON /X/ U, V, R, A, C, IR, MM
+	COMMON /X/ A, C, IR, MM
+      REAL*8 A(0:3),C(0:3)
+
+      INTEGER IT, N
+      INTEGER LMI, MTIME, NTIMES
+C
+      READ *,LMI
+      READ *,NIT
+      READ *,NTIMES
+      READ *,U0
+
+      READ 9004, A
+      READ 9004, C
+9004  FORMAT (4D8.0)
+
+      DO I = 0, 3
+	A(I) = A(I)/3.0D0
+	C(I) = C(I)/64.0D0
+      ENDDO
+C
+      N  = 2 + 2**LMI
+
+      WRITE(6,7)N-2,N-2,N-2,NIT
+ 6    FORMAT( I4, 2E19.12)
+ 7    FORMAT(/,' KERNEL B:  SOLVING A POISSON PROBLEM ON A ',I6,' BY ',
+     > I6,' BY ',I6,' GRID,',/,' USING ',I6,' MULTIGRID ITERATIONS.',/)
+C
+      STOP
+      END
+
+! { dg-final { scan-assembler-times "avx_vzeroupper" 1 } }
diff --git a/gcc/testsuite/gfortran.dg/pr46519-2.f90 b/gcc/testsuite/gfortran.dg/pr46519-2.f90
new file mode 100644
index 000000000..b4d698055
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr46519-2.f90
@@ -0,0 +1,31 @@
+! { dg-do compile { target i?86-*-* x86_64-*-* } }
+! { dg-options "-O3 -mavx -mvzeroupper -mtune=generic -dp" }
+
+  SUBROUTINE func(kts, kte, qrz, qiz, rho)
+  IMPLICIT NONE
+  INTEGER, INTENT(IN)               :: kts, kte
+  REAL,    DIMENSION(kts:kte), INTENT(INOUT) :: qrz, qiz, rho
+  INTEGER                              :: k
+  REAL, DIMENSION(kts:kte)    ::  praci, vtiold
+  REAL                          :: fluxout
+  INTEGER                       :: min_q, max_q, var
+  do k=kts,kte
+    praci(k)=0.0
+  enddo
+  min_q=kte
+  max_q=kts-1
+  DO var=1,20
+    do k=max_q,min_q,-1
+       fluxout=rho(k)*qrz(k)
+    enddo
+    qrz(min_q-1)=qrz(min_q-1)+fluxout
+  ENDDO
+  DO var=1,20
+    do k=kts,kte-1
+      vtiold(k)= (rho(k))**0.16
+    enddo
+  ENDDO
+  STOP
+  END SUBROUTINE func
+
+! { dg-final { scan-assembler "avx_vzeroupper" } }
diff --git a/gcc/testsuite/gfortran.dg/pr46665.f90 b/gcc/testsuite/gfortran.dg/pr46665.f90
new file mode 100644
index 000000000..c59e7eaf5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr46665.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! { dg-options "-fipa-pta -fno-tree-ccp -fno-tree-forwprop -g" }
+
+program main
+  implicit none
+  call test ((/ 3, 4, 5 /), f ((/ 3, 4, 5 /)))
+contains
+  subroutine test (expected, x)
+    integer, dimension (:,:,:) :: x
+    integer, dimension (3) :: expected
+    integer :: i, i1, i2, i3
+    do i = 1, 3
+      if (size (x, i) .ne. expected (i)) call abort
+    end do
+    do i1 = 1, expected (1)
+      do i2 = 1, expected (2)
+        do i3 = 1, expected (3)
+          if (x (i1, i2, i3) .ne. i1 + i2 * 10 + i3 * 100) call abort
+        end do
+      end do
+    end do
+  end subroutine test
+
+  function f (x)
+    integer, dimension (3) :: x
+    integer, dimension (x(1), x(2), x(3)) :: f
+    integer :: i1, i2, i3
+    do i1 = 1, x(1)
+      do i2 = 1, x(2)
+        do i3 = 1, x(3)
+          f (i1, i2, i3) = i1 + i2 * 10 + i3 * 100
+        end do
+      end do
+    end do
+  end function f
+end program main
diff --git a/gcc/testsuite/gfortran.dg/pr46755.f b/gcc/testsuite/gfortran.dg/pr46755.f
new file mode 100644
index 000000000..adc57eb49
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr46755.f
@@ -0,0 +1,24 @@
+C { dg-do compile }
+C { dg-options "-O" }
+      IMPLICIT NONE
+      INTEGER I640,I760,I800
+      INTEGER I,ITER,ITMX,LENCM
+      LOGICAL QDISK,QDW
+      ASSIGN 801 TO I800        ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+
+      GOTO I800                 ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" }
+ 801  CONTINUE
+      ASSIGN 761 TO I760        ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+ 761  CONTINUE
+      DO I=1,LENCM
+      ENDDO
+      DO WHILE(ITER.LT.ITMX)
+         IF(QDW) THEN
+            ASSIGN 641 to I640  ! { dg-warning "Deleted feature: ASSIGN" "Deleted feature: ASSIGN" }
+            GOTO I760           ! { dg-warning "Deleted feature: Assigned" "Assigned GO TO" }
+ 641        CONTINUE
+         ENDIF
+      ENDDO
+      RETURN
+      END
+
diff --git a/gcc/testsuite/gfortran.dg/pr46804.f90 b/gcc/testsuite/gfortran.dg/pr46804.f90
new file mode 100644
index 000000000..ee44a56c8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr46804.f90
@@ -0,0 +1,36 @@
+! PR rtl-optimization/46804
+! { dg-do run }
+! { dg-options "-O -fPIC -fexpensive-optimizations -fgcse -foptimize-register-move -fpeel-loops -fno-tree-loop-optimize" }
+
+program main
+  integer, parameter :: n1 = 2, n2 = 3, n3 = 4, slen = 3
+  character (len = slen), dimension (n1, n2, n3) :: a
+  integer (kind = 1), dimension (2, 4) :: shift1
+  integer (kind = 2), dimension (2, 4) :: shift2
+  integer (kind = 4), dimension (2, 4) :: shift3
+  do i3 = 1, n3
+    do i2 = 1, n2
+      do i1 = 1, n1
+        a (i1, i2, i3) = 'ab'(i1:i1) // 'cde'(i2:i2) // 'fghi'(i3:i3)
+      end do
+    end do
+  end do
+  shift1 (1, :) = (/ 4, 11, 19, 20 /)
+  shift1 (2, :) = (/ 55, 5, 1, 2 /)
+  shift2 = shift1
+  shift3 = shift1
+  call test (cshift (a, shift2, 2))
+  call test (cshift (a, shift3, 2))
+contains
+  subroutine test (b)
+    character (len = slen), dimension (n1, n2, n3) :: b
+    do i3 = 1, n3
+      do i2 = 1, n2
+        do i1 = 1, n1
+          i2p = mod (shift1 (i1, i3) + i2 - 1, n2) + 1
+          if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) call abort
+        end do
+      end do
+    end do
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/pr46884.f b/gcc/testsuite/gfortran.dg/pr46884.f
new file mode 100644
index 000000000..54ae57d5c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr46884.f
@@ -0,0 +1,8 @@
+C PR fortran/46884
+C { dg-do compile }
+C { dg-options "" }
+      SUBROUTINE F
+      IMPLICIT CHARACTER*12 (C)
+      CALL G(C1)
+      CALL H(C1(1:4))
+      END
diff --git a/gcc/testsuite/gfortran.dg/pr46945.f90 b/gcc/testsuite/gfortran.dg/pr46945.f90
new file mode 100644
index 000000000..da4d7c7e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr46945.f90
@@ -0,0 +1,10 @@
+! PR fortran/46945
+! { dg-do run }
+! { dg-options "-O -ftree-vrp -fno-tree-ccp -fno-tree-fre" }
+
+program pr46945
+  real, allocatable :: a(:,:,:)
+  integer :: n
+  n = 0
+  allocate (a(n,n,n))
+end program pr46945
diff --git a/gcc/testsuite/gfortran.dg/pr46985.f90 b/gcc/testsuite/gfortran.dg/pr46985.f90
new file mode 100644
index 000000000..141641d29
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr46985.f90
@@ -0,0 +1,17 @@
+! PR tree-optimization/46985
+! { dg-do compile }
+! { dg-options "-O -ftree-pre -ftree-vrp -fno-tree-ccp -fno-tree-dominator-opts -fno-tree-fre" }
+
+  type :: t
+    integer :: i
+  end type t
+  type(t), target :: tar(2) = (/t(2), t(4)/)
+  integer, pointer :: ptr(:)
+  ptr => tar%i
+  call foo (ptr)
+contains
+  subroutine foo (arg)
+    integer :: arg(:)
+    arg = arg - 1
+  end subroutine
+end
diff --git a/gcc/testsuite/gfortran.dg/pr47008.f03 b/gcc/testsuite/gfortran.dg/pr47008.f03
new file mode 100644
index 000000000..a3e1e1dae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr47008.f03
@@ -0,0 +1,24 @@
+! PR rtl-optimization/47008
+! { dg-do run }
+! { dg-options "-Os -fno-asynchronous-unwind-tables -fschedule-insns -fsched-pressure -fno-inline" { target i?86-*-* x86_64-*-* } }
+
+program main
+  type :: t
+    integer :: i
+    character(24) :: c
+    type (t), pointer :: p
+  end type t
+  type(t), pointer :: r, p
+  allocate (p)
+  p = t (123455, "", p)
+  r => entry ("", 123456, 1, "", 99, "", p)
+  if (p%i /= 123455) call abort
+contains
+  function entry (x, i, j, c, k, d, p) result (q)
+    integer :: i, j, k
+    character (*) :: x, c, d
+    type (t), pointer :: p, q
+    allocate (q)
+    q = t (i, c, p)
+  end function
+end program main
diff --git a/gcc/testsuite/gfortran.dg/pr47574.f90 b/gcc/testsuite/gfortran.dg/pr47574.f90
new file mode 100644
index 000000000..65d168630
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr47574.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! PR 47574 - this used to ICE.
+      SUBROUTINE EXCH2_UV_AGRID_3D_RL( uPhi, vPhi, myNz )
+
+      IMPLICIT NONE
+
+      INTEGER, parameter :: sNx=32, sNy=32, OLx=4, OLy=4
+
+      INTEGER myNz
+      Real(8) uPhi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,3,1)
+      REAL(8) vPhi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,3,1)
+
+      INTEGER i,j,k,bi,bj
+      REAL(8) uLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
+      REAL(8) vLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
+      REAL(8) negOne
+
+      negOne = 1.
+        DO k = 1,myNz
+         DO j = 1-OLy,sNy+OLy
+          DO i = 1-OLx,sNx+OLx
+           uLoc(i,j) = uPhi(i,j,k,bi,bj)
+           vLoc(i,j) = vPhi(i,j,k,bi,bj)
+          ENDDO
+         ENDDO
+         DO j = 1-OLy,sNy+OLy
+          DO i = 1,OLx
+           uPhi(1-i,j,k,bi,bj) = vLoc(1-i,j)
+           vPhi(1-i,j,k,bi,bj) = uLoc(1-i,j)*negOne
+          ENDDO
+         ENDDO
+
+        ENDDO
+
+      END
+
diff --git a/gcc/testsuite/gfortran.dg/pr47614.f b/gcc/testsuite/gfortran.dg/pr47614.f
new file mode 100644
index 000000000..52f14c0c1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr47614.f
@@ -0,0 +1,37 @@
+! { dg-do run { target { powerpc*-*-* } } }
+! { dg-skip-if "" { powerpc*-*-darwin* } { "*" } { "" } }
+! { dg-options "-O3 -funroll-loops -ffast-math -mcpu=power4" }
+
+
+      SUBROUTINE SFCPAR(ZET,NZ,ZMH,TSL,TMES)
+      IMPLICIT REAL*8 (A-H, O-Z)
+      REAL*8 ZET(*)
+
+      ZS=MAX(TSL*ZMH,ZET(2))
+
+      DO 10 K=2,NZ
+         KLEV=K-1
+         IF(ZS.LE.ZET(K)) GO TO 20
+ 10   CONTINUE
+
+ 20   CONTINUE
+      TMES=ZET(KLEV+1)
+      
+      RETURN
+      END
+
+      program pr47614
+	real*8 ar1(10),d1,d2,d3
+	integer i
+
+	d1 = 2.0
+	d2 = 3.0
+	d3 = 3.0
+	do 50 i=1,10
+	  ar1(i) = d1
+	  d1 = d1 + 2.0
+ 50	continue
+
+	call sfcpar(ar1,10,d2,d3,d1)
+	if (d1.ne.10.0) call abort()
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr47757-1.f90 b/gcc/testsuite/gfortran.dg/pr47757-1.f90
new file mode 100644
index 000000000..1c40f9874
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr47757-1.f90
@@ -0,0 +1,40 @@
+! PR libfortran/47757
+! { dg-do run }
+
+  integer(1) :: a1(2,2)
+  integer(2) :: a2(2,2)
+  integer(4) :: a4(2,2)
+  integer(8) :: a8(2,2)
+  logical :: mask(2,2)
+  logical :: mask2
+  a1 = 0
+  a2 = 0
+  a3 = 0
+  a4 = 0
+  mask2 = .true.
+  mask = reshape([.true.,.true.,.false.,.true.],[2,2])
+  print *, iany(a1, dim=1, mask=mask)
+  print *, iany(a2, dim=1, mask=mask)
+  print *, iany(a4, dim=1, mask=mask)
+  print *, iany(a8, dim=1, mask=mask)
+  print *, iall(a1, dim=1, mask=mask)
+  print *, iall(a2, dim=1, mask=mask)
+  print *, iall(a4, dim=1, mask=mask)
+  print *, iall(a8, dim=1, mask=mask)
+  print *, iparity(a1, dim=1, mask=mask)
+  print *, iparity(a2, dim=1, mask=mask)
+  print *, iparity(a4, dim=1, mask=mask)
+  print *, iparity(a8, dim=1, mask=mask)
+  print *, iany(a1, dim=1, mask=mask2)
+  print *, iany(a2, dim=1, mask=mask2)
+  print *, iany(a4, dim=1, mask=mask2)
+  print *, iany(a8, dim=1, mask=mask2)
+  print *, iall(a1, dim=1, mask=mask2)
+  print *, iall(a2, dim=1, mask=mask2)
+  print *, iall(a4, dim=1, mask=mask2)
+  print *, iall(a8, dim=1, mask=mask2)
+  print *, iparity(a1, dim=1, mask=mask2)
+  print *, iparity(a2, dim=1, mask=mask2)
+  print *, iparity(a4, dim=1, mask=mask2)
+  print *, iparity(a8, dim=1, mask=mask2)
+end
diff --git a/gcc/testsuite/gfortran.dg/pr47757-2.f90 b/gcc/testsuite/gfortran.dg/pr47757-2.f90
new file mode 100644
index 000000000..1f8a08f0b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr47757-2.f90
@@ -0,0 +1,16 @@
+! PR libfortran/47757
+! { dg-do run { target fortran_large_int } }
+
+  integer(16) :: a16(2,2)
+  logical :: mask(2,2)
+  logical :: mask2
+  a16 = 0
+  mask2 = .true.
+  mask = reshape([.true.,.true.,.false.,.true.],[2,2])
+  print *, iany(a16, dim=1, mask=mask)
+  print *, iall(a16, dim=1, mask=mask)
+  print *, iparity(a16, dim=1, mask=mask)
+  print *, iany(a16, dim=1, mask=mask2)
+  print *, iall(a16, dim=1, mask=mask2)
+  print *, iparity(a16, dim=1, mask=mask2)
+end
diff --git a/gcc/testsuite/gfortran.dg/pr47757-3.f90 b/gcc/testsuite/gfortran.dg/pr47757-3.f90
new file mode 100644
index 000000000..9bfad8257
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr47757-3.f90
@@ -0,0 +1,12 @@
+! PR libfortran/47757
+! { dg-do run { target fortran_large_int } }
+
+  character(kind=4):: str(3,3), s(3)
+  str(1,:) = [4_'A', 4_'b', 4_'C']
+  str(2,:) = [4_'A', 4_'b', 4_'C']
+  str(3,:) = [4_'A', 4_'b', 4_'C']
+  s = 4_'A'
+  print *, cshift(str, shift=2_16, dim=1_16)
+  print *, eoshift(str, shift=2_16, dim=1_16)
+  print *, eoshift(str, shift=2_16, boundary=s, dim=1_16)
+end
diff --git a/gcc/testsuite/gfortran.dg/pr47878.f90 b/gcc/testsuite/gfortran.dg/pr47878.f90
new file mode 100644
index 000000000..9cc4a0860
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr47878.f90
@@ -0,0 +1,10 @@
+! PR fortran/47878
+! { dg-do run }
+  integer :: a(5)
+  open (99, recl = 40)
+  write (99, '(5i3)') 1, 2, 3
+  rewind (99)
+  read (99, '(5i3)') a
+  if (any (a.ne.(/1, 2, 3, 0, 0/))) call abort 
+  close (99, status = 'delete')
+end
diff --git a/gcc/testsuite/gfortran.dg/pr49103.f90 b/gcc/testsuite/gfortran.dg/pr49103.f90
new file mode 100644
index 000000000..e744c9bbe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr49103.f90
@@ -0,0 +1,19 @@
+! PR fortran/49103
+! { dg-do run }
+  integer :: a(2), b(2), i, j
+  open (10, status='scratch')
+  do j = 1, 2
+    a = (/ 0, 0 /)
+    b = (/ 1, 1 /)
+    do i = 1, 2
+      write (10, *) a
+      write (10, *) b
+    end do
+  end do
+  rewind (10)
+  do i = 0, 7
+    read (10, *) a
+    if (any (a .ne. mod (i, 2))) call abort
+  end do
+  close (10)
+end
diff --git a/gcc/testsuite/gfortran.dg/pr49472.f90 b/gcc/testsuite/gfortran.dg/pr49472.f90
new file mode 100644
index 000000000..1baf82e8b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr49472.f90
@@ -0,0 +1,15 @@
+! PR rtl-optimization/49472
+! { dg-do compile }
+! { dg-options "-O -fcompare-debug -ffast-math" }
+subroutine pr49472
+  integer, parameter :: n = 3
+  real(8) :: a, b, c, d, e (n+1)
+  integer :: i
+  do i=2, (n+1)
+    b = 1. / ((i - 1.5d0) * 1.)
+    c = b * a
+    d = -b * c / (1. + b * b) ** 1.5d0
+    e(i) = d
+  end do
+  call dummy (e)
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/pr49540-1.f90 b/gcc/testsuite/gfortran.dg/pr49540-1.f90
new file mode 100644
index 000000000..5a8218f0f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr49540-1.f90
@@ -0,0 +1,6 @@
+! PR fortran/49540
+! { dg-do compile }
+block data
+  common /a/ b(100000,100)
+  data b /10000000 * 0.0/
+end block data
diff --git a/gcc/testsuite/gfortran.dg/pr49540-2.f90 b/gcc/testsuite/gfortran.dg/pr49540-2.f90
new file mode 100644
index 000000000..f9a3d6df6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr49540-2.f90
@@ -0,0 +1,17 @@
+! PR fortran/49540
+! { dg-do compile }
+! { dg-options "" }
+block data
+  common /a/ i(5,5)
+  data i /4, 23 * 5, 6/
+  data i(:,2) /1, 3 * 2, 3/
+  common /b/ j(5,5)
+  data j(2,:) /1, 3 * 2, 3/
+  data j /4, 23 * 5, 6/
+  common /c/ k(5,5)
+  data k(:,2) /1, 3 * 2, 3/
+  data k /4, 23 * 5, 6/
+  common /d/ l(5,5)
+  data l /4, 23 * 5, 6/
+  data l(2,:) /1, 3 * 2, 3/
+end block data
diff --git a/gcc/testsuite/gfortran.dg/pr49675.f90 b/gcc/testsuite/gfortran.dg/pr49675.f90
new file mode 100644
index 000000000..06fd1b665
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr49675.f90
@@ -0,0 +1,6 @@
+! PR middle-end/49675
+! { dg-do compile }
+! { dg-options "-finstrument-functions" }
+end
+! { dg-final { scan-assembler "__cyg_profile_func_enter" } }
+! { dg-final { scan-assembler "__cyg_profile_func_exit" } }
diff --git a/gcc/testsuite/gfortran.dg/pr49698.f90 b/gcc/testsuite/gfortran.dg/pr49698.f90
new file mode 100644
index 000000000..638cbb0b7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr49698.f90
@@ -0,0 +1,15 @@
+! PR fortran/49698
+! { dg-do compile }
+subroutine foo (x, y, z)
+  type S
+    integer, pointer :: e => null()
+  end type S
+  type T
+    type(S), dimension(:), allocatable :: a
+  end type T
+  type(T) :: x, y
+  integer :: z, i
+  forall (i = 1 : z)
+    y%a(i)%e => x%a(i)%e
+  end forall
+end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/pr50875.f90 b/gcc/testsuite/gfortran.dg/pr50875.f90
new file mode 100644
index 000000000..6b4476c14
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr50875.f90
@@ -0,0 +1,39 @@
+! { dg-do compile { target { i?86-*-* x86_64-*-* } } }
+! { dg-options "-O3 -mavx" }
+!
+! PR fortran/50875.f90
+
+module test
+
+  implicit none
+
+  integer, parameter :: dp=kind(1.d0)
+
+  integer :: P = 2
+
+  real(kind=dp), allocatable :: real_array_A(:),real_array_B(:,:)
+  complex(kind=dp), allocatable :: cmplx_array_A(:) 
+
+contains
+
+  subroutine routine_A
+
+    integer :: i
+
+    allocate(cmplx_array_A(P),real_array_B(P,P),real_array_A(P))
+
+    real_array_A = 1
+    real_array_B = 1
+
+    do i = 1, p
+       cmplx_array_A = cmplx(real_array_B(:,i),0.0_dp,dp)
+       cmplx_array_A = cmplx_array_A * exp(cmplx(0.0_dp,real_array_A+1))
+    end do
+
+    deallocate(cmplx_array_A,real_array_B,real_array_A)
+
+  end subroutine routine_A
+
+end module test
+
+! { dg-final { cleanup-modules "test" } }
diff --git a/gcc/testsuite/gfortran.dg/pr56015.f90 b/gcc/testsuite/gfortran.dg/pr56015.f90
new file mode 100644
index 000000000..a615f663f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr56015.f90
@@ -0,0 +1,16 @@
+! PR middle-end/56015
+! { dg-do run }
+! { dg-options "-O3 -ffast-math -fno-inline" }
+
+program pr56015
+  implicit none
+  complex*16 p(10)
+  p(:) = (0.1d0, 0.2d0)
+  p(:) = (0.0d0, 1.0d0) * p(:)
+  call foo (p)
+contains
+  subroutine foo (p)
+    complex*16 p(10)
+    if (any (p .ne. (-0.2d0, 0.1d0))) call abort
+  end subroutine
+end program pr56015
diff --git a/gcc/testsuite/gfortran.dg/predcom-1.f b/gcc/testsuite/gfortran.dg/predcom-1.f
new file mode 100644
index 000000000..1cc0bf24b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/predcom-1.f
@@ -0,0 +1,16 @@
+! PR 32160, complex temporary variables were not marked as gimple registers
+! { dg-do compile }
+! { dg-options "-O3" }
+
+      REAL             FUNCTION CLANHT( N, E )
+      INTEGER            N
+      COMPLEX            E( * )
+      INTEGER            I
+      REAL               ANORM
+      INTRINSIC          ABS
+            DO 20 I = 1, N
+               ANORM = ANORM +ABS( E( I ) )+ ABS( E( I-1 ) )
+   20       CONTINUE
+      CLANHT = ANORM
+      RETURN
+      END
diff --git a/gcc/testsuite/gfortran.dg/predcom-2.f b/gcc/testsuite/gfortran.dg/predcom-2.f
new file mode 100644
index 000000000..7e43cb07a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/predcom-2.f
@@ -0,0 +1,20 @@
+! PR 32220, ICE when the loop is not unrolled enough to eliminate all 
+!   register copies
+! { dg-do compile }
+! { dg-options "-O3" }
+
+      subroutine derv (b,cosxy,thick)
+c
+      common /shell4/xji(3,3)
+c
+      dimension cosxy(6,*),
+     1          thick(*),b(*)
+c
+
+      do 125 i=1,3
+      b(k2+i)=xji(i,1) + xji(i,2) + xji(i,3)
+  125 b(k3+i)=cosxy(i+3,kk) + cosxy(i,kk)
+c
+c
+      return
+      end
diff --git a/gcc/testsuite/gfortran.dg/present_1.f90 b/gcc/testsuite/gfortran.dg/present_1.f90
new file mode 100644
index 000000000..6dee264fd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/present_1.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! Test the fix for PR25097, in which subobjects of the optional dummy argument
+! could appear as argument A of the PRESENT intrinsic.
+! 
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+ MODULE M1
+  TYPE T1
+   INTEGER :: I
+  END TYPE T1
+ CONTAINS
+  SUBROUTINE S1(D1)
+   TYPE(T1), OPTIONAL :: D1(4)
+   write(6,*) PRESENT(D1%I)  ! { dg-error "must not be a subobject" }
+   write(6,*) PRESENT(D1(1)) ! { dg-error "must not be a subobject" }
+   write(6,*) PRESENT(D1)
+  END SUBROUTINE S1
+ END MODULE
+ END
+! { dg-final { cleanup-modules "M1" } }
diff --git a/gcc/testsuite/gfortran.dg/print_1.f90 b/gcc/testsuite/gfortran.dg/print_1.f90
new file mode 100644
index 000000000..8f4ef3cf4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/print_1.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! PR fortran/29403
+program p
+   character(len=10) a, b, c
+   integer i
+   i = 1
+   print ('(I0)'), i
+   a = '(I0,'
+   b = 'I2,'
+   c = 'I4)'
+   call prn(a, b, c, i)
+   print (1,*), i       ! { dg-error "in PRINT statement" }
+end program p
+
+subroutine prn(a, b, c, i)
+  integer i
+  character(len=*) a, b, c
+  print (a//(b//c)), i, i, i
+  print trim(a//trim(b//c)), i, i, i
+end subroutine prn
diff --git a/gcc/testsuite/gfortran.dg/print_c_kinds.f90 b/gcc/testsuite/gfortran.dg/print_c_kinds.f90
new file mode 100644
index 000000000..a66323316
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/print_c_kinds.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+program print_c_kinds
+  use, intrinsic :: iso_c_binding
+  implicit none
+
+  print *, 'c_short is:              ', c_short
+  print *, 'c_int is:                ', c_int
+  print *, 'c_long is:               ', c_long
+  print *, 'c_long_long is:          ', c_long_long
+  print *
+  print *, 'c_int8_t is:             ', c_int8_t
+  print *, 'c_int_least8_t is:       ', c_int_least8_t
+  print *, 'c_int_fast8_t is:        ', c_int_fast8_t
+  print *
+  print *, 'c_int16_t is:            ', c_int16_t
+  print *, 'c_int_least16_t is:      ', c_int_least16_t
+  print *, 'c_int_fast16_t is:       ', c_int_fast16_t
+  print *
+  print *, 'c_int32_t is:            ', c_int32_t
+  print *, 'c_int_least32_t is:      ', c_int_least32_t
+  print *, 'c_int_fast32_t is:       ', c_int_fast32_t
+  print *
+  print *, 'c_int64_t is:            ', c_int64_t
+  print *, 'c_int_least64_t is:      ', c_int_least64_t
+  print *, 'c_int_fast64_t is:       ', c_int_fast64_t
+  print *
+  print *, 'c_intmax_t is:           ', c_intmax_t
+  print *, 'c_intptr_t is:           ', c_intptr_t
+  print *
+  print *, 'c_float is:              ', c_float
+  print *, 'c_double is:             ', c_double
+  print *, 'c_long_double is:        ', c_long_double
+  print *
+  print *, 'c_char is:               ', c_char
+end program print_c_kinds
diff --git a/gcc/testsuite/gfortran.dg/print_fmt_1.f90 b/gcc/testsuite/gfortran.dg/print_fmt_1.f90
new file mode 100644
index 000000000..f7622b57d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/print_fmt_1.f90
@@ -0,0 +1,7 @@
+! { dg-do run }
+! PR 23661
+! PRINT with a character format was broken
+character(5) :: f = "(a)"
+! { dg-output "check" }
+print f, "check"
+end
diff --git a/gcc/testsuite/gfortran.dg/print_fmt_2.f90 b/gcc/testsuite/gfortran.dg/print_fmt_2.f90
new file mode 100644
index 000000000..c7a5cc146
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/print_fmt_2.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! PR 23661 Make sure space between PRINT and variable name is enforced in
+! free form.
+! Also tests the namelist case
+character(5) :: f = "(a)"
+real  x
+namelist /mynml/ x
+printf, "check" ! { dg-error "Unclassifiable" }
+x = 1
+printmynml ! { dg-error "" }
+end
diff --git a/gcc/testsuite/gfortran.dg/print_fmt_3.f b/gcc/testsuite/gfortran.dg/print_fmt_3.f
new file mode 100644
index 000000000..c46b756f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/print_fmt_3.f
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! PR 23661 Make sure space between PRINT and variable name is not enforced in
+! fixed form.
+! Also tests the namelist case
+      character(5) :: f = "(a)"
+      real  x
+      namelist /mynml/ x
+      printf, "check"
+      x = 1
+      printmynml ! { dg-warning "extension" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/print_fmt_4.f b/gcc/testsuite/gfortran.dg/print_fmt_4.f
new file mode 100644
index 000000000..f8978ebc7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/print_fmt_4.f
@@ -0,0 +1,3 @@
+! { dg-do compile }
+      print precision(1.) ! { dg-error "must be of type default CHARACTER" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/print_fmt_5.f90 b/gcc/testsuite/gfortran.dg/print_fmt_5.f90
new file mode 100644
index 000000000..fb37d7539
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/print_fmt_5.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! print_fmt_5.f90
+! Test of fix for PR28237 and the last bit of PR23420.  See
+! below for the description of the problem.
+!
+program r
+  character(12) :: for = '(i5)', left = '(i', right = ')'
+  integer :: i, j
+  integer :: h(4) &
+    = (/1h(, 1hi, 1h5, 1h)/)! { dg-warning "HOLLERITH|Hollerith" }
+  namelist /mynml/ i
+  i = fact ()
+!
+! All these are "legal" things to do; note however the warnings
+! for extensions or obsolete features!
+!
+  print *, fact()
+  print 100, fact()
+  print '(i5)', fact()
+  print mynml      ! { dg-warning "is an extension" }
+  do i = 1, 5
+    print trim(left)//char(iachar('0') + i)//trim(right), i
+  end do
+  assign 100 to i  ! { dg-warning "ASSIGN statement" }
+  print i, fact()  ! { dg-warning "ASSIGNED variable" }
+  print h, fact () ! { dg-warning "Non-character in FORMAT" }
+!
+! These are not and caused a segfault in trans-io:560
+!
+! PR28237
+  print fact()     ! { dg-error "not an ASSIGNED variable" }
+! original PR23420
+  print precision(1.2_8) ! { dg-error "type default CHARACTER" }
+! PR23420 points 4 and 5
+  print j + j      ! { dg-error "not an ASSIGNED variable" }
+! An extension of the above, encountered in writing the fix
+  write (*, fact())! { dg-error "not an ASSIGNED variable" }
+ 100 format (i5)
+contains
+  function fact()
+    integer :: fact
+    fact = 1
+  end function fact
+end
+
diff --git a/gcc/testsuite/gfortran.dg/print_parentheses_1.f b/gcc/testsuite/gfortran.dg/print_parentheses_1.f
new file mode 100644
index 000000000..d64448323
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/print_parentheses_1.f
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+      program main
+      character*80 line
+      print (line,'(A)'), 'hello' ! { dg-error "Syntax error" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/print_parentheses_2.f90 b/gcc/testsuite/gfortran.dg/print_parentheses_2.f90
new file mode 100644
index 000000000..520973ed1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/print_parentheses_2.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+program main
+  character*80 line
+  print (line,'(A)'), 'hello' ! { dg-error "Syntax error" }
+end program main
diff --git a/gcc/testsuite/gfortran.dg/private_type_1.f90 b/gcc/testsuite/gfortran.dg/private_type_1.f90
new file mode 100644
index 000000000..96b2eb4c8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_1.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! PR21986 - test based on original example.
+! A public subroutine must not have private-type, dummy arguments.
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+module modboom
+  implicit none
+  private
+  public:: dummysub
+  type:: intwrapper
+    integer n
+  end type intwrapper
+contains
+  subroutine dummysub(size, arg_array) ! { dg-error "PRIVATE type and cannot be a dummy argument" }
+   type(intwrapper) :: size
+   real, dimension(size%n) :: arg_array
+   real :: local_array(4)
+  end subroutine dummysub
+end module modboom
+
+! { dg-final { cleanup-modules "modboom" } }
diff --git a/gcc/testsuite/gfortran.dg/private_type_10.f90 b/gcc/testsuite/gfortran.dg/private_type_10.f90
new file mode 100644
index 000000000..561cfb7fd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_10.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/34438
+!
+! Check that error is not issued for local, non-module
+! variables.
+!
+! Contributed by Sven Buijssen
+!
+module demo
+  implicit none
+  private
+  type myint
+    integer :: bar = 42
+  end type myint
+  public :: func
+contains
+  subroutine func()
+    type(myint) :: foo
+  end subroutine func
+end module demo
+
+module demo2
+  implicit none
+  private
+  type myint
+    integer :: bar = 42
+  end type myint
+  type(myint), save :: foo2 ! { dg-error "of PRIVATE derived type" }
+  public :: foo2
+end module demo2
+
+! { dg-final { cleanup-modules "demo" } }
diff --git a/gcc/testsuite/gfortran.dg/private_type_11.f90 b/gcc/testsuite/gfortran.dg/private_type_11.f90
new file mode 100644
index 000000000..57c22dd52
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_11.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! PR fortran/38065
+!
+! Reported by Norman S. Clerman
+! and reduced by Joost VandeVondele
+!
+MODULE M1
+  IMPLICIT NONE
+  PRIVATE
+  TYPE T1
+   INTEGER :: I1
+  END TYPE T1
+  PUBLIC :: S1,F2
+CONTAINS
+  SUBROUTINE S1
+  CONTAINS
+   TYPE(T1) FUNCTION F1()
+   END FUNCTION F1
+  END SUBROUTINE S1
+  TYPE(T1) FUNCTION F2()
+  END FUNCTION F2
+END MODULE M1
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/private_type_12.f90 b/gcc/testsuite/gfortran.dg/private_type_12.f90
new file mode 100644
index 000000000..5bebcf030
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_12.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! PR fortran/38065
+!
+! Reported by Norman S. Clerman
+! and reduced by Joost VandeVondele
+!
+MODULE M1
+  IMPLICIT NONE
+  PRIVATE
+  TYPE T1
+   INTEGER :: I1
+  END TYPE T1
+  PUBLIC :: S1,F2
+CONTAINS
+  SUBROUTINE S1
+  CONTAINS
+   TYPE(T1) FUNCTION F1()
+   END FUNCTION F1
+  END SUBROUTINE S1
+  TYPE(T1) FUNCTION F2() ! { dg-error "Fortran 2003: PUBLIC variable 'f2'" }
+  END FUNCTION F2
+END MODULE M1
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/private_type_13.f90 b/gcc/testsuite/gfortran.dg/private_type_13.f90
new file mode 100644
index 000000000..77c41a44f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_13.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! Test fix for F95 part of PR39800, in which the host association of the type 't1'
+! generated an error.
+!
+! Reported to clf by Alexei Matveev <Alexei Matveev@gmail.com> and reported by
+! Tobias Burnus  <burnus@gcc.gnu.org>
+!
+module m
+  implicit none
+  private
+
+  type :: t1
+    integer :: i
+  end type
+
+  type :: t2
+    type(t1) :: j
+  end type
+
+  contains
+
+    subroutine sub()
+      implicit none
+
+      type :: t3
+        type(t1) :: j
+      end type
+
+    end subroutine
+
+end module
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/private_type_2.f90 b/gcc/testsuite/gfortran.dg/private_type_2.f90
new file mode 100644
index 000000000..cda00cabb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_2.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! PR16404 test 6 - If a component of a derived type is of a type declared to
+! be private, either the derived type definition must contain the PRIVATE
+! statement, or the derived type must be private.
+! Modified on 20051105 to test PR24534.
+! Modified on 20090419 to use -std=f95, since F2003 allows public types
+! with private components.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+MODULE TEST
+  PRIVATE
+  TYPE :: info_type
+   INTEGER :: value
+  END TYPE info_type
+  TYPE :: all_type! { dg-error "PRIVATE type and cannot be a component" }
+    TYPE(info_type) :: info
+  END TYPE
+  TYPE :: any_type! This is OK because of the PRIVATE statement.
+    PRIVATE
+    TYPE(info_type) :: info
+  END TYPE
+  public  all_type, any_type
+END MODULE
+END
+
+! { dg-final { cleanup-modules "TEST" } }
diff --git a/gcc/testsuite/gfortran.dg/private_type_3.f90 b/gcc/testsuite/gfortran.dg/private_type_3.f90
new file mode 100644
index 000000000..dea35818e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_3.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-options "-O0" }
+! Tests the fix for PR24207 and the problems associated
+! with the fix for PR21986. In two cases, use associated
+! public symbols were taking on the default private access
+! attribute of the local namespace. In the third, a private
+! symbol was not available to a namelist in contained 
+! procedure in the same module.
+!
+! Based on the example in PR24207.
+!
+module a
+  implicit none
+  real b
+  type :: mytype
+    integer :: c
+  end type mytype
+end module a
+module c
+  use a
+  implicit none
+  public d
+  private
+  real x
+  contains
+     subroutine d (arg_t)   ! This would cause an error
+        type (mytype) :: arg_t
+        namelist /e/ b, x   ! .... as would this.
+        read(5,e)
+	arg_t%c = 42
+     end subroutine d
+end module c
+
+! { dg-final { cleanup-modules "a c" } }
diff --git a/gcc/testsuite/gfortran.dg/private_type_4.f90 b/gcc/testsuite/gfortran.dg/private_type_4.f90
new file mode 100644
index 000000000..42303ca53
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_4.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! PR 25093: Check that a PUBLIC function can't be of PRIVATE type
+! in Fortran 95; in Fortran 2003 it is allowed (cf. PR fortran/38065)
+!
+module m1
+
+    type :: t1
+        integer :: i
+    end type t1
+
+    private :: t1
+    public :: f1
+
+contains
+
+    type(t1) function f1() ! { dg-error "of PRIVATE derived type" }
+    end function
+
+end module
+
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/private_type_5.f90 b/gcc/testsuite/gfortran.dg/private_type_5.f90
new file mode 100644
index 000000000..0fcf00e53
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_5.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! Tests the fix for PR26779, where an error would occur because
+! init was detected to be public with a private type dummy argument.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module test
+  public sub
+  type, private :: t
+    integer :: i
+  end type t
+contains
+  subroutine sub (arg)
+    integer arg
+    type(t) :: root
+    call init(root, arg)
+  contains
+    subroutine init(ir, i)
+      integer i
+      type(t) :: ir
+      ir%i = i
+    end subroutine init
+  end subroutine sub
+end module test
+! { dg-final { cleanup-modules "test" } }
diff --git a/gcc/testsuite/gfortran.dg/private_type_6.f90 b/gcc/testsuite/gfortran.dg/private_type_6.f90
new file mode 100644
index 000000000..4af3f704f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_6.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! PR fortran/32460
+!
+module foomod
+  implicit none
+  type :: footype
+    private
+    integer :: dummy
+  end type footype
+  TYPE :: bartype
+    integer :: dummy
+    integer, private :: dummy2
+  end type bartype
+end module foomod
+
+program foo_test
+  USE foomod
+  implicit none
+  TYPE(footype) :: foo
+  TYPE(bartype) :: foo2
+  foo  = footype(1) ! { dg-error "is a PRIVATE component" }
+  foo2 = bartype(1,2) ! { dg-error "is a PRIVATE component" }
+  foo2%dummy2 = 5 ! { dg-error "is a PRIVATE component" }
+end program foo_test
+! { dg-final { cleanup-modules "foomod" } }
diff --git a/gcc/testsuite/gfortran.dg/private_type_7.f90 b/gcc/testsuite/gfortran.dg/private_type_7.f90
new file mode 100644
index 000000000..b9ad8fab7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_7.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! PR32760 Error defining subroutine named PRINT
+! Test case derived from original PR.
+
+module gfcbug68
+  implicit none
+  private :: write
+
+contains
+
+  function foo (i)
+    integer, intent(in)  :: i
+    integer foo
+
+    write (*,*) i
+    call write(i)
+    foo = i
+  end function foo
+
+  subroutine write (m)
+    integer, intent(in) :: m
+    print *, m*m*m
+  end subroutine write
+
+end module gfcbug68
+
+program testit
+  use gfcbug68
+  integer :: i = 27
+  integer :: k
+  
+  k = foo(i)
+  print *, "in the main:", k
+end program testit
+! { dg-final { cleanup-modules "gfcbug68" } }
diff --git a/gcc/testsuite/gfortran.dg/private_type_8.f90 b/gcc/testsuite/gfortran.dg/private_type_8.f90
new file mode 100644
index 000000000..df1609646
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_8.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! A public subroutine can have private-type, dummy arguments
+! in Fortran 2003 (but not in Fortran 95).
+! See private_type_1.f90 for the F95 test.
+!
+module modboom
+  implicit none
+  private
+  public:: dummysub
+  type:: intwrapper
+    integer n
+  end type intwrapper
+contains
+  subroutine dummysub(size, arg_array)
+   type(intwrapper) :: size
+   real, dimension(size%n) :: arg_array
+   real :: local_array(4)
+  end subroutine dummysub
+end module modboom
+
+! { dg-final { cleanup-modules "modboom" } }
diff --git a/gcc/testsuite/gfortran.dg/private_type_9.f90 b/gcc/testsuite/gfortran.dg/private_type_9.f90
new file mode 100644
index 000000000..3ca2fd5fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_9.f90
@@ -0,0 +1,42 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/33106
+!
+module m1
+  implicit none
+  type, private :: t
+    integer :: i
+  end type t
+  type(t), public :: one ! { dg-error "PRIVATE derived type" }
+  type(t), public, parameter :: two = t(2) ! { dg-error "PRIVATE derived type" }
+end module m1
+
+module m2
+  implicit none
+  private
+  type t
+    integer :: i
+  end type t
+  type(t), public :: one ! { dg-error "PRIVATE derived type" }
+  type(t), public, parameter :: two = t(2) ! { dg-error "PRIVATE derived type" }
+end module m2
+
+module m3
+  implicit none
+  type t
+    integer :: i
+  end type t
+end module m3
+
+module m4
+  use m3!, only: t
+  implicit none
+  private 
+  private :: t
+  type(t), public :: one
+  type(t), public, parameter :: two = t(2)
+end module m4
+
+end
+! { dg-final { cleanup-modules "m1 m2 m3 m4" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_assign_1.f90 b/gcc/testsuite/gfortran.dg/proc_assign_1.f90
new file mode 100644
index 000000000..e85df7635
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_assign_1.f90
@@ -0,0 +1,80 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!

+! This tests the patch for PR26787 in which it was found that setting

+! the result of one module procedure from within another produced an

+! ICE rather than an error.

+!

+! This is an "elaborated" version of the original testcase from

+! Joshua Cogliati  <jjcogliati-r1@yahoo.com>

+!

+function ext1 ()

+    integer ext1, ext2, arg

+    ext1 = 1

+    entry ext2 (arg)

+    ext2 = arg

+contains

+    subroutine int_1 ()

+        ext1 = arg * arg     ! OK - host associated.

+    end subroutine int_1

+end function ext1

+

+module simple

+    implicit none

+contains

+    integer function foo () 

+         foo = 10            ! OK - function result

+         call foobar ()

+    contains

+        subroutine foobar ()

+            integer z

+            foo = 20         ! OK - host associated.

+        end subroutine foobar

+    end function foo

+    subroutine bar()         ! This was the original bug.

+        foo = 10             ! { dg-error "is not a variable" }

+    end subroutine bar

+    integer function oh_no ()

+        oh_no = 1

+        foo = 5              ! { dg-error "is not a variable" }

+    end function oh_no

+end module simple

+

+module simpler

+    implicit none

+contains

+    integer function foo_er () 

+         foo_er = 10         ! OK - function result

+    end function foo_er

+end module simpler

+

+    use simpler

+    real w, stmt_fcn

+    interface

+        function ext1 ()

+           integer ext1

+        end function ext1

+        function ext2 (arg)

+           integer ext2, arg

+        end function ext2

+    end interface

+    stmt_fcn (w) = sin (w)     

+    call x (y ())

+    x = 10                   ! { dg-error "is not a variable" }

+    y = 20                   ! { dg-error "is not a variable" }

+    foo_er = 8               ! { dg-error "is not a variable" }

+    ext1 = 99                ! { dg-error "is not a variable" }

+    ext2 = 99                ! { dg-error "is not a variable" }

+    stmt_fcn = 1.0           ! { dg-error "is not a variable" }

+    w = stmt_fcn (1.0)

+contains

+    subroutine x (i)

+        integer i

+        y = i                ! { dg-error "is not a variable" }

+    end subroutine x

+    function y ()

+        integer y

+        y = 2                ! OK - function result

+    end function y

+end

+! { dg-final { cleanup-modules "simple simpler" } }

diff --git a/gcc/testsuite/gfortran.dg/proc_assign_2.f90 b/gcc/testsuite/gfortran.dg/proc_assign_2.f90
new file mode 100644
index 000000000..8f313c58f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_assign_2.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! This checks the fix for PR34910, in which the invalid reference
+! below caused an ICE.
+!
+! Contributed by Daniel Franke <dfranke@gcc.gnu.org>
+!
+MODULE foo
+CONTAINS
+  INTEGER FUNCTION f()
+  f = 42
+  CONTAINS
+    LOGICAL FUNCTION f1()
+      f1 = .TRUE.
+    END FUNCTION
+
+    LOGICAL FUNCTION f2()
+      f1 = .FALSE.  ! { dg-error "is not a variable" }
+    END FUNCTION
+  END FUNCTION
+END MODULE
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_1.f90 b/gcc/testsuite/gfortran.dg/proc_decl_1.f90
new file mode 100644
index 000000000..de7cb4159
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_1.f90
@@ -0,0 +1,77 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! This tests various error messages for PROCEDURE declarations.
+! Contributed by Janus Weil <jaydub66@gmail.com>
+
+module m
+
+  abstract interface
+    subroutine sub()
+    end subroutine
+    subroutine sub2() bind(c)
+    end subroutine
+  end interface
+
+  procedure(), public, private :: a  ! { dg-error "was already specified" }
+  procedure(sub),bind(C) :: a2  ! { dg-error "requires an interface with BIND.C." }
+  procedure(sub2), public, bind(c, name="myEF") :: e, f  ! { dg-error "Multiple identifiers provided with single NAME= specifier" }
+  procedure(sub2), bind(C, name=""), pointer :: g  ! { dg-error "may not have POINTER attribute" }
+
+  public:: h
+  procedure(),public:: h  ! { dg-error "was already specified" }
+
+contains
+
+  subroutine abc
+    procedure() :: abc2
+  entry abc2(x)  ! { dg-error "PROCEDURE attribute conflicts with ENTRY attribute" }
+    real x
+  end subroutine
+
+end module m
+
+program prog
+
+  interface z
+    subroutine z1()
+    end subroutine
+    subroutine z2(a)
+      integer :: a
+    end subroutine
+  end interface
+
+  procedure(z) :: bar   ! { dg-error "may not be generic" }
+
+  procedure(), allocatable:: b  ! { dg-error "PROCEDURE attribute conflicts with ALLOCATABLE attribute" }
+  procedure(), save:: c  ! { dg-error "PROCEDURE attribute conflicts with SAVE attribute" }
+
+  procedure(dcos) :: my1
+  procedure(amax0) :: my2  ! { dg-error "not allowed in PROCEDURE statement" }
+
+  real f, x
+  f(x) = sin(x**2)
+  external oo
+
+  procedure(f) :: q  ! { dg-error "may not be a statement function" }
+  procedure(oo) :: p  ! { dg-error "must be explicit" }
+
+  procedure ( ) :: r 
+  procedure ( up ) :: s  ! { dg-error "must be explicit" }
+
+  procedure(t) :: t  ! { dg-error "may not be used as its own interface" }
+
+  call s
+
+contains
+
+  subroutine foo(a,c)  ! { dg-error "PROCEDURE attribute conflicts with INTENT attribute" }
+    abstract interface
+      subroutine b() bind(C)
+      end subroutine b
+    end interface
+    procedure(b), bind(c,name="hjj") :: a  ! { dg-error "may not have BIND.C. attribute with NAME" }
+    procedure(b),intent(in):: c
+  end subroutine foo 
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_10.f90 b/gcc/testsuite/gfortran.dg/proc_decl_10.f90
new file mode 100644
index 000000000..88fd6d8a7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_10.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! PR33162 INTRINSIC functions as ACTUAL argument
+! Test case adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+module m
+implicit none
+  interface
+    double precision function my1(x)
+      double precision, intent(in) :: x
+    end function my1
+  end interface
+  interface
+    real(kind=4) function my2(x)
+      real, intent(in) :: x
+    end function my2
+  end interface
+  interface
+    real function  my3(x, y)
+      real, intent(in) :: x, y
+    end function my3
+  end interface
+end module
+
+program test
+use m
+implicit none
+procedure(dcos):: my1 ! { dg-error "Cannot change attributes" }
+procedure(cos) :: my2 ! { dg-error "Cannot change attributes" }
+procedure(dprod) :: my3 ! { dg-error "Cannot change attributes" }
+
+end program test
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_11.f90 b/gcc/testsuite/gfortran.dg/proc_decl_11.f90
new file mode 100644
index 000000000..74c068069
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_11.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! PR fortran/33917
+!
+! Depending, in which order the symbol tree
+! was walked in resolve, gfortran resolved
+! p6 before p4; thus there was no explicit
+! interface available for p4 and an error
+! was printed. (This is a variant of proc_decl_2.f90)
+!
+! Additionally, the following contrain was not honoured:
+! "C1212 (R1215) [...] If name is declared by a procedure-declaration-stmt
+! it shall be previously declared." ("name" = interface-name)
+!
+program s
+  implicit none
+  procedure() :: q2
+  procedure() :: q3
+  procedure() :: q5
+  procedure(sub) :: p4
+  procedure(p4) :: p6
+contains
+  subroutine sub
+  end subroutine
+end program s
+
+subroutine test
+  implicit none
+  abstract interface
+    subroutine sub()
+    end subroutine sub
+  end interface
+  procedure(p4) :: p6 ! { dg-error "declared in a later PROCEDURE statement" }
+  procedure(sub) :: p4
+end subroutine test
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_12.f90 b/gcc/testsuite/gfortran.dg/proc_decl_12.f90
new file mode 100644
index 000000000..092c24d36
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_12.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+!
+! This tests the (partial) fix for PR35830, i.e. handling array arguments
+! with the PROCEDURE statement.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m
+contains
+  subroutine one(a)
+      integer a(1:3)
+      if (any(a /= [1,2,3])) call abort()
+  end subroutine one
+end module m
+
+program test
+  use m
+  implicit none
+  call foo(one)
+contains
+  subroutine foo(f)
+    procedure(one) :: f
+    call f([1,2,3])
+  end subroutine foo
+end program test
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_13.f90 b/gcc/testsuite/gfortran.dg/proc_decl_13.f90
new file mode 100644
index 000000000..b875376a0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_13.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+! PR fortran/35830
+!
+module m
+contains
+  subroutine one(a)
+      integer a(:)
+      print *, lbound(a), ubound(a), size(a)
+      if ((lbound(a,dim=1) /= 1) .or. (ubound(a,dim=1) /= 3)) &
+        call abort()
+      print *, a
+      if (any(a /= [1,2,3])) call abort()
+  end subroutine one
+end module m
+
+program test
+  use m
+  implicit none
+  call foo1(one)
+  call foo2(one)
+contains
+  subroutine foo1(f)
+    ! The following interface block is needed
+    ! for NAG f95 as it wrongly does not like
+    ! use-associated interfaces for PROCEDURE
+    ! (It is not needed for gfortran)
+    interface
+      subroutine bar(a)
+        integer a(:)
+      end subroutine
+    end interface
+    procedure(bar) :: f
+    call f([1,2,3]) ! Was failing before
+  end subroutine foo1
+  subroutine foo2(f)
+    interface
+      subroutine f(a)
+        integer a(:)
+      end subroutine
+    end interface
+    call f([1,2,3]) ! Works
+  end subroutine foo2
+
+! { dg-final { cleanup-modules "m" } }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_14.f90 b/gcc/testsuite/gfortran.dg/proc_decl_14.f90
new file mode 100644
index 000000000..d30ee7a90
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_14.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! PR fortran/35830
+!
+abstract interface
+  function ptrfunc()
+    integer, pointer :: ptrfunc
+  end function ptrfunc
+  elemental subroutine elem(a)
+    integer,intent(in) :: a
+  end subroutine elem
+  function dims()
+    integer :: dims(3)
+  end function dims
+end interface
+
+procedure(ptrfunc) :: func_a
+procedure(elem)    :: func_b
+procedure(dims)     :: func_c
+
+integer, pointer :: ptr
+integer :: array(3)
+
+ptr => func_a()
+call func_b([1,2,3])
+array = func_c()
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_15.f90 b/gcc/testsuite/gfortran.dg/proc_decl_15.f90
new file mode 100644
index 000000000..f099c1dea
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_15.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! PR fortran/35830
+!
+function f()
+  real, allocatable :: f(:)
+  allocate(f(1:3))
+  f(1:3)= (/9,8,7/)
+end function
+
+program test
+  implicit none
+  abstract interface
+    function ai()
+      real, allocatable :: ai(:)
+    end function
+  end interface
+  procedure(ai) :: f
+  if(any(f() /= [9,8,7])) call abort()
+  if(size(f()) /= 3) call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_16.f90 b/gcc/testsuite/gfortran.dg/proc_decl_16.f90
new file mode 100644
index 000000000..3251e52f5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_16.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! PR fortran/36459
+!
+abstract interface
+  function dim()
+    integer :: dim
+  end function dim
+end interface
+procedure(dim) :: f
+
+interface
+  integer function tan()
+  end function
+end interface
+procedure(tan) :: g
+
+print *, f()
+
+print *, tan()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_17.f90 b/gcc/testsuite/gfortran.dg/proc_decl_17.f90
new file mode 100644
index 000000000..858022a43
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_17.f90
@@ -0,0 +1,68 @@
+! { dg-do run }
+!
+! PR 36322/36463
+!
+! Original code by James Van Buskirk.
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+module m
+
+   use ISO_C_BINDING
+
+   character, allocatable, save :: my_message(:)
+
+   abstract interface
+      function abs_fun(x)
+         use ISO_C_BINDING
+         import my_message
+         integer(C_INT) x(:)
+         character(size(my_message),C_CHAR) abs_fun(size(x))
+      end function abs_fun
+   end interface 
+
+contains
+
+  function foo(y)
+    implicit none
+    integer(C_INT) :: y(:)
+    character(size(my_message),C_CHAR) :: foo(size(y))
+    integer i,j
+    do i=1,size(y)
+      do j=1,size(my_message)
+        foo(i)(j:j) = achar(iachar(my_message(j))+y(i))
+      end do
+    end do
+  end function
+
+  subroutine check(p,a)
+    integer a(:)
+    procedure(abs_fun) :: p
+    character(size(my_message),C_CHAR) :: c(size(a))
+    integer k,l,m
+    c = p(a)
+    m=iachar('a')
+    do k=1,size(a)
+      do l=1,size(my_message)
+        if (c(k)(l:l) /= achar(m)) call abort()
+        m = m + 1
+      end do
+    end do
+  end subroutine
+
+end module
+
+program prog
+
+use m
+
+integer :: i(4) = (/0,6,12,18/)
+
+allocate(my_message(1:6))
+
+my_message = (/'a','b','c','d','e','f'/)
+
+call check(foo,i)
+
+end program
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_18.f90 b/gcc/testsuite/gfortran.dg/proc_decl_18.f90
new file mode 100644
index 000000000..46493eb9e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_18.f90
@@ -0,0 +1,63 @@
+! { dg-do run }
+!
+! PR 36322/36463
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m
+
+contains
+
+  pure integer function mysize(a)
+    integer,intent(in) :: a(:)
+    mysize = size(a)
+  end function
+
+end module
+
+
+program prog
+
+use m
+implicit none
+
+abstract interface
+  function abs_fun(x,sz)
+    integer :: x(:)
+    interface
+      pure integer function sz(b)
+        integer,intent(in) :: b(:)
+      end function
+    end interface
+    integer :: abs_fun(sz(x))
+  end function
+end interface
+
+procedure(abs_fun) :: p
+
+integer :: k,j(3),i(3) = (/1,2,3/)
+
+j = p(i,mysize)
+
+do k=1,mysize(i)
+  if (j(k) /= 2*i(k)) call abort()
+end do
+
+end
+
+  function p(y,asz)
+    implicit none
+    integer,intent(in) :: y(:)
+    interface
+      pure integer function asz(c)
+        integer,intent(in) :: c(:)
+      end function
+    end interface
+    integer :: p(asz(y))
+    integer l
+    do l=1,asz(y)
+      p(l) = y(l)*2
+    end do
+  end function
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_19.f90 b/gcc/testsuite/gfortran.dg/proc_decl_19.f90
new file mode 100644
index 000000000..1e85a7dba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_19.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! 
+! PR 36426
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+abstract interface
+  function foo(x)
+    character(len=*) :: x
+    character(len=len(x)) :: foo
+  end function foo
+end interface
+procedure(foo) :: bar
+
+abstract interface
+  character function abs_fun()
+  end function
+end interface
+procedure(abs_fun):: x
+
+character(len=20) :: str
+str = bar("Hello")
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_2.f90 b/gcc/testsuite/gfortran.dg/proc_decl_2.f90
new file mode 100644
index 000000000..a16b4db5f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_2.f90
@@ -0,0 +1,148 @@
+! { dg-do run }
+! Various runtime tests of PROCEDURE declarations.
+! Contributed by Janus Weil <jaydub66@gmail.com>
+
+module m
+
+  use ISO_C_BINDING
+
+  abstract interface
+    subroutine csub() bind(c)
+    end subroutine csub
+  end interface
+
+  integer, parameter :: ckind = C_FLOAT_COMPLEX
+  abstract interface
+    function stub() bind(C)
+      import ckind
+      complex(ckind) stub
+    end function
+  end interface
+
+  procedure():: mp1
+  procedure(real), private:: mp2
+  procedure(mfun), public:: mp3
+  procedure(csub), public, bind(c) :: c, d
+  procedure(csub), public, bind(c, name="myB") :: b
+  procedure(stub), bind(C) :: e
+
+contains
+
+  real function mfun(x,y)
+    real x,y
+    mfun=4.2
+  end function
+
+  subroutine bar(a,b)
+    implicit none
+    interface
+      subroutine a()
+      end subroutine a
+    end interface
+    optional ::  a
+    procedure(a), optional :: b
+  end subroutine bar
+
+  subroutine bar2(x)
+    abstract interface
+      character function abs_fun()
+      end function
+    end interface
+    procedure(abs_fun):: x
+  end subroutine
+
+
+end module
+
+
+program p
+  implicit none
+
+  abstract interface
+    subroutine abssub(x)
+      real x
+    end subroutine
+  end interface
+
+  integer i
+  real r
+
+  procedure(integer):: p1
+  procedure(fun):: p2
+  procedure(abssub):: p3
+  procedure(sub):: p4
+  procedure():: p5
+  procedure(p4):: p6
+  procedure(integer) :: p7
+
+  i=p1()
+  if (i /= 5) call abort()
+  i=p2(3.1)
+  if (i /= 3) call abort()
+  r=4.2
+  call p3(r)
+  if (abs(r-5.2)>1e-6) call abort()
+  call p4(r)
+  if (abs(r-3.7)>1e-6) call abort()
+  call p5()
+  call p6(r)
+  if (abs(r-7.4)>1e-6) call abort()
+  i=p7(4)
+  if (i /= -8) call abort()
+  r=dummytest(p3)
+  if (abs(r-2.1)>1e-6) call abort()
+
+contains
+
+  integer function fun(x)
+    real x
+    fun=7
+  end function
+
+  subroutine sub(x)
+    real x
+  end subroutine
+
+  real function dummytest(dp)
+    procedure(abssub):: dp
+    real y
+    y=1.1
+    call dp(y)
+    dummytest=y
+  end function
+
+end program p
+
+
+integer function p1()
+  p1 = 5
+end function
+
+integer function p2(x)
+  real x
+  p2 = int(x)
+end function
+
+subroutine p3(x)
+  real,intent(inout):: x
+  x=x+1.0
+end subroutine
+
+subroutine p4(x)
+  real,intent(inout):: x
+  x=x-1.5
+end subroutine
+
+subroutine p5()
+end subroutine
+
+subroutine p6(x)
+  real,intent(inout):: x
+  x=x*2.
+end subroutine
+
+function p7(x)
+ implicit none
+ integer :: x, p7
+ p7 = x*(-2)
+end function
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_20.f90 b/gcc/testsuite/gfortran.dg/proc_decl_20.f90
new file mode 100644
index 000000000..612dac195
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_20.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+!
+! PR fortran/36463
+! Gfortran used to fail on this testcase with: 
+! gfc_get_default_type(): Bad symbol '@0'
+!
+! Original program by James Van Buskirk
+! Reduced by Janus Weil <janus@gcc.gnu.org>
+
+module other_fun
+   interface
+      function abstract_fun(x)
+         integer x
+         integer abstract_fun(x)
+      end function abstract_fun
+   end interface
+end module other_fun
+
+ program fptr
+    use other_fun
+    procedure(abstract_fun) :: fun
+ end program fptr
+
+! { dg-final { cleanup-modules "other_fun" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_21.f90 b/gcc/testsuite/gfortran.dg/proc_decl_21.f90
new file mode 100644
index 000000000..4fd4020cb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_21.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+!
+! PR fortran/39414: PROCEDURE statement double declaration bug
+!
+! Discovered by Paul Thomas <pault@gcc.gnu.org>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+
+! forbidden
+
+procedure(integer) :: a
+integer :: a   ! { dg-error "already has basic type of" }
+
+integer :: b
+procedure(integer) :: b	  ! { dg-error "already has basic type of" }
+
+procedure(iabs) :: c
+integer :: c   ! { dg-error "may not have basic type of" }
+
+integer :: d
+procedure(iabs) :: d   ! { dg-error "already has basic type of" }
+
+! allowed
+
+integer :: e
+procedure() :: e
+
+procedure() :: f
+integer :: f
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_22.f90 b/gcc/testsuite/gfortran.dg/proc_decl_22.f90
new file mode 100644
index 000000000..40060061a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_22.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+! PR 37254: Reject valid PROCEDURE statement with implicit interface
+!
+! Original test case by Dominique d'Humieres <dominiq@lps.ens.fr>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+  real function proc3( arg1 )
+     integer :: arg1
+     proc3 = arg1+7
+  end function proc3
+
+program myProg
+  PROCEDURE () :: proc3
+  call proc4( proc3 )
+
+contains
+
+  subroutine proc4( arg1 )
+     PROCEDURE(real) :: arg1
+     print*, 'the func: ', arg1(0)
+  end subroutine proc4
+
+end program myProg
+
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_23.f90 b/gcc/testsuite/gfortran.dg/proc_decl_23.f90
new file mode 100644
index 000000000..66cf5fff7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_23.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! Test the fix for PR43227, in which the lines below would segfault.
+!
+! Dominique d'Humieres <dominiq@lps.ens.fr>
+!
+function char1 (s) result(res)
+  character, dimension(:), intent(in) :: s
+  character(len=size(s)) :: res
+  do i = 1, size(s)
+    res(i:i) = s(i)
+  end do
+end function char1
+
+module m_string
+
+  procedure(string_to_char) :: char1                    ! segfault
+  procedure(string_to_char), pointer :: char2           ! segfault
+  type t_string
+    procedure(string_to_char), pointer, nopass :: char3 ! segfault
+  end type t_string
+
+contains
+
+  function string_to_char (s) result(res)
+    character, dimension(:), intent(in) :: s
+    character(len=size(s)) :: res
+    do i = 1, size(s)
+      res(i:i) = s(i)
+    end do
+  end function string_to_char
+
+end module m_string
+
+  use m_string
+  type(t_string) :: t
+  print *, string_to_char (["a","b","c"])
+  char2 => string_to_char
+  print *, char2 (["d","e","f"])
+  t%char3 => string_to_char
+  print *, t%char3 (["g","h","i"])
+  print *, char1 (["j","k","l"])
+end
+! { dg-final { cleanup-tree-dump "m_string" } }
+! { dg-final { cleanup-modules "m_string" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_24.f90 b/gcc/testsuite/gfortran.dg/proc_decl_24.f90
new file mode 100644
index 000000000..01cbb7c37
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_24.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+!
+! Contributed by James van Buskirk
+!
+! http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/44d572766bce0e6f/
+
+  use iso_c_binding
+  implicit none
+
+  abstract interface
+    subroutine all_subs(x,y) bind(C)
+      use iso_c_binding
+      real(c_float) :: x,y
+    end subroutine all_subs
+  end  interface
+
+  procedure(all_subs) :: sub
+  type(C_FUNPTR) :: s
+
+  s = c_funloc (sub)
+
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_25.f90 b/gcc/testsuite/gfortran.dg/proc_decl_25.f90
new file mode 100644
index 000000000..b45591180
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_25.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+!
+! PR 47352: [F03] ICE with proc-pointers in generic procedures
+!
+! Contributed by James van Buskirk
+! cf. http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/bbaf59ffd7c372e9
+
+   implicit none
+
+   abstract interface
+      real function f()
+      end function f
+   end interface
+
+   procedure(f) :: f1
+
+   interface gen
+      procedure f1
+   end interface gen
+
+   write(*,*) gen()
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_27.f90 b/gcc/testsuite/gfortran.dg/proc_decl_27.f90
new file mode 100644
index 000000000..30ff4def3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_27.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+! PR 50659: [4.5/4.6/4.7 Regression] [F03] ICE on invalid with procedure interface
+!
+! Contributed by Andrew Benson <abenson@caltech.edu>
+
+module m1
+  integer :: arrSize
+end module
+
+module m2
+contains
+  function Proc (arg)
+    use m1
+    double precision, dimension(arrSize) :: proc
+    double precision :: arg
+  end function
+end
+
+  use m2
+  implicit none
+  procedure(Proc) :: Proc_Get
+end
+
+! { dg-final { cleanup-modules "m1 m2" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_3.f90 b/gcc/testsuite/gfortran.dg/proc_decl_3.f90
new file mode 100644
index 000000000..5ee8a9117
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_3.f90
@@ -0,0 +1,75 @@
+! { dg-do compile }
+! Some tests for PROCEDURE declarations inside of interfaces.
+! Contributed by Janus Weil <jaydub66@gmail.com>
+
+module m
+
+  interface
+    subroutine a()
+    end subroutine a
+  end interface
+
+  procedure(c) :: f
+
+  interface bar
+    procedure a,d
+  end interface bar
+
+  interface foo
+    procedure c
+  end interface foo
+
+  abstract interface
+    procedure f  ! { dg-error "must be in a generic interface" }
+  end interface
+
+  interface
+    function opfoo(a)
+      integer,intent(in) :: a
+      integer :: opfoo
+    end function opfoo
+  end interface
+
+  interface operator(.op.)
+    procedure opfoo
+  end interface
+
+  external ex  ! { dg-error "has no explicit interface" }
+  procedure():: ip  ! { dg-error "has no explicit interface" }
+  procedure(real):: pip  ! { dg-error "has no explicit interface" }
+
+  interface nn1
+    procedure ex
+    procedure a, a  ! { dg-error "already present in the interface" }
+  end interface
+
+  interface nn2
+    procedure ip
+  end interface
+
+  interface nn3
+    procedure pip
+  end interface
+
+contains
+
+ subroutine d(x)
+
+   interface
+     subroutine x()
+     end subroutine x
+   end interface
+
+   interface gen
+     procedure x
+   end interface
+
+ end subroutine d
+
+ function c(x)
+   integer :: x
+   real :: c
+   c = 3.4*x
+ end function c
+
+end module m
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_4.f90 b/gcc/testsuite/gfortran.dg/proc_decl_4.f90
new file mode 100644
index 000000000..fa133d45e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_4.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! Test for PROCEDURE statements with the -std=f95 flag.
+! Contributed by Janus Weil <jaydub66@gmail.com>
+
+program p
+
+procedure():: proc  ! { dg-error "Fortran 2003: PROCEDURE statement" }
+
+end program 
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_5.f90 b/gcc/testsuite/gfortran.dg/proc_decl_5.f90
new file mode 100644
index 000000000..b327d5c12
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_5.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! PR fortran/33945
+!
+! PROCEDURE in the interface was wrongly rejected
+module modproc
+  implicit none
+  interface bar
+    procedure x
+  end interface bar
+  procedure(sub) :: x
+  interface
+    integer function sub()
+    end function sub
+  end interface
+end module modproc
+
+integer function x()
+  implicit none
+  x = -5
+end function x
+
+program test
+  use modproc
+  implicit none
+  if(x() /= -5) call abort()
+end program test
+
+! { dg-final { cleanup-modules "modproc" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_6.f90 b/gcc/testsuite/gfortran.dg/proc_decl_6.f90
new file mode 100644
index 000000000..d2a6a1de9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_6.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! PR fortran/33945
+!
+! MODULE PROCEDURE in the interface was wrongly accepted
+module modproc2
+  implicit none
+  interface
+    subroutine x
+    end subroutine x
+  end interface
+  procedure(x) :: y
+  interface bar
+    module procedure y ! { dg-error "not a module procedure" }
+  end interface bar
+end module modproc2
+
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_7.f90 b/gcc/testsuite/gfortran.dg/proc_decl_7.f90
new file mode 100644
index 000000000..c8c2a81c5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_7.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! PR33162 INTRINSIC functions as ACTUAL argument
+! Test case adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+module m
+implicit none
+contains
+  subroutine sub(a)
+    interface
+      function a()
+        real :: a
+      end function a
+    end interface
+    print *, a()
+  end subroutine sub
+end module m
+use m
+implicit none
+intrinsic cos
+call sub(cos) ! { dg-error "wrong number of arguments" }
+end
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_8.f90 b/gcc/testsuite/gfortran.dg/proc_decl_8.f90
new file mode 100644
index 000000000..2d3514ec8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_8.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! PR33162 INTRINSIC functions as ACTUAL argument
+! Test case adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+module m
+implicit none
+contains
+  subroutine sub(a)
+    interface
+      function a(x)
+        real :: a, x
+        intent(in) :: x
+      end function a
+    end interface
+    print *, a(4.0)
+  end subroutine sub
+
+end module m
+
+use m
+implicit none
+EXTERNAL foo  ! interface is undefined
+procedure(cos) :: foo ! { dg-error "Duplicate EXTERNAL attribute specified" }
+call sub(foo)         ! { dg-error "is not a function" }
+end
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_decl_9.f90 b/gcc/testsuite/gfortran.dg/proc_decl_9.f90
new file mode 100644
index 000000000..08faee931
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_9.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! PR33162 INTRINSIC functions as ACTUAL argument
+! Test case adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+real function t(x)
+  real ::x
+  t = x
+end function
+
+program p
+  implicit none
+  intrinsic sin
+  procedure(sin):: t
+  if (t(1.0) /= 1.0) call abort
+end program
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_1.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_1.f90
new file mode 100644
index 000000000..fe8e20100
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_1.f90
@@ -0,0 +1,73 @@
+! { dg-do run }
+!
+! basic tests of PROCEDURE POINTERS
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m
+contains
+  subroutine proc1(arg)
+    character (5) :: arg
+    arg = "proc1"
+  end subroutine
+  integer function proc2(arg)
+    integer, intent(in) :: arg
+    proc2 = arg**2
+  end function
+  complex function proc3(re, im)
+    real, intent(in) :: re, im
+    proc3 = complex (re, im)
+  end function
+end module
+
+subroutine foo1
+end subroutine
+
+real function foo2()
+  foo2=6.3
+end function
+
+program procPtrTest
+  use m, only: proc1, proc2, proc3
+  character (5) :: str
+  PROCEDURE(proc1), POINTER :: ptr1
+  PROCEDURE(proc2), POINTER :: ptr2
+  PROCEDURE(proc3), POINTER :: ptr3 => NULL()
+  PROCEDURE(REAL), SAVE, POINTER :: ptr4
+  PROCEDURE(), POINTER :: ptr5,ptr6
+
+  EXTERNAL :: foo1,foo2
+  real :: foo2
+
+  if(ASSOCIATED(ptr3)) call abort()
+
+  NULLIFY(ptr1)
+  if (ASSOCIATED(ptr1)) call abort()
+  ptr1 => proc1
+  if (.not. ASSOCIATED(ptr1)) call abort()
+  call ptr1 (str)
+  if (str .ne. "proc1") call abort ()
+
+  ptr2 => NULL()
+  if (ASSOCIATED(ptr2)) call abort()
+  ptr2 => proc2
+  if (.not. ASSOCIATED(ptr2,proc2)) call abort()
+  if (10*ptr2 (10) .ne. 1000) call abort ()
+
+  ptr3 => NULL (ptr3)
+  if (ASSOCIATED(ptr3)) call abort()
+  ptr3 => proc3
+  if (ptr3 (1.0, 2.0) .ne. (1.0, 2.0)) call abort ()
+
+  ptr4 => cos
+  if (ptr4(0.0)/=1.0) call abort()
+
+  ptr5 => foo1
+  call ptr5()
+
+  ptr6 => foo2
+  if (ptr6()/=6.3) call abort()
+
+end program 
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_10.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_10.f90
new file mode 100644
index 000000000..0ceedaa2d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_10.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+!
+! PR fortran/37253
+!
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+
+module myMod
+
+  CONTAINS
+
+  real function proc3( arg1 )
+     integer :: arg1
+     proc3 = arg1+7
+  end function proc3
+
+  subroutine proc4( arg1 )
+     procedure(real), pointer :: arg1
+     if (arg1(0)/=7) call abort()
+  end subroutine proc4
+
+end module myMod
+
+program myProg
+  use myMod
+  PROCEDURE (real), POINTER :: p => NULL()
+  p => proc3
+  call proc4( p )
+end program myProg
+ 
+! { dg-final { cleanup-modules "myMod" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_11.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_11.f90
new file mode 100644
index 000000000..4e8b3c253
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_11.f90
@@ -0,0 +1,62 @@
+! { dg-do compile }
+!
+! PR 38290: Procedure pointer assignment checking.
+!
+! Test case found at http://de.wikibooks.org/wiki/Fortran:_Fortran_2003:_Zeiger
+! Adapted by Janus Weil <janus@gcc.gnu.org>
+
+program bsp
+  implicit none   
+
+  abstract interface
+    subroutine up()
+    end subroutine up
+  end interface
+
+  procedure( up ) , pointer :: pptr
+  procedure(isign), pointer :: q
+
+  procedure(iabs),pointer :: p1
+  procedure(f), pointer :: p2
+
+  pointer :: p3
+  interface
+    function p3(x)
+      real(8) :: p3,x
+      intent(in) :: x
+    end function p3
+  end interface
+
+  pptr => add   ! { dg-error "is not a subroutine" }
+
+  q => add
+
+  print *, pptr()   ! { dg-error "is not a function" }
+
+  p1 => iabs
+  p2 => iabs
+  p1 => f
+  p2 => f
+  p2 => p1
+  p1 => p2
+
+  p1 => abs   ! { dg-error "Type/kind mismatch in return value" }
+  p2 => abs   ! { dg-error "Type/kind mismatch in return value" }
+
+  p3 => dsin
+  p3 => sin   ! { dg-error "Type/kind mismatch in return value" }
+
+  contains
+
+    function add( a, b )
+      integer               :: add
+      integer, intent( in ) :: a, b
+      add = a + b
+    end function add
+
+    integer function f(x)
+      integer,intent(in) :: x
+      f = 317 + x
+    end function
+
+end program bsp 
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_12.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_12.f90
new file mode 100644
index 000000000..325703f49
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_12.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+!
+! PR 36704: Procedure pointer as function result
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+procedure(integer),pointer :: p
+p => foo()
+if (p(-1)/=1) call abort
+contains
+  function foo() result(bar)
+    procedure(integer),pointer :: bar
+    bar => iabs
+  end function
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_13.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_13.f90
new file mode 100644
index 000000000..5c66c54e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_13.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! { dg-options "-g" }
+!
+! PR 38152: Procedure pointers as module variables.
+!
+! Contributed by Daniel Kraft <domob@gcc.gnu.org>
+
+MODULE myfortran_binding
+
+  IMPLICIT NONE
+  PROCEDURE(error_stop), POINTER :: error_handler
+
+CONTAINS
+
+  LOGICAL FUNCTION myfortran_shutdown ()
+    CALL error_handler ()
+  END FUNCTION myfortran_shutdown
+
+  SUBROUTINE error_stop ()
+  END SUBROUTINE error_stop
+
+END MODULE myfortran_binding
+
+
+use myfortran_binding
+error_handler => error_stop
+end
+
+! { dg-final { cleanup-modules "myfortran_binding" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_14.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_14.f90
new file mode 100644
index 000000000..90037a1a5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_14.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR 39692: f95: conflict between EXTERNAL and POINTER
+!
+! Test for Procedure Pointers (without PROCEDURE statements) with the -std=f95 flag.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+pointer :: f
+external :: f   ! { dg-error "Fortran 2003: Procedure pointer" }
+
+external :: g
+pointer :: g   ! { dg-error "Fortran 2003: Procedure pointer" }
+
+real, pointer, external :: h   ! { dg-error "Fortran 2003: Procedure pointer" }
+
+interface
+  subroutine i
+  end subroutine i
+end interface
+pointer :: i   ! { dg-error "Fortran 2003: Procedure pointer" }
+
+pointer :: j
+interface
+  real function j()
+  end function j   ! { dg-error "Fortran 2003: Procedure pointer" }
+end interface
+
+contains
+
+  function k()   ! { dg-error "attribute conflicts with" }
+    intrinsic sin
+    external k
+    pointer k   ! { dg-error "Fortran 2003: Procedure pointer" }
+    real k
+  end function k
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_15.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_15.f90
new file mode 100644
index 000000000..3d37ee2d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_15.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+!
+! PR 39735: procedure pointer assignments: return value is not checked
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+implicit none
+procedure(real(4)), pointer :: p1
+procedure(integer), pointer :: p2
+procedure(sub), pointer :: p3
+procedure(), pointer :: p4
+procedure(real(8)),pointer :: p5
+real(4), external, pointer :: p6
+
+! valid
+p2 => iabs
+p3 => sub
+p4 => p3
+p6 => p1
+
+! invalid
+p1 => iabs   ! { dg-error "Type/kind mismatch in return value" }
+p1 => p2     ! { dg-error "Type/kind mismatch in return value" }
+p1 => p5     ! { dg-error "Type/kind mismatch in return value" }
+p6 => iabs   ! { dg-error "Type/kind mismatch in return value" }
+p4 => p2     ! { dg-error "is not a subroutine" }
+
+contains
+
+  subroutine sub(i)
+    integer :: i
+  end subroutine
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_16.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_16.f90
new file mode 100644
index 000000000..904b550b5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_16.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+!
+! PR 39946: PROCEDURE statements: interface with RESULT variable
+!
+! Original test case by Juergen Reuter <reuter@physik.uni-freiburg.de>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+  procedure(prc_is_allowed), pointer :: fptr
+
+  interface
+     function prc_is_allowed (flv, hel, col) result (is_allowed)
+       logical :: is_allowed
+       integer, intent(in) :: flv, hel, col
+     end function prc_is_allowed
+  end interface
+
+  fptr => prc_is_allowed
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_17.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_17.f90
new file mode 100644
index 000000000..55b8bce24
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_17.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR39998: Procedure Pointer Assignments: Statement Functions & Internal Functions.
+!
+! Contributed by Tobias Burnus <burnus@net-b.de>
+
+  procedure(), pointer :: p
+  f(x) = x**2  ! { dg-warning "Obsolescent feature" }
+  p => f  ! { dg-error "invalid in procedure pointer assignment" }
+  p => sub  ! { dg-error "invalid in procedure pointer assignment" }
+contains
+  subroutine sub
+  end subroutine sub
+end
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_18.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_18.f90
new file mode 100644
index 000000000..79cd68a51
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_18.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+!
+! PR 40176:  Fortran 2003: Procedure pointers with array return value
+!
+! Original test case by Barron Bichon <barron.bichon@swri.org>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+PROGRAM test_prog
+
+  PROCEDURE(triple), POINTER :: f
+
+  f => triple
+  if (sum(f(2.,4.)-triple(2.,4.))>1E-3) call abort()
+
+CONTAINS
+
+  FUNCTION triple(a,b) RESULT(tre)
+    REAL, INTENT(in) :: a, b
+    REAL :: tre(2)
+    tre(1) = 3.*a
+    tre(2) = 3.*b
+  END FUNCTION triple
+
+END PROGRAM test_prog
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_19.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_19.f90
new file mode 100644
index 000000000..a78a8d464
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_19.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+!
+! PR 40176:  Fortran 2003: Procedure pointers with array return value
+!
+! This example tests for a bug in procedure pointer assignments,
+! where the rhs is a dummy.
+!
+! Original test case by Barron Bichon <barron.bichon@swri.org>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+PROGRAM test_prog
+
+  PROCEDURE(add), POINTER :: forig, fset
+
+  forig => add
+
+  CALL set_ptr(forig,fset)
+
+  if (forig(1,2) /= fset(1,2)) call abort()
+
+CONTAINS
+
+  SUBROUTINE set_ptr(f1,f2)
+    PROCEDURE(add), POINTER :: f1, f2
+    f2 => f1
+  END SUBROUTINE set_ptr
+
+  FUNCTION add(a,b)
+    INTEGER :: a,b,add
+    add = a+b
+
+  END FUNCTION add
+ 
+END PROGRAM test_prog
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_2.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_2.f90
new file mode 100644
index 000000000..98539b985
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_2.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+! checking invalid code for PROCEDURE POINTERS
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+PROCEDURE(REAL), POINTER :: ptr
+PROCEDURE(REAL), SAVE    :: noptr    ! { dg-error "attribute conflicts with" }
+REAL :: x
+
+ abstract interface
+   subroutine bar(a)
+     integer :: a
+   end subroutine bar
+ end interface
+
+ptr => cos(4.0)        ! { dg-error "Invalid procedure pointer assignment" }
+ptr => x               ! { dg-error "Invalid procedure pointer assignment" }
+ptr => sin(x)          ! { dg-error "Invalid procedure pointer assignment" }
+
+ptr => bar             ! { dg-error "is invalid in procedure pointer assignment" }
+
+ALLOCATE(ptr)          ! { dg-error "must be ALLOCATABLE" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_20.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_20.f90
new file mode 100644
index 000000000..79c9ba8f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_20.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+!
+! PR 40450: [F03] procedure pointer as actual argument
+!
+! Contributed by John McFarland <john.mcfarland@swri.org>
+
+MODULE m
+ ABSTRACT INTERFACE
+ SUBROUTINE sub()
+ END SUBROUTINE sub
+ END INTERFACE
+
+CONTAINS
+
+ SUBROUTINE passf(f2)
+   PROCEDURE(sub), POINTER:: f2
+   CALL callf(f2)
+ END SUBROUTINE passf
+
+ SUBROUTINE callf(f3)
+   PROCEDURE(sub), POINTER :: f3
+   PRINT*, 'calling f'
+   CALL f3()
+ END SUBROUTINE callf
+END MODULE m
+
+
+PROGRAM prog
+ USE m
+ PROCEDURE(sub), POINTER :: f1
+ f1 => s
+ CALL passf(f1)
+
+CONTAINS
+
+ SUBROUTINE s
+   PRINT*, 'sub'
+ END SUBROUTINE s
+END PROGRAM prog
+
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_21.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_21.f90
new file mode 100644
index 000000000..875173fd3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_21.f90
@@ -0,0 +1,33 @@
+! { dg-do run }

+! Tests the fix for PR40591 in which the interface 'sub2'

+! for 'pptr2' was not resolved.

+!

+! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>

+!

+program main

+  call test

+contains

+  subroutine sub1(arg)
+    integer arg
+    arg = arg + 1

+  end subroutine sub1

+  subroutine test()

+    procedure(sub1), pointer :: pptr1

+    procedure(sub2), pointer :: pptr2
+    integer i

+    i = 0

+    pptr1 => sub1
+    call pptr1 (i)

+    pptr1 => sub2
+    call pptr1 (i)

+    pptr2 => sub1
+    call pptr2 (i)

+    pptr2 => sub2
+    call pptr2 (i)
+    if (i .ne. 22) call abort

+  end subroutine test

+  subroutine sub2(arg)
+    integer arg
+    arg = arg + 10

+  end subroutine sub2

+end program main

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_22.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_22.f90
new file mode 100644
index 000000000..3b1f5c64e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_22.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+!
+! PR 40646: [F03] array-valued procedure pointer components
+!
+! Original test case by Charlie Sharpsteen <chuck@sharpsteen.net>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+module bugTestMod
+  implicit none
+  procedure(returnMat), pointer :: pp2
+contains
+  function returnMat( a, b ) result( mat )
+    integer:: a, b
+    double precision, dimension(a,b):: mat 
+    mat = 1d0
+  end function returnMat
+end module bugTestMod
+
+program bugTest
+  use bugTestMod
+  implicit none
+  procedure(returnMat), pointer :: pp
+  pp => returnMat
+  if (sum(pp(2,2))/=4) call abort()
+  pp2 => returnMat
+  if (sum(pp2(3,2))/=6) call abort()
+end program bugTest
+
+! { dg-final { cleanup-modules "bugTestMod" } }
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_23.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_23.f90
new file mode 100644
index 000000000..ee947122f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_23.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+!
+! PR 41106: [F03] Procedure Pointers with CHARACTER results
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+character(len=5) :: str
+procedure(character(len=5)), pointer :: pp
+pp => abc
+print *,pp()
+str = pp()
+if (str/='abcde') call abort()
+contains
+ function abc()
+  character(len=5) :: abc
+  abc = 'abcde'
+ end function abc
+end
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_24.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_24.f90
new file mode 100644
index 000000000..6bd4709aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_24.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options -std=f95 }
+!
+! Code was posted to comp.lang.fortran by Richard Maine.
+! http://groups.google.com/group/comp.lang.fortran/browse_frm/thread/fff9b3426211c018#
+!
+module m
+  type :: foo
+    real, pointer :: array(:)
+    procedure (), pointer, nopass :: f ! { dg-error "Procedure pointer component" }
+  end type
+contains
+    elemental subroutine fooAssgn (a1, a2)
+        type(foo), intent(out) :: a1
+        type(foo), intent(in) :: a2
+        allocate (a1%array(size(a2%array)))
+
+        a1%array = a2%array
+        a1%f => a2%f         ! { dg-error "not a member of the" }
+    end subroutine
+end module m
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_25.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_25.f90
new file mode 100644
index 000000000..cfa0d4434
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_25.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+!
+! PR 41139: [4.5 Regression] a procedure pointer call as actual argument
+!
+! Original test case by Barron Bichon <barron.bichon@swri.org>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+PROGRAM test
+
+ PROCEDURE(add), POINTER :: f
+ logical :: g
+
+ ! Passing the function works
+ g=greater(4.,add(1.,2.))
+ if (.not. g) call abort()
+
+ ! Passing the procedure pointer fails
+ f => add
+ g=greater(4.,f(1.,2.))
+ if (.not. g) call abort()
+
+CONTAINS
+
+ REAL FUNCTION add(x,y)
+   REAL, INTENT(in) :: x,y
+   print *,"add:",x,y
+   add = x+y
+ END FUNCTION add
+
+ LOGICAL FUNCTION greater(x,y)
+   REAL, INTENT(in) :: x, y
+   greater = (x > y)
+ END FUNCTION greater
+
+END PROGRAM test
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_26.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_26.f90
new file mode 100644
index 000000000..044f0a403
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_26.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+!
+! PR fortran/42597
+!
+! Contributed by mrestelli@gmail.com
+!
+
+module mod_a
+ implicit none
+
+ abstract interface
+  pure function intf(x) result(y)
+   real, intent(in) :: x(:,:)
+   real :: y(size(x,1),size(x,1),size(x,2))
+  end function intf
+ end interface
+
+ procedure(intf), pointer :: p_fun => null()
+end module mod_a
+
+program main
+  use mod_a
+  implicit none
+
+  procedure(intf), pointer :: p_fun2 => null()
+
+  if (associated(p_fun) .or. associated(p_fun2)) &
+    call abort ()
+end program main
+
+! { dg-final { cleanup-modules "mod_a" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_27.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_27.f90
new file mode 100644
index 000000000..83f095981
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_27.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+!
+! PR fortran/44446
+!
+! Contributed by Marco Restelli.
+!
+! Procedure pointer with PROTECTED was wrongly rejected.
+!
+module m
+ implicit none
+ abstract interface
+  pure function i_f(x) result(y)
+   real, intent(in) :: x
+   real :: y
+  end function i_f
+ end interface
+ procedure(i_f), pointer, protected :: p_f => null()
+end module m
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_28.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_28.f90
new file mode 100644
index 000000000..8754d8e29
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_28.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+!
+! PR 44718: Procedure-pointer name is wrongly regarded as "external procedure"
+!
+! Contributed by John McFarland <john.mcfarland@swri.org>
+
+MODULE m
+
+ IMPLICIT NONE
+
+CONTAINS
+
+ FUNCTION func(x) RESULT(y)
+   INTEGER :: x,y
+   y = x *2
+ END FUNCTION func
+
+ SUBROUTINE sub(x)
+   INTEGER :: x
+   PRINT*, x
+ END SUBROUTINE sub
+
+
+ SUBROUTINE use_func()
+   PROCEDURE(func), POINTER :: f
+   INTEGER :: y
+   f => func
+   y = f(2)
+ END SUBROUTINE use_func
+
+ SUBROUTINE use_sub()
+   PROCEDURE(sub), POINTER :: f
+   f => sub
+   CALL f(2)
+ END SUBROUTINE use_sub
+
+END MODULE m 
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_29.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_29.f90
new file mode 100644
index 000000000..69f0b0341
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_29.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+!
+! PR 45366: Problem with procedure pointer dummy in PURE function
+!
+! Contributed by Marco Restelli <mrestelli@gmail.com>
+
+module m1
+ implicit none
+ abstract interface
+  pure function i_f(x) result(y)
+   real, intent(in) :: x
+   real :: y
+  end function i_f
+ end interface
+end module m1
+
+module m2
+ use m1, only: i_f
+ implicit none
+contains
+ pure function i_g(x,p) result(y)
+  real, intent(in) :: x
+  procedure(i_f), pointer, intent(in) :: p
+  real :: y
+   y = p(x)
+ end function i_g
+end module m2
+
+! { dg-final { cleanup-modules "m1 m2" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_3.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_3.f90
new file mode 100644
index 000000000..b69ae9c10
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_3.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+!
+! PROCEDURE POINTERS without the PROCEDURE statement
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+real function e1(x)
+  real :: x
+  e1 = x * 3.0
+end function
+
+subroutine e2(a,b)
+  real, intent(inout) :: a
+  real, intent(in) :: b
+  a = a + b
+end subroutine
+
+program proc_ptr_3
+
+real, external, pointer :: fp
+
+pointer :: sp
+interface
+  subroutine sp(a,b)
+    real, intent(inout) :: a
+    real, intent(in) :: b
+  end subroutine sp
+end interface
+
+real, external :: e1
+
+interface
+  subroutine e2(a,b)
+    real, intent(inout) :: a
+    real, intent(in) :: b
+  end subroutine e2
+end interface
+
+real :: c = 1.2
+
+fp => e1
+
+if (abs(fp(2.5)-7.5)>0.01) call abort()
+
+sp => e2
+
+call sp(c,3.4)
+
+if (abs(c-4.6)>0.01) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_30.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_30.f90
new file mode 100644
index 000000000..5996deecb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_30.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+!
+! PR 46067: [F03] invalid procedure pointer assignment not detected
+!
+! Contributed by Stephen J. Bespalko <sjbespa@comcast.net>
+
+  implicit none
+  
+  type test_type
+    integer :: id = 1
+  end type
+  
+  abstract interface
+    real function fun_interface(t,x)
+      import :: test_type
+      real, intent(in) :: x
+      class(test_type) :: t
+    end function
+  end interface  
+  
+  type(test_type) :: funs
+  real :: r
+  procedure(fun_interface), pointer :: pp
+
+  pp => fun1        ! { dg-error "Interface mismatch in procedure pointer assignment" }
+  r = pp(funs,0.)
+  print *, " pp(0) ", r 
+
+contains
+
+  real function fun1 (t,x)
+    real, intent(in) :: x
+    type(test_type) :: t
+    print *," id = ", t%id
+    fun1 = cos(x)
+  end function
+ 
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_34.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_34.f90
new file mode 100644
index 000000000..6226414b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_34.f90
@@ -0,0 +1,79 @@
+! { dg-do compile }
+!
+! PR fortran/52469
+!
+! This was failing as the DECL of the proc pointer "func"
+! was used for the interface of the proc-pointer component "my_f_ptr"
+! rather than the decl of the proc-pointer target
+!
+! Contributed by palott@gmail.com
+!
+
+module ExampleFuncs
+  implicit none
+
+  ! NOTE: "func" is a procedure pointer!
+  pointer :: func
+  interface
+     function func (z)
+        real :: func
+        real, intent (in) :: z
+     end function func
+  end interface
+
+  type Contains_f_ptr
+     procedure (func), pointer, nopass :: my_f_ptr
+  end type Contains_f_ptr
+contains
+
+function f1 (x)
+  real :: f1
+  real, intent (in) :: x
+
+  f1 = 2.0 * x
+
+  return
+end function f1
+
+function f2 (x)
+   real :: f2
+   real, intent (in) :: x
+
+   f2 = 3.0 * x**2
+
+   return
+end function f2
+
+function fancy (func, x)
+   real :: fancy
+   real, intent (in) :: x
+
+   interface AFunc
+      function func (y)
+         real :: func
+         real, intent (in) ::y
+      end function func
+   end interface AFunc
+
+   fancy = func (x) + 3.3 * x
+end function fancy
+
+end module  ExampleFuncs
+
+
+program test_proc_ptr
+  use ExampleFuncs
+  implicit none
+
+  type (Contains_f_ptr), dimension (2) :: NewType
+ 
+  !NewType(1) % my_f_ptr => f1
+  NewType(2) % my_f_ptr => f2
+
+  !write (*, *) NewType(1) % my_f_ptr (3.0), NewType(2) % my_f_ptr (3.0)
+  write (6, *)  NewType(2) % my_f_ptr (3.0) ! < Shall print '27.0'
+
+  stop
+end program test_proc_ptr
+
+! { dg-final { cleanup-modules "examplefuncs" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_4.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_4.f90
new file mode 100644
index 000000000..60b9e73af
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_4.f90
@@ -0,0 +1,57 @@
+! { dg-do compile }
+!
+! PROCEDURE POINTERS & pointer-valued functions
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+interface
+  integer function f1()
+  end function
+end interface
+
+interface
+ function f2()
+   integer, pointer :: f2
+ end function
+end interface
+
+interface
+ function pp1()
+   integer :: pp1
+ end function
+end interface
+pointer :: pp1
+
+pointer :: pp2
+interface
+  function pp2()
+    integer :: pp2
+  end function
+end interface
+
+pointer :: pp3
+interface
+  function pp3()
+    integer, pointer :: pp3
+  end function
+end interface
+
+interface
+  function pp4()
+    integer, pointer :: pp4
+  end function
+end interface
+pointer :: pp4
+
+
+pp1 => f1
+
+pp2 => pp1
+
+f2 => f1	! { dg-error "is not a variable" }
+
+pp3 => f2
+
+pp4 => pp3
+
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_5.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_5.f90
new file mode 100644
index 000000000..61cf8a35d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_5.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! NULL() initialization for PROCEDURE POINTERS
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+program main
+implicit none
+call test(.true.)
+call test(.false.)
+
+contains
+
+integer function hello()
+ hello = 42
+end function hello
+
+subroutine test(first)
+ logical :: first
+ integer :: i
+ procedure(integer), pointer :: x => null()
+
+ if(first) then
+  if(associated(x)) call abort()
+  x => hello
+ else
+  if(.not. associated(x)) call abort()
+  i = x()
+  if(i /= 42) call abort()
+ end if
+ end subroutine test
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_6.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_6.f90
new file mode 100644
index 000000000..6a5c7e5f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_6.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+!
+! PROCEDURE POINTERS as actual/formal arguments
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+subroutine foo(j)
+  INTEGER, INTENT(OUT) :: j
+  j = 6
+end subroutine
+
+program proc_ptr_6
+
+PROCEDURE(),POINTER :: ptr1
+PROCEDURE(REAL),POINTER :: ptr2
+EXTERNAL foo
+INTEGER :: k = 0
+
+ptr1 => foo
+call s_in(ptr1,k)
+if (k /= 6) call abort()
+
+call s_out(ptr2)
+if (ptr2(-3.0) /= 3.0) call abort()
+
+contains
+
+subroutine s_in(p,i)
+  PROCEDURE(),POINTER,INTENT(IN) :: p
+  INTEGER, INTENT(OUT) :: i
+  call p(i)
+end subroutine
+
+subroutine s_out(p)
+  PROCEDURE(REAL),POINTER,INTENT(OUT) :: p
+  p => abs
+end subroutine
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_7.c b/gcc/testsuite/gfortran.dg/proc_ptr_7.c
new file mode 100644
index 000000000..7e9542fd8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_7.c
@@ -0,0 +1,10 @@
+/* Procedure pointer test. Used by proc_ptr_7.f90.
+   PR fortran/32580.  */
+
+int f(void) {
+  return 42;
+}
+
+void assignf_(int(**ptr)(void)) {
+  *ptr = f;
+}
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_7.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_7.f90
new file mode 100644
index 000000000..8b1ea0a44
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_7.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! { dg-additional-sources proc_ptr_7.c }
+!
+! PR fortran/32580
+! Procedure pointer test
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+program proc_pointer_test
+  use iso_c_binding, only: c_int
+  implicit none
+
+  interface
+    subroutine assignF(f)
+      import c_int
+      procedure(Integer(c_int)), pointer :: f
+    end subroutine
+  end interface
+
+  procedure(Integer(c_int)), pointer :: ptr
+
+  call assignF(ptr)
+  if(ptr() /= 42) call abort()
+
+  ptr => f55
+  if(ptr() /= 55) call abort()  
+
+  call foo(ptr)
+  if(ptr() /= 65) call abort()  
+
+contains
+
+ subroutine foo(a)
+   procedure(integer(c_int)), pointer :: a
+   if(a() /= 55) call abort()
+   a => f65
+   if(a() /= 65) call abort()
+ end subroutine foo
+
+ integer(c_int) function f55()
+    f55 = 55
+ end function f55
+
+ integer(c_int) function f65()
+    f65 = 65
+ end function f65
+end program proc_pointer_test
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_8.c b/gcc/testsuite/gfortran.dg/proc_ptr_8.c
new file mode 100644
index 000000000..c732ff666
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_8.c
@@ -0,0 +1,14 @@
+/* Used by proc_ptr_8.f90.
+   PR fortran/32580.  */
+
+int (*funpointer)(int);
+
+int f(int t)
+{
+  return t*3;
+}
+
+void init()
+{
+ funpointer=f;
+}
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_8.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_8.f90
new file mode 100644
index 000000000..f45d114f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_8.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+! { dg-additional-sources proc_ptr_8.c }
+!
+! PR fortran/32580
+! Original test case
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+
+MODULE X
+
+  USE ISO_C_BINDING
+  INTERFACE
+    INTEGER(KIND=C_INT) FUNCTION mytype( a ) BIND(C)
+       USE ISO_C_BINDING
+       INTEGER(KIND=C_INT), VALUE :: a
+    END FUNCTION
+    SUBROUTINE init() BIND(C,name="init")
+    END SUBROUTINE
+  END INTERFACE
+
+  TYPE(C_FUNPTR), BIND(C,name="funpointer") :: funpointer
+
+END MODULE X
+
+USE X
+PROCEDURE(mytype), POINTER :: ptype,ptype2
+
+CALL init()
+CALL C_F_PROCPOINTER(funpointer,ptype)
+if (ptype(3) /= 9) call abort()
+
+! the stuff below was added with PR 42072
+call setpointer(ptype2)
+if (ptype2(4) /= 12) call abort()
+
+contains
+
+  subroutine setpointer (p)
+    PROCEDURE(mytype), POINTER :: p
+    CALL C_F_PROCPOINTER(funpointer,p)
+  end subroutine
+
+END
+
+! { dg-final { cleanup-modules "X" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_9.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_9.f90
new file mode 100644
index 000000000..22708b8f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_9.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+!
+! PR fortran/36705
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+save :: p
+procedure() :: p
+pointer :: p
+
+contains
+
+subroutine bar(x)
+  procedure(), intent(in) :: x
+  pointer :: x
+end subroutine bar 
+
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_common_1.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_common_1.f90
new file mode 100644
index 000000000..df2ef0b79
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_common_1.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+
+! PR fortran/36592
+!
+! Procedure Pointers inside COMMON blocks.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>.
+
+subroutine one()
+  implicit none
+  common /com/ p1,p2,a,b
+  procedure(real), pointer :: p1,p2
+  integer :: a,b
+  if (a/=5 .or. b/=-9 .or. p1(0.0)/=1.0 .or. p2(0.0)/=0.0) call abort()
+end subroutine one
+
+program main
+  implicit none
+  integer :: x,y
+  intrinsic sin,cos
+  procedure(real), pointer :: func1
+  real, external :: func2
+  pointer func2
+  common /com/ func1,func2,x,y
+  x = 5
+  y = -9
+  func1 => cos
+  func2 => sin
+  call one()
+end program main
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_common_2.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_common_2.f90
new file mode 100644
index 000000000..f401c3a15
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_common_2.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+
+! PR fortran/36592
+!
+! Procedure Pointers inside COMMON blocks.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>.
+
+abstract interface
+ subroutine foo() bind(C)
+ end subroutine foo
+end interface
+
+procedure(foo), pointer, bind(C) :: proc
+common /com/ proc,r
+
+common s
+call s()  ! { dg-error "PROCEDURE attribute conflicts with COMMON attribute" }
+
+end 
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_1.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_1.f90
new file mode 100644
index 000000000..cbb69f1d5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_1.f90
@@ -0,0 +1,65 @@
+! { dg-do run }
+!
+! PR39630: Fortran 2003: Procedure pointer components.
+!
+! Basic test for PPCs with SUBROUTINE interface and NOPASS.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+  type t
+    integer :: i
+    procedure(sub), pointer, nopass :: ppc
+    procedure(), pointer, nopass :: proc
+  end type
+
+  type, extends(t) :: t2
+    procedure(), pointer, nopass :: proc2
+  end type t2
+
+  type(t) :: x
+  type(t2) :: x2
+
+  procedure(sub),pointer :: pp
+  integer :: sum = 0
+
+  x%i = 1
+  x%ppc => sub
+  pp => x%ppc
+
+  call sub(1)
+  if (sum/=1) call abort
+  call pp(2)
+  if (sum/=3) call abort
+  call x%ppc(3)
+  if (sum/=6) call abort
+
+  ! calling object as argument
+  x%proc => sub2
+  call x%proc(x)
+  if (x%i/=7) call abort
+
+  ! type extension
+  x%proc => sub
+  call x%proc(4)
+  if (sum/=10) call abort
+  x2%proc => sub
+  call x2%proc(5)
+  if (sum/=15) call abort
+  x2%proc2 => sub
+  call x2%proc2(6)
+  if (sum/=21) call abort
+
+contains
+
+  subroutine sub(y)
+    integer, intent(in) :: y
+    sum = sum + y
+  end subroutine
+
+  subroutine sub2(arg)
+    type(t),intent(inout) :: arg
+    arg%i = arg%i + sum
+  end subroutine
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_10.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_10.f90
new file mode 100644
index 000000000..382f41255
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_10.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+!
+! PR 40176:  Fortran 2003: Procedure pointers with array return value
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m
+
+abstract interface
+  function ai()
+    real, dimension(3) :: ai
+  end function
+end interface
+
+type t
+  procedure(ai), pointer, nopass :: ppc
+end type
+
+procedure(ai), pointer :: pp
+
+end module
+
+program test
+use m
+type(t) :: obj
+obj%ppc => pp
+pp => obj%ppc
+end
+
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_11.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_11.f90
new file mode 100644
index 000000000..7e487fbb2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_11.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+!
+! PR 40427: Procedure Pointer Components with OPTIONAL arguments
+!
+! Original test case by John McFarland <john.mcfarland@swri.org>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+PROGRAM prog
+
+ ABSTRACT INTERFACE
+ SUBROUTINE sub_template(i,j,o)
+   INTEGER, INTENT(in) :: i
+   INTEGER, INTENT(in), OPTIONAL :: j, o
+ END SUBROUTINE sub_template
+ END INTERFACE
+
+ TYPE container
+   PROCEDURE(sub_template), POINTER, NOPASS :: s
+ END TYPE container
+
+ PROCEDURE(sub_template), POINTER :: f
+ TYPE (container) :: c
+
+ c%s => sub
+ f => sub
+
+ CALL f(2,o=4)
+ CALL c%s(3,o=6)
+
+CONTAINS
+
+ SUBROUTINE sub(i,arg2,arg3)
+   INTEGER, INTENT(in) :: i
+   INTEGER, INTENT(in), OPTIONAL :: arg2, arg3
+   if (present(arg2)) call abort()
+   if (.not. present(arg3)) call abort()
+   if (2*i/=arg3) call abort()
+ END SUBROUTINE sub
+
+END PROGRAM prog
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_12.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_12.f90
new file mode 100644
index 000000000..5f26a782e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_12.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+!
+! PR 40646: [F03] array-valued procedure pointer components
+!
+! Original test case by Charlie Sharpsteen <chuck@sharpsteen.net>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+module bugTestMod
+  implicit none
+  type:: boundTest
+    procedure(returnMat), pointer, nopass:: test
+  end type boundTest
+contains
+  function returnMat( a, b ) result( mat )
+    integer:: a, b
+    double precision, dimension(a,b):: mat 
+    mat = 1d0
+  end function returnMat
+end module bugTestMod
+
+program bugTest
+  use bugTestMod
+  implicit none
+  type( boundTest ):: testObj
+  double precision, dimension(2,2):: testCatch
+  testObj%test => returnMat
+  testCatch = testObj%test(2,2)
+  print *,testCatch
+  if (sum(testCatch)/=4) call abort()
+  print *,testObj%test(3,3)
+  if (sum(testObj%test(3,3))/=9) call abort()
+end program bugTest
+
+! { dg-final { cleanup-modules "bugTestMod" } }
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90
new file mode 100644
index 000000000..afc8f55b5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+!
+! PR 40882: [F03] infinite recursion in gfc_get_derived_type with PPC returning derived type.
+! At the same time, check that a formal argument does not cause infinite recursion (PR 40870).
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+implicit none
+
+type :: t
+  integer :: data
+  procedure(foo), pointer, nopass :: ppc
+  procedure(type(t)), pointer, nopass :: ppc2
+end type
+
+type(t) :: o,o2
+
+o%data = 1
+o%ppc => foo
+
+o2 = o%ppc(o)
+
+if (o%data /= 1) call abort()
+if (o2%data /= 5) call abort()
+if (.not. associated(o%ppc)) call abort()
+if (associated(o2%ppc)) call abort()
+
+contains
+
+  function foo(arg)
+    type(t) :: foo, arg
+    foo%data = arg%data * 5
+    foo%ppc => NULL()
+  end function
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_14.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_14.f90
new file mode 100644
index 000000000..811223ee2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_14.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+!
+! PR 41022: [F03] procedure pointer components as actual arguments
+!
+! Contributed by Juergen Reuter <reuter@physik.uni-freiburg.de>
+
+program foo
+
+   type :: container_t
+      procedure(proc), nopass, pointer :: proc => null ()
+   end type container_t
+
+   type(container_t), target :: obj1
+   type(container_t) :: obj2
+
+   obj1%proc => proc
+   call transfer_proc_ptr (obj2, obj1)
+
+   if (obj2%proc()/=7) call abort()
+
+contains
+
+   subroutine transfer_proc_ptr (obj2, obj1)
+     type(container_t), intent(out) :: obj2
+     type(container_t), intent(in), target :: obj1
+     call assign_proc_ptr (obj2%proc, obj1)
+   end subroutine transfer_proc_ptr
+
+   subroutine assign_proc_ptr (ptr, obj1)
+     procedure(proc), pointer :: ptr
+     type(container_t), intent(in), target :: obj1
+     ptr => obj1%proc
+   end subroutine assign_proc_ptr
+
+   integer function proc ()
+      proc = 7
+   end function
+
+end program foo
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_15.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_15.f90
new file mode 100644
index 000000000..9f15d14db
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_15.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! PR 41106: [F03] Procedure Pointers with CHARACTER results
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+module m
+ type :: t
+ procedure(character(len=5)), pointer, nopass :: ptr
+ end type
+contains
+ function abc()
+  character(len=5) :: abc
+  abc = 'abcde'
+ end function abc
+end module m
+
+use m
+ type(t) :: x
+ character(len=5) :: str
+ x%ptr => abc
+ print *,x%ptr()
+ str = x%ptr()
+ if (str/='abcde') call abort()
+end
+
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_16.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_16.f90
new file mode 100644
index 000000000..e6b77a22f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_16.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+!
+! PR 41106: [F03] Procedure Pointers with CHARACTER results
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m
+ type :: t
+  procedure(abc), pointer, nopass :: ptr
+ end type
+contains
+ function abc(i)
+  integer :: i
+  character(len=i) :: abc
+  abc = 'abcde'
+ end function abc
+end module m
+
+use m
+ type(t) :: x
+ character(len=4) :: str
+ x%ptr => abc
+ print *,x%ptr(4)
+ if (x%ptr(4)/='abcd') call abort
+ str = x%ptr(3)
+ if (str/='abc') call abort()
+end
+
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_17.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_17.f90
new file mode 100644
index 000000000..cfe498b0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_17.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+!
+! PR 41106: [F03] Procedure Pointers with CHARACTER results
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m
+ type :: t
+ procedure(abc), pointer, nopass :: ptr
+ end type
+contains
+ function abc(arg)
+  character(len=5),pointer :: abc
+  character(len=5),target :: arg
+  abc => arg
+ end function abc
+end module m
+
+use m
+ type(t) :: x
+ character(len=5) :: str = 'abcde'
+ character(len=5), pointer :: strptr
+ x%ptr => abc
+ print *,x%ptr(str)
+ strptr => x%ptr(str)
+ if (strptr/='abcde') call abort()
+ str = 'fghij'
+ if (strptr/='fghij') call abort()
+end
+
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_18.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_18.f90
new file mode 100644
index 000000000..4b849b64e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_18.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! PR 41139: [4.5 Regression] a procedure pointer call as actual argument
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+PROGRAM test
+
+ type :: t
+   PROCEDURE(add), POINTER, nopass :: f
+ end type
+ type(t) :: o
+ logical :: g
+
+ o%f => add
+ g=greater(4.,o%f(1.,2.))
+ if (.not. g) call abort()
+
+CONTAINS
+
+ REAL FUNCTION add(x,y)
+   REAL, INTENT(in) :: x,y
+   add = x+y
+ END FUNCTION add
+
+ LOGICAL FUNCTION greater(x,y)
+   REAL, INTENT(in) :: x, y
+   print *,"greater:",x,y
+   greater = (x > y)
+ END FUNCTION greater
+
+END PROGRAM test
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_19.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_19.f90
new file mode 100644
index 000000000..8027c82d3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_19.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+!
+! PR 41139: [4.5 Regression] a procedure pointer call as actual argument
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+PROGRAM test
+
+ type :: t
+   PROCEDURE(three), POINTER, nopass :: f
+ end type
+ type(t) :: o
+ logical :: g
+
+ o%f => three
+ g=greater(4.,o%f())
+ if (.not. g) call abort()
+
+CONTAINS
+
+ REAL FUNCTION three()
+   three = 3.
+ END FUNCTION
+
+ LOGICAL FUNCTION greater(x,y)
+   REAL, INTENT(in) :: x, y
+   print *,"greater:",x,y
+   greater = (x > y)
+ END FUNCTION greater
+
+END PROGRAM test
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_2.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_2.f90
new file mode 100644
index 000000000..33e32aaf6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_2.f90
@@ -0,0 +1,58 @@
+! { dg-do run }
+!
+! PR39630: Fortran 2003: Procedure pointer components.
+!
+! Basic test for PPCs with FUNCTION interface and NOPASS.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+  type t

+    procedure(fcn), pointer, nopass :: ppc

+    procedure(abstr), pointer, nopass :: ppc1
+    integer :: i

+  end type

+

+  abstract interface

+    integer function abstr(x)

+      integer, intent(in) :: x

+    end function

+  end interface

+

+  type(t) :: obj

+  procedure(fcn), pointer :: f

+  integer :: base
+
+  intrinsic :: iabs

+

+! Check with interface from contained function

+  obj%ppc => fcn

+  base=obj%ppc(2)
+  if (base/=4) call abort

+  call foo (obj%ppc,3)

+

+! Check with abstract interface

+  obj%ppc1 => obj%ppc

+  base=obj%ppc1(4)
+  if (base/=8) call abort

+  call foo (obj%ppc1,5)

+

+! Check compatibility components with non-components  

+  f => obj%ppc

+  base=f(6)
+  if (base/=12) call abort

+  call foo (f,7)
+
+contains

+

+  integer function fcn(x)

+    integer, intent(in) :: x

+    fcn = 2 * x

+  end function

+
+  subroutine foo (arg, i)
+    procedure (fcn), pointer :: arg
+    integer :: i
+    if (arg(i)/=2*i) call abort
+  end subroutine
+

+end

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_20.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_20.f90
new file mode 100644
index 000000000..57660c7b7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_20.f90
@@ -0,0 +1,49 @@
+! { dg-do compile }
+!
+! PR 40869: [F03] PPC assignment checking
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+implicit none
+
+interface func
+  procedure f1,f2 ! { dg-error "Ambiguous interfaces" }
+end interface
+
+interface operator(.op.)
+  procedure f1,f2 ! { dg-error "Ambiguous interfaces" }
+end interface
+
+type :: t1
+  procedure(integer), pointer, nopass :: ppc
+end type
+
+type :: t2
+  procedure(real), pointer, nopass :: ppc
+end type
+
+type(t1) :: o1
+type(t2) :: o2
+procedure(logical),pointer :: pp1
+procedure(complex),pointer :: pp2
+
+pp1 => pp2        ! { dg-error "Type/kind mismatch" }
+pp2 => o2%ppc     ! { dg-error "Type/kind mismatch" }
+
+o1%ppc => pp1     ! { dg-error "Type/kind mismatch" }
+o1%ppc => o2%ppc  ! { dg-error "Type/kind mismatch" }
+
+contains
+
+  real function f1(a,b) ! { dg-warning "Extension: Internal procedure" }
+    real,intent(in) :: a,b
+    f1 = a + b
+  end function
+
+  integer function f2(a,b) ! { dg-warning "Extension: Internal procedure" }
+    real,intent(in) :: a,b
+    f2 = a - b
+  end function
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_21.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_21.f90
new file mode 100644
index 000000000..a21916bc8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_21.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR 41242: [4.5 Regression] PPC call rejected (related to user-defined assignment?)
+!
+! Original test case by Juergen Reuter <reuter@physik.uni-freiburg.de>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+  type :: nf_t
+     procedure(integer), nopass, pointer :: get_n_in
+  end type
+
+  interface assignment(=)
+     procedure op_assign
+  end interface
+
+  type(nf_t) :: prc_lib
+  prc_lib = "foobar"
+  print *, prc_lib%get_n_in()
+
+contains
+
+  elemental subroutine op_assign (str, ch) ! { dg-warning "Extension: Internal procedure" }
+    type(nf_t), intent(out) :: str
+    character(len=*), intent(in) :: ch
+  end subroutine
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_22.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_22.f90
new file mode 100644
index 000000000..b82564ff4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_22.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+!
+! PR 41978: [F03] ICE in gfc_conv_expr_descriptor for array PPC assignment
+!
+! Contributed by Daniel Kraft <domob@gcc.gnu.org>
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE t
+    PROCEDURE(myproc), POINTER, PASS :: myproc
+  END TYPE t
+
+CONTAINS
+
+  INTEGER FUNCTION myproc (me)
+    CLASS(t), INTENT(IN) :: me
+    myproc = 42
+  END FUNCTION myproc
+
+END MODULE m
+
+PROGRAM main
+  USE m
+  IMPLICIT NONE
+
+  TYPE(t) :: arr(2)
+  arr%myproc => myproc  ! { dg-error "must not have the POINTER attribute" }
+END PROGRAM main
+ 
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_23.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_23.f90
new file mode 100644
index 000000000..8b1c6912d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_23.f90
@@ -0,0 +1,73 @@
+! { dg-do run }
+! Tests the fix for PR42104 in which the call to the procedure pointer
+! component caused an ICE because the "always_implicit flag was not used
+! to force the passing of a descriptor for the array argument.
+!
+! Contributed by Martien Hulsen <m.a.hulsen@tue.nl>
+!
+module poisson_functions_m
+
+  implicit none
+
+contains
+ 
+  function func ( nr, x )
+    integer, intent(in) :: nr
+    real, intent(in), dimension(:) :: x
+    real :: func
+
+    real :: pi 
+
+    pi = 4 * atan(1.)
+
+    select case(nr)
+      case(1)
+        func = 0
+      case(2)
+        func = 1
+      case(3)
+        func = 1 + cos(pi*x(1))*cos(pi*x(2))
+      case default
+        write(*,'(/a,i0/)') 'Error func: wrong function number: ', nr
+        stop
+    end select
+
+  end function func 
+
+end module poisson_functions_m
+ 
+module element_defs_m
+
+  implicit none
+
+  abstract interface 
+    function dummyfunc ( nr, x )
+      integer, intent(in) :: nr
+      real, intent(in), dimension(:) :: x
+      real :: dummyfunc
+    end function dummyfunc
+  end interface 
+
+  type function_p
+    procedure(dummyfunc), nopass, pointer :: p => null()
+  end type function_p
+
+end module element_defs_m
+
+program t
+
+use poisson_functions_m
+use element_defs_m
+
+procedure(dummyfunc), pointer :: p => null()
+type(function_p) :: funcp
+
+p => func
+funcp%p => func
+
+print *, func(nr=3,x=(/0.1,0.1/))
+print *, p(nr=3,x=(/0.1,0.1/))
+print *, funcp%p(nr=3,x=(/0.1,0.1/))
+
+end program t
+! { dg-final { cleanup-modules "poisson_functions_m element_defs_m" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_24.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_24.f90
new file mode 100644
index 000000000..8c935c9ea
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_24.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+!
+! PR42045: [F03] passing a procedure pointer component to a procedure pointer dummy
+!
+! Contributed by John McFarland <john.mcfarland@swri.org>
+
+PROGRAM prog
+ TYPE object
+  PROCEDURE(), POINTER, NOPASS :: f
+ END TYPE object
+ TYPE container
+  TYPE (object), POINTER :: o(:)
+ END TYPE container
+ TYPE (container) :: c
+ TYPE (object) :: o1, o2
+ PROCEDURE(), POINTER :: f => NULL()
+ o1%f => f
+ CALL set_func(o2,f)
+ CALL set_func(o2,o1%f)
+ ALLOCATE( c%o(5) )
+ c%o(5)%f => f
+ CALL set_func(o2,c%o(5)%f)
+CONTAINS
+ SUBROUTINE set_func(o,f)
+  TYPE (object) :: o
+  PROCEDURE(), POINTER :: f
+  o%f => f
+ END SUBROUTINE set_func
+END PROGRAM prog
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_25.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_25.f90
new file mode 100644
index 000000000..683552629
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_25.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+! PR 46060: [F03] procedure pointer component referenced without argument list
+!
+! Contributed by Stephen J. Bespalko <sjbespa@comcast.net>
+
+implicit none
+
+abstract interface
+  function name_func (ivar) result (res)
+    integer, intent(in) :: ivar
+    character(len=8) :: res
+  end function name_func
+end interface
+
+type var_type
+  procedure(name_func), nopass, pointer :: name
+end type var_type
+
+type(var_type) :: vars
+character(len=8) name
+
+name = vars%name   ! { dg-error "requires an argument list" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_26.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_26.f90
new file mode 100644
index 000000000..0b97e09e0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_26.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+!
+! PR 46841: [F03] ICE on allocating array of procedure pointers
+!
+! Contributed by Martien Hulsen <m.a.hulsen@tue.nl>
+
+  type vfunc_p
+    procedure (dum_vfunc), pointer, nopass :: p => null()
+  end type vfunc_p
+
+  type(vfunc_p), allocatable, dimension(:) :: vfunc1 
+
+  allocate(vfunc1(10))
+
+contains
+
+  function dum_vfunc ()
+    real, dimension(2) :: dum_vfunc
+    dum_vfunc = 0
+  end function dum_vfunc
+
+end 
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_27.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_27.f90
new file mode 100644
index 000000000..d966648fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_27.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+!
+! PR 46201: [F03] ICE on procedure pointer component call
+!
+! Contributed by Stephen J. Bespalko <sjbespa@comcast.net>
+
+type t
+  procedure(character), nopass, pointer :: ppc
+end type
+type(t),dimension(1) :: v
+print *,v(1)%ppc()
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_28.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_28.f90
new file mode 100644
index 000000000..8d46fb5fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_28.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! PR 47224: [F03] ICE with procedure pointer component
+!
+! Contributed by Martien Hulsen <m.a.hulsen@tue.nl>
+
+  type coefficients_t
+    procedure (real), pointer, nopass :: vfunc
+  end type
+
+  type(coefficients_t) :: coeff
+  real, dimension(3) :: x
+
+  print *, abs ( coeff%vfunc ( x(:) ) )
+
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_29.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_29.f90
new file mode 100644
index 000000000..94c59cd1a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_29.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+!
+! PR 47240: [F03] segfault with procedure pointer component
+!
+! Contributed by Martien Hulsen <m.a.hulsen@tue.nl>
+
+  type t
+    procedure (fun), pointer, nopass :: p
+  end type
+  type(t) :: x
+  real, dimension(2) :: r
+  x%p => fun
+  r = evaluate (x%p)
+  if (r(1) /= 5 .and. r(2) /= 6) call abort()
+contains
+  function fun ()
+    real, dimension(2) :: fun
+    fun = (/ 5, 6 /)
+  end function
+  function evaluate ( dummy )
+    real, dimension(2) :: evaluate
+    procedure(fun) :: dummy
+    evaluate = dummy ()
+  end function
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_3.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_3.f90
new file mode 100644
index 000000000..67d5b5360
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_3.f90
@@ -0,0 +1,50 @@
+! { dg-do compile }
+!
+! PR39630: Fortran 2003: Procedure pointer components.
+!
+! Probing some error messages.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+implicit none
+
+interface
+ subroutine sub
+ end subroutine
+end interface
+
+external :: aaargh
+
+type :: t
+  procedure(), pointer, nopass :: ptr1
+  procedure(real), pointer, nopass :: ptr2
+  procedure(sub), pointer, nopass :: ptr3
+  procedure(), pointer, nopass ptr4              ! { dg-error "Expected '::'" }
+  procedure(), pointer, nopass, pointer :: ptr5  ! { dg-error "Duplicate" }
+  procedure, pointer, nopass :: ptr6             ! { dg-error "Syntax error" }
+  procedure(), nopass :: ptr8                    ! { dg-error "POINTER attribute is required" }
+  procedure(pp), pointer, nopass :: ptr9         ! { dg-error "declared in a later PROCEDURE statement" }
+  procedure(aaargh), pointer, nopass :: ptr10    ! { dg-error "must be explicit" }
+  real :: y
+end type t
+
+type,bind(c) :: bct                   ! { dg-error "BIND.C. derived type" }
+  procedure(), pointer,nopass :: ptr  ! { dg-error "cannot be a member of|may not be C interoperable" }
+end type bct
+
+procedure(sub), pointer :: pp
+
+type(t) :: x
+
+x%ptr2 => x       ! { dg-error "Invalid procedure pointer assignment" }
+
+x => x%ptr2       ! { dg-error "Non-POINTER in pointer association context" }
+
+print *, x%ptr1() ! { dg-error "attribute conflicts with" }
+call x%ptr2()     ! { dg-error "attribute conflicts with" }
+print *,x%ptr3()  ! { dg-error "attribute conflicts with" }
+
+call x%y          ! { dg-error "Expected type-bound procedure or procedure pointer component" }
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_30.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_30.f90
new file mode 100644
index 000000000..afcc4c73f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_30.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+! PR 47768: ICE: printing a derived-type variable with proc-pointer components
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+type :: t
+  integer :: i = 3
+  procedure(type(t)), pointer, nopass :: ppc
+end type 
+
+type(t) :: x
+
+print *,x  ! { dg-error "cannot have procedure pointer components" }
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_31.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_31.f90
new file mode 100644
index 000000000..6a5d8c967
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_31.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+!
+! PR 47768: printing a derived-type variable with proc-pointer components
+!
+! Contributed by Arjen Markus <arjen.markus895@gmail.com>
+
+module proc_pointers
+  implicit none
+  type :: rectangle
+    real :: width, height
+    procedure(real), pointer, nopass :: get_special_area
+  end type
+end module
+
+program test_objects
+  use proc_pointers
+  implicit none
+  type(rectangle) :: rect
+  write(*,*) rect          ! { dg-error "cannot have procedure pointer components" }
+end program
+
+! { dg-final { cleanup-modules "proc_pointers" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_37.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_37.f90
new file mode 100644
index 000000000..9695b9606
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_37.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+! PR 56385: [4.6/4.7/4.8 Regression] [OOP] ICE with allocatable function result in a procedure-pointer component
+!
+! Contributed by Vladimir Fuka <vladimir.fuka@gmail.com>
+
+  implicit none
+  
+  type :: TGeometricShape
+  end type
+
+  type :: TVolumeSourceBody
+    class(TGeometricShape), allocatable :: GeometricShape
+    procedure(scalar_flux_interface), pointer :: get_scalar_flux
+  end type
+
+  abstract interface
+    function scalar_flux_interface(self) result(res)
+      import
+      real, allocatable :: res(:)
+      class(TVolumeSourceBody), intent(in) :: self
+    end function
+  end interface
+
+end
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_4.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_4.f90
new file mode 100644
index 000000000..b904a2f86
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_4.f90
@@ -0,0 +1,120 @@
+! { dg-do compile }
+!
+! PR39630: Fortran 2003: Procedure pointer components.
+!
+! Original code by Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
+!
+! Adapted by Janus Weil <janus@gcc.gnu.org>
+
+
+! Test for infinte recursion in trans-types.c when a PPC interface
+! refers to the original type.
+
+module expressions
+
+  type :: eval_node_t
+     logical, pointer :: lval => null ()
+     type(eval_node_t), pointer :: arg1 => null ()
+     procedure(unary_log), nopass, pointer :: op1_log  => null ()
+  end type eval_node_t
+
+  abstract interface
+     logical function unary_log (arg)
+       import eval_node_t
+       type(eval_node_t), intent(in) :: arg
+     end function unary_log
+  end interface
+
+contains
+
+  subroutine eval_node_set_op1_log (en, op)
+    type(eval_node_t), intent(inout) :: en
+    procedure(unary_log) :: op
+    en%op1_log => op
+  end subroutine eval_node_set_op1_log
+
+  subroutine eval_node_evaluate (en)
+    type(eval_node_t), intent(inout) :: en
+    en%lval = en%op1_log  (en%arg1)
+  end subroutine
+
+end module
+
+
+! Test for C_F_PROCPOINTER and pointers to derived types
+
+module process_libraries
+
+  implicit none
+
+  type :: process_library_t
+     procedure(), nopass, pointer :: write_list
+  end type process_library_t
+
+contains
+
+  subroutine process_library_load (prc_lib)
+    use iso_c_binding 
+    type(process_library_t) :: prc_lib
+    type(c_funptr) :: c_fptr
+    call c_f_procpointer (c_fptr, prc_lib%write_list)
+  end subroutine process_library_load
+
+  subroutine process_libraries_test ()
+    type(process_library_t), pointer :: prc_lib
+    call prc_lib%write_list ()
+  end subroutine process_libraries_test
+
+end module process_libraries
+
+
+! Test for argument resolution
+
+module hard_interactions
+
+  implicit none
+
+  type :: hard_interaction_t
+     procedure(), nopass, pointer :: new_event
+  end type hard_interaction_t
+
+  interface afv
+     module procedure afv_1
+  end interface
+
+contains
+
+  function afv_1 () result (a)
+    real, dimension(0:3) :: a
+  end function
+
+  subroutine hard_interaction_evaluate (hi)
+    type(hard_interaction_t) :: hi
+    call hi%new_event (afv ())
+  end subroutine
+
+end module hard_interactions
+
+
+! Test for derived types with PPC working properly as function result.
+
+  implicit none
+
+  type :: var_entry_t
+    procedure(), nopass, pointer :: obs1_int
+  end type var_entry_t
+  
+  type(var_entry_t), pointer :: var
+
+  var => var_list_get_var_ptr ()
+
+contains
+
+  function var_list_get_var_ptr ()
+    type(var_entry_t), pointer :: var_list_get_var_ptr
+  end function var_list_get_var_ptr
+
+end
+
+! { dg-final { cleanup-modules "expressions process_libraries hard_interactions" } }
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_5.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_5.f90
new file mode 100644
index 000000000..216cb4e9b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_5.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+!
+! PR39630: Fortran 2003: Procedure pointer components.
+!
+! Nested types / double component references.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+abstract interface
+  subroutine as
+  end subroutine
+  integer function af()
+  end function
+end interface
+
+type :: t1
+  procedure(as), pointer, nopass :: s
+  procedure(af), pointer, nopass :: f
+end type
+
+type :: t2
+  type(t1) :: c
+end type
+
+type(t2) :: x
+integer :: j = 0
+
+x%c%s => is
+call x%c%s
+if (j/=5) call abort
+
+x%c%f => if
+j=x%c%f()
+if (j/=42) call abort
+
+contains
+
+subroutine is
+  j = 5
+end subroutine
+
+integer function if()
+  if = 42
+end function
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_6.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_6.f90
new file mode 100644
index 000000000..f0dcf4ccf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_6.f90
@@ -0,0 +1,64 @@
+! { dg-do run }
+!
+! PR39630: Fortran 2003: Procedure pointer components.
+!
+! test case taken from:
+! http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/4a827e8ced6efb0f/884b9eca6d7e6742?#884b9eca6d7e6742
+! http://fortranwiki.org/fortran/show/proc_component_example
+
+module proc_component_example
+
+  type t
+    real :: a
+    procedure(print_int), pointer, &
+                          nopass :: proc
+  end type t
+
+  abstract interface
+    subroutine print_int (arg, lun)
+      import
+      type(t), intent(in) :: arg
+      integer, intent(in) :: lun
+    end subroutine print_int
+  end interface
+
+  integer :: calls = 0
+
+contains
+
+  subroutine print_me (arg, lun)
+    type(t), intent(in) :: arg
+    integer, intent(in) :: lun
+    write (lun,*) arg%a
+    calls = calls + 1
+  end subroutine print_me
+
+  subroutine print_my_square (arg, lun)
+    type(t), intent(in) :: arg
+    integer, intent(in) :: lun
+    write (lun,*) arg%a**2
+    calls = calls + 1
+  end subroutine print_my_square
+
+end module proc_component_example
+
+program main
+
+    use proc_component_example
+    use iso_fortran_env, only : output_unit
+
+    type(t) :: x
+
+    x%a = 2.71828
+
+    x%proc => print_me
+    call x%proc(x, output_unit)
+    x%proc => print_my_square
+    call x%proc(x, output_unit)
+
+    if (calls/=2) call abort
+
+end program main 
+
+! { dg-final { cleanup-modules "proc_component_example" } }
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_7.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_7.f90
new file mode 100644
index 000000000..860c2dd9b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_7.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+!
+! PR 40089: Public type with public component which has a private type
+!
+! Original test case by Juergen Reuter <reuter@physik.uni-freiburg.de>
+! Adapted by Janus Weil <janus@gcc.gnu.org>
+
+module m
+
+  implicit none
+  private
+
+  public :: public_t
+
+  type :: private_t
+    integer :: i
+  end type
+
+  type :: public_t
+     type(private_t), pointer :: public_comp_with_private_type
+     procedure(ifc) , nopass, pointer :: ppc
+  end type
+
+  abstract interface
+     integer function ifc ()
+     end function
+  end interface
+
+end module m
+
+program test
+use m
+implicit none
+type(public_t) :: x
+integer :: j
+j = x%ppc()
+end
+
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_8.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_8.f90
new file mode 100644
index 000000000..ed06c2bc6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_8.f90
@@ -0,0 +1,58 @@
+! { dg-do run }
+!
+! PR 40164: Fortran 2003: "Arrays of procedure pointers" (using PPCs)
+!
+! Original test case by Barron Bichon <barron.bichon@swri.org>
+! Adapted by Janus Weil <janus@gcc.gnu.org>
+
+PROGRAM test_prog
+
+  ABSTRACT INTERFACE
+  FUNCTION fn_template(n,x) RESULT(y)
+    INTEGER, INTENT(in) :: n
+    REAL, INTENT(in) :: x(n)
+    REAL :: y(n)
+  END FUNCTION fn_template
+  END INTERFACE
+
+  TYPE PPA
+    PROCEDURE(fn_template), POINTER, NOPASS :: f
+  END TYPE PPA
+
+ TYPE ProcPointerArray
+   PROCEDURE(add), POINTER, NOPASS :: f
+ END TYPE ProcPointerArray
+
+ TYPE (ProcPointerArray) :: f_array(3)
+ PROCEDURE(add), POINTER :: f
+ real :: r
+
+ f_array(1)%f => add
+ f => f_array(1)%f
+ f_array(2)%f => sub
+ f_array(3)%f => f_array(1)%f
+
+ r = f(1.,2.)
+ if (abs(r-3.)>1E-3) call abort()
+ r = f_array(1)%f(4.,2.)
+ if (abs(r-6.)>1E-3) call abort()
+ r = f_array(2)%f(5.,3.)
+ if (abs(r-2.)>1E-3) call abort()
+ if (abs(f_array(1)%f(1.,3.)-f_array(3)%f(2.,2.))>1E-3) call abort()
+
+CONTAINS
+
+ FUNCTION add(a,b) RESULT(sum)
+   REAL, INTENT(in) :: a, b
+   REAL :: sum
+   sum = a + b
+ END FUNCTION add
+
+ FUNCTION sub(a,b) RESULT(diff)
+   REAL, INTENT(in) :: a, b
+   REAL :: diff
+   diff = a - b
+ END FUNCTION sub
+
+END PROGRAM test_prog
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_9.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_9.f90
new file mode 100644
index 000000000..951db485f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_9.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+!
+! PR 40176:  Fortran 2003: Procedure pointers with array return value
+!
+! Original test case by Barron Bichon <barron.bichon@swri.org>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+PROGRAM test_prog
+
+ TYPE ProcPointerType
+   PROCEDURE(triple), POINTER, NOPASS :: f
+ END TYPE ProcPointerType
+
+ TYPE (ProcPointerType) :: ppt
+ PROCEDURE(triple), POINTER :: f
+ REAL :: tres(2)
+
+ ppt%f => triple
+ f => ppt%f
+ tres = f(2,[2.,4.])
+ if (abs(tres(1)-6.)>1E-3) call abort()
+ if (abs(tres(2)-12.)>1E-3) call abort()
+ tres = ppt%f(2,[3.,5.])
+ if (abs(tres(1)-9.)>1E-3) call abort()
+ if (abs(tres(2)-15.)>1E-3) call abort()
+
+CONTAINS
+
+ FUNCTION triple(n,x) RESULT(tre)
+   INTEGER, INTENT(in) :: n
+   REAL, INTENT(in) :: x(2)
+   REAL :: tre(2)
+   tre = 3.*x
+ END FUNCTION triple
+
+END PROGRAM test_prog
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_1.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_1.f90
new file mode 100644
index 000000000..4513083ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_1.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+!
+! PR 39630: [F03] Procedure Pointer Components with PASS
+!
+! found at http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/4a827e8ced6efb0f/884b9eca6d7e6742
+
+module mymod
+
+    type :: mytype
+        integer :: i
+        procedure(set_int_value), pointer :: seti
+    end type
+
+    abstract interface
+        subroutine set_int_value(this,i)
+            import
+            class(mytype), intent(inout) :: this
+            integer, intent(in) :: i
+        end subroutine set_int_value
+    end interface
+
+    contains
+
+    subroutine seti_proc(this,i)
+        class(mytype), intent(inout) :: this
+        integer, intent(in) :: i
+        this%i=i
+    end subroutine seti_proc
+
+end module mymod
+
+program Test_03
+    use mymod
+    implicit none
+
+    type(mytype) :: m
+
+    m%i = 44
+    m%seti => seti_proc
+
+    call m%seti(6)
+
+    if (m%i/=6) call abort()
+
+end program Test_03
+
+! { dg-final { cleanup-modules "mymod" } }
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_2.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_2.f90
new file mode 100644
index 000000000..03770ce3f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_2.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+!
+! PR 39630: [F03] Procedure Pointer Components with PASS
+!
+! taken from "The Fortran 2003 Handbook" (Adams et al., 2009)
+
+module passed_object_example
+
+  type t
+    real :: a
+    procedure(print_me), pointer, pass(arg) :: proc
+  end type t
+
+contains
+
+  subroutine print_me (arg, lun)
+    class(t), intent(in) :: arg
+    integer, intent(in) :: lun
+    if (abs(arg%a-2.718)>1E-6) call abort()
+    write (lun,*) arg%a
+  end subroutine print_me
+
+  subroutine print_my_square (arg, lun)
+    class(t), intent(in) :: arg
+    integer, intent(in) :: lun
+    if (abs(arg%a-2.718)>1E-6) call abort()
+    write (lun,*) arg%a**2
+  end subroutine print_my_square
+
+end module passed_object_example
+
+
+program main
+  use passed_object_example
+  use iso_fortran_env, only: output_unit
+
+  type(t) :: x
+
+  x%a = 2.718
+  x%proc => print_me
+  call x%proc (output_unit)
+  x%proc => print_my_square
+  call x%proc (output_unit)
+
+end program main
+
+! { dg-final { cleanup-modules "passed_object_example" } }
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_3.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_3.f90
new file mode 100644
index 000000000..add025cb0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_3.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+!
+! PR 39630: [F03] Procedure Pointer Components with PASS
+!
+! taken from "Fortran 95/2003 explained" (Metcalf, Reid, Cohen, 2004)
+
+type t
+  procedure(obp), pointer, pass(x) :: p
+  character(100) :: name
+end type
+
+abstract interface
+  subroutine obp(w,x)
+    import :: t
+    integer :: w
+    class(t) :: x
+  end subroutine
+end interface
+
+type(t) :: a
+a%p => my_obp_sub
+a%name = "doodoo"
+
+call a%p(32)
+
+contains
+
+  subroutine my_obp_sub(w,x)
+    integer :: w
+    class(t) :: x
+    if (x%name/="doodoo") call abort()
+    if (w/=32) call abort()
+  end subroutine
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90
new file mode 100644
index 000000000..0a28b5340
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90
@@ -0,0 +1,75 @@
+! { dg-do compile }
+!
+! PR 39630: [F03] Procedure Pointer Components with PASS
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m
+
+ type :: t0
+  procedure() :: p0  ! { dg-error "POINTER attribute is required for procedure pointer component" }
+ end type
+
+ type :: t1
+  integer :: i
+  procedure(foo1), pointer :: f1  ! { dg-error "must be scalar" }
+ end type
+
+ type :: t2
+  integer :: i
+  procedure(foo2), pointer :: f2  ! { dg-error "may not have the POINTER attribute" }
+ end type
+
+ type :: t3
+  integer :: i
+  procedure(foo3), pointer :: f3  ! { dg-error "may not be ALLOCATABLE" }
+ end type
+
+ type :: t4
+   procedure(),     pass(x), pointer :: f4  ! { dg-error "NOPASS or explicit interface required" }
+   procedure(real), pass(y), pointer :: f5  ! { dg-error "NOPASS or explicit interface required" }
+   procedure(foo6), pass(c), pointer :: f6  ! { dg-error "has no argument" }
+ end type
+
+ type :: t7
+   procedure(foo7), pass, pointer :: f7  ! { dg-error "must have at least one argument" }
+ end type
+
+ type :: t8
+   procedure(foo8), pass, pointer :: f8  ! { dg-error "must be of the derived type" }
+ end type
+
+contains
+
+ subroutine foo1 (x1,y1)
+  type(t1) :: x1(:)
+  type(t1) :: y1
+ end subroutine
+
+ subroutine foo2 (x2,y2)
+  type(t2),pointer :: x2
+  type(t2) :: y2
+ end subroutine
+
+ subroutine foo3 (x3,y3)
+  type(t3),allocatable :: x3
+  type(t3) :: y3
+ end subroutine
+
+ real function foo6 (a,b)
+   real :: a,b
+   foo6 = 1.
+ end function
+
+ integer function foo7 ()
+   foo7 = 2
+ end function
+
+ character function foo8 (i)
+   integer :: i
+ end function
+
+end module m
+
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_5.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_5.f90
new file mode 100644
index 000000000..216a554f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_5.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+!
+! PR 39630: [F03] Procedure Pointer Components with PASS
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+module m
+ type :: t
+  sequence
+  integer :: i
+  procedure(foo), pointer,pass(y) :: foo
+ end type t
+contains
+ subroutine foo(x,y)
+  type(t),optional :: x
+  type(t) :: y
+  if(present(x)) then
+    print *, 'foo', x%i, y%i
+    if (mod(x%i+y%i,3)/=2) call abort()
+  else
+    print *, 'foo', y%i
+    if (mod(y%i,3)/=1) call abort()
+  end if
+ end subroutine foo
+end module m
+
+use m
+type(t) :: t1, t2
+t1%i = 4
+t2%i = 7
+t1%foo => foo
+t2%foo => t1%foo
+call t1%foo()
+call t2%foo()
+call t2%foo(t1)
+end
+
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_6.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_6.f90
new file mode 100644
index 000000000..8898a597d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_6.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-options "-fcheck=bounds" }
+!
+! PR 42804: ICE with -fcheck=bounds and type bound procedure call on array element
+!
+! Contributed by Ian Harvey <ian_harvey@bigpond.com>
+
+MODULE ModA
+  IMPLICIT NONE
+  TYPE, PUBLIC :: A
+    PROCEDURE(a_proc),pointer :: Proc
+  END TYPE A
+CONTAINS
+  SUBROUTINE a_proc(this, stat)
+    CLASS(A), INTENT(INOUT) :: this
+    INTEGER, INTENT(OUT) :: stat
+    WRITE (*, *) 'a_proc'
+    stat = 0
+  END SUBROUTINE a_proc
+END MODULE ModA
+
+PROGRAM ProgA
+  USE ModA
+  IMPLICIT NONE
+  INTEGER :: ierr
+  INTEGER :: i
+  TYPE(A), ALLOCATABLE :: arr(:)
+  ALLOCATE(arr(2))
+  DO i = 1, 2
+    arr(i)%proc => a_proc
+    CALL arr(i)%Proc(ierr)
+  END DO
+END PROGRAM ProgA
+
+! { dg-final { cleanup-modules "ModA" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_7.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_7.f90
new file mode 100644
index 000000000..a15018db3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_7.f90
@@ -0,0 +1,65 @@
+! { dg-do compile }
+!
+! PR 46662: [OOP] gfortran accepts "CALL polymorphic%abstract_type%ppc()"
+!
+! Contributed by Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
+! cf. http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/a0857fa4a692d518
+
+module types
+  implicit none
+
+  type, abstract :: base_t
+     integer :: i = 0
+     procedure(base_write_i), pointer :: write_procptr
+   contains
+     procedure :: write_i => base_write_i
+  end type base_t
+
+  type, extends (base_t) :: t
+  end type t
+
+contains
+
+  subroutine base_write_i (obj)
+    class (base_t), intent(in) :: obj
+    print *, obj%i
+  end subroutine base_write_i
+
+end module types
+
+
+program main
+  use types
+  implicit none
+
+  type(t) :: obj
+
+  print *, "Direct printing"
+  obj%i = 1
+  print *, obj%i
+
+  print *, "Direct printing via parent"
+  obj%base_t%i = 2
+  print *, obj%base_t%i
+
+  print *, "Printing via TBP"
+  obj%i = 3
+  call obj%write_i
+
+  print *, "Printing via parent TBP"
+  obj%base_t%i = 4
+  call obj%base_t%write_i      ! { dg-error "is of ABSTRACT type" }
+
+  print *, "Printing via OBP"
+  obj%i = 5
+  obj%write_procptr => base_write_i
+  call obj%write_procptr
+
+  print *, "Printing via parent OBP"
+  obj%base_t%i = 6
+  obj%base_t%write_procptr => base_write_i
+  call obj%base_t%write_procptr               ! { dg-error "is of ABSTRACT type" }
+
+end program main
+
+! { dg-final { cleanup-modules "types" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_result_1.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_result_1.f90
new file mode 100644
index 000000000..df830d3b1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_result_1.f90
@@ -0,0 +1,183 @@
+! { dg-do run }
+!
+! PR 36704: Procedure pointer as function result
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module mo
+contains
+
+  function j()
+    implicit none
+    procedure(integer),pointer :: j
+    intrinsic iabs
+    j => iabs
+  end function
+
+  subroutine sub(y)
+    integer,intent(inout) :: y
+    y = y**2
+  end subroutine
+
+end module
+
+
+program proc_ptr_14
+use mo
+implicit none
+intrinsic :: iabs
+integer :: x
+procedure(integer),pointer :: p,p2
+procedure(sub),pointer :: ps
+
+p => a()
+if (p(-1)/=1) call abort()
+p => b()
+if (p(-2)/=2) call abort()
+p => c()
+if (p(-3)/=3) call abort()
+
+ps => d()
+x = 4
+call ps(x)
+if (x/=16) call abort()
+
+p => dd()
+if (p(-4)/=4) call abort()
+
+ps => e(sub)
+x = 5
+call ps(x)
+if (x/=25) call abort()
+
+p => ee()
+if (p(-5)/=5) call abort()
+p => f()
+if (p(-6)/=6) call abort()
+p => g()
+if (p(-7)/=7) call abort()
+
+ps => h(sub)
+x = 2
+call ps(x)
+if (x/=4) call abort()
+
+p => i()
+if (p(-8)/=8) call abort()
+p => j()
+if (p(-9)/=9) call abort()
+
+p => k(p2)
+if (p(-10)/=p2(-10)) call abort()
+
+p => l()
+if (p(-11)/=11) call abort()
+
+contains
+
+  function a()
+    procedure(integer),pointer :: a
+    a => iabs
+  end function
+
+  function b()
+    procedure(integer) :: b
+    pointer :: b
+    b => iabs
+  end function
+
+  function c()
+    pointer :: c
+    procedure(integer) :: c
+    c => iabs
+  end function
+
+  function d()
+    pointer :: d
+    external d
+    d => sub
+  end function
+
+  function dd()
+    pointer :: dd
+    external :: dd
+    integer :: dd
+    dd => iabs
+  end function
+
+  function e(arg)
+    external :: e,arg
+    pointer :: e
+    e => arg
+  end function
+
+  function ee()
+    integer :: ee
+    external :: ee
+    pointer :: ee
+    ee => iabs
+  end function
+
+  function f()
+    pointer :: f
+    interface
+      integer function f(x)
+        integer,intent(in) :: x
+      end function
+    end interface
+    f => iabs
+  end function
+
+  function g()
+    interface
+      integer function g(x)
+        integer,intent(in) :: x
+      end function g
+    end interface
+    pointer :: g
+    g => iabs
+  end function
+
+  function h(arg)
+    interface
+      subroutine arg(b)
+        integer,intent(inout) :: b
+      end subroutine arg
+    end interface
+    pointer :: h
+    interface
+      subroutine h(a)
+        integer,intent(inout) :: a
+      end subroutine h
+    end interface
+    h => arg
+  end function
+
+  function i()
+    pointer :: i
+    interface
+      function i(x)
+        integer :: i,x
+        intent(in) :: x
+      end function i
+    end interface
+    i => iabs
+  end function
+
+  function k(arg)
+    procedure(integer),pointer :: k,arg
+    k => iabs
+    arg => k
+  end function
+
+  function l()
+    procedure(iabs),pointer :: l
+    integer :: i
+    l => iabs
+    if (l(-11)/=11) call abort()
+  end function 
+
+end
+
+! { dg-final { cleanup-modules "mo" } }
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_result_2.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_result_2.f90
new file mode 100644
index 000000000..362a1f7f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_result_2.f90
@@ -0,0 +1,62 @@
+! { dg-do compile }
+!
+! PR 36704: Procedure pointer as function result
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module proc_ptr_15
+
+  interface
+    function e(x)
+      real :: x
+      procedure(), pointer :: e
+    end function e
+  end interface
+
+  interface
+    function f(x)
+      real :: x
+      external :: f
+      pointer :: f
+    end function
+  end interface
+
+  interface
+    function g(x)
+      real :: x
+      pointer :: g
+      external :: g
+    end function
+  end interface
+
+contains
+
+  subroutine point_fun()
+    call set_fun(aux)
+  end subroutine
+
+  subroutine set_fun(y)
+    external :: y
+  end subroutine
+
+  function aux()
+    external aux
+    pointer aux
+    intrinsic sin
+    aux => sin
+  end function
+
+  function foo(x)
+    real :: x
+    interface
+      subroutine foo(i)  ! { dg-error "attribute conflicts with" }
+        integer :: i
+      end subroutine
+    end interface
+    !pointer :: foo
+  end function
+
+end
+
+! { dg-final { cleanup-modules "proc_ptr_15" } }
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_result_3.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_result_3.f90
new file mode 100644
index 000000000..a84ff2420
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_result_3.f90
@@ -0,0 +1,56 @@
+!{ dg-do run }
+!
+! PR 36704: Procedure pointer as function result
+!
+! Original test case from James Van Buskirk.
+!
+! Adapted by Janus Weil <janus@gcc.gnu.org>
+
+module store_subroutine
+   implicit none
+
+   abstract interface
+      subroutine sub(i)
+        integer, intent(inout) :: i
+      end subroutine sub
+   end interface
+
+   procedure(sub), pointer, private :: psub => NULL()
+
+contains
+
+   subroutine set_sub(x)
+      procedure(sub) x
+      psub => x
+   end subroutine set_sub
+
+   function get_sub()
+      procedure(sub), pointer :: get_sub
+      get_sub => psub
+   end function get_sub
+
+end module store_subroutine
+
+program test
+   use store_subroutine
+   implicit none
+   procedure(sub), pointer :: qsub
+   integer :: k = 1
+
+   call my_sub(k)
+   if (k/=3) call abort
+   qsub => get_sub()
+   call qsub(k)
+   if (k/=9) call abort
+end program test
+
+recursive subroutine my_sub(j)
+   use store_subroutine
+   implicit none
+   integer, intent(inout) :: j
+   j = j*3
+   call set_sub(my_sub)
+end subroutine my_sub
+
+! { dg-final { cleanup-modules "store_subroutine" } }
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_result_4.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_result_4.f90
new file mode 100644
index 000000000..97e67e558
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_result_4.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! PR 40451: [F03] procedure pointer assignment rejected 
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+contains
+
+  function f()
+    intrinsic :: sin
+    procedure(sin), pointer :: f
+    f => sin
+  end function f
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_result_5.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_result_5.f90
new file mode 100644
index 000000000..0e60cbb2a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_result_5.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+!
+! PR 40541: Assignment checking for proc-pointer => proc-ptr-returning-function()
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+program test
+  procedure(real), pointer :: p
+  p => f()  ! { dg-error "Type/kind mismatch in return value" }
+contains
+ function f()
+   pointer :: f
+   interface
+     logical(1) function f()
+     end function
+   end interface
+   f = .true._1
+ end function f
+end program test
+
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_result_6.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_result_6.f90
new file mode 100644
index 000000000..c9e1a8b06
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_result_6.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+!
+! PR 40593: Proc-pointer returning function as actual argument
+!
+! Original test case by Tobias Burnus <burnus@gcc.gnu.org>
+! Modified by Janus Weil
+
+module m
+contains
+  subroutine sub(a)
+    integer :: a
+    a = 42
+  end subroutine
+  integer function func()
+    func = 42
+  end function
+end module m
+
+program test
+  use m
+  implicit none
+  call caller1(getPtr1())
+  call caller2(getPtr2())
+  call caller3(getPtr2())
+contains
+  subroutine caller1(s)
+    procedure(sub) :: s
+    integer :: b
+    call s(b)
+    if (b /= 42)  call abort()
+  end subroutine
+  subroutine caller2(f)
+    procedure(integer) :: f
+    if (f() /= 42)  call abort()
+  end subroutine
+  subroutine caller3(f)
+    procedure(func),pointer :: f
+    if (f() /= 42) call abort()
+  end subroutine
+  function getPtr1()
+    procedure(sub), pointer :: getPtr1
+    getPtr1 => sub
+  end function
+  function getPtr2()
+    procedure(func), pointer :: getPtr2
+    getPtr2 => func
+  end function
+end program test
+
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/procedure_lvalue.f90 b/gcc/testsuite/gfortran.dg/procedure_lvalue.f90
new file mode 100644
index 000000000..741dc8c34
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/procedure_lvalue.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! Tests the fix for PR17911, where a USE associated l-value
+! would cause an ICE in gfc_conv_variable.
+! Test contributed by Tobias Schlueter  <tobi@gcc.gnu.org>
+module t
+  interface a
+     module procedure b
+  end interface
+contains
+  integer function b(x)
+    b = x
+  end function b
+end module t
+
+subroutine r
+  use t
+  b = 1.       ! { dg-error "is not a variable" }
+  y = a(1.)
+end subroutine r
+
+! { dg-final { cleanup-modules "t" } }
diff --git a/gcc/testsuite/gfortran.dg/product_init_expr.f03 b/gcc/testsuite/gfortran.dg/product_init_expr.f03
new file mode 100644
index 000000000..c6ff7e8ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/product_init_expr.f03
@@ -0,0 +1,66 @@
+! { dg-do run }
+! { dg-options "-fno-inline" }
+!
+! PRODUCT as initialization expression.
+!
+! This test compares results of simplifier of PRODUCT
+! with the corresponding inlined or library routine(s).
+!
+
+  IMPLICIT NONE
+
+  INTEGER, PARAMETER :: imatrix(2,4) = RESHAPE ([ 1, 2, 3, 4, 5, 6, 7, 8 ], [2, 4] )
+  INTEGER, PARAMETER :: imatrix_prod = PRODUCT (imatrix)
+  INTEGER, PARAMETER :: imatrix_prod_d1(4) = PRODUCT (imatrix, dim=1)
+  INTEGER, PARAMETER :: imatrix_prod_d2(2) = PRODUCT (imatrix, dim=2)
+  LOGICAL, PARAMETER :: i_equal_prod = ALL ([PRODUCT( imatrix_prod_d1 ) ==  PRODUCT ( imatrix_prod_d2 ), &
+                                             PRODUCT( imatrix_prod_d1 ) == imatrix_prod])
+  LOGICAL, PARAMETER :: i_empty_prod = PRODUCT(imatrix, mask=.FALSE.) == 1
+
+  REAL, PARAMETER :: rmatrix(2,4) = RESHAPE ([ 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0 ], [2, 4] )
+  REAL, PARAMETER :: rmatrix_prod = PRODUCT (rmatrix)
+  REAL, PARAMETER :: rmatrix_prod_d1(4) = PRODUCT (rmatrix, dim=1)
+  REAL, PARAMETER :: rmatrix_prod_d2(2) = PRODUCT (rmatrix, dim=2)
+  LOGICAL, PARAMETER :: r_equal_prod = ALL ([PRODUCT( rmatrix_prod_d1 ) ==  PRODUCT ( rmatrix_prod_d2 ), &
+                                             PRODUCT( rmatrix_prod_d1 ) == rmatrix_prod])
+  LOGICAL, PARAMETER :: r_empty_prod = PRODUCT(rmatrix, mask=.FALSE.) == 1.0
+
+  IF (.NOT. ALL ([i_equal_prod, i_empty_prod])) CALL abort()
+  IF (.NOT. ALL ([r_equal_prod, r_empty_prod])) CALL abort()
+
+  CALL ilib (imatrix, imatrix_prod)
+  CALL ilib_with_dim (imatrix, 1, imatrix_prod_d1)
+  CALL ilib_with_dim (imatrix, 2, imatrix_prod_d2)
+  CALL rlib (rmatrix, rmatrix_prod)
+  CALL rlib_with_dim (rmatrix, 1, rmatrix_prod_d1)
+  CALL rlib_with_dim (rmatrix, 2, rmatrix_prod_d2)
+
+CONTAINS
+  SUBROUTINE ilib (array, result)
+    INTEGER, DIMENSION(:,:), INTENT(in) :: array
+    INTEGER, INTENT(in) :: result
+    IF (PRODUCT(array) /= result) CALL abort()
+  END SUBROUTINE
+
+  SUBROUTINE ilib_with_dim (array, dim, result)
+    INTEGER, DIMENSION(:,:), INTENT(in) :: array
+    INTEGER, INTENT(iN)                 :: dim
+    INTEGER, DIMENSION(:), INTENT(in)   :: result
+    IF (ANY (PRODUCT (array, dim=dim) /= result)) CALL abort()
+  END SUBROUTINE
+
+  SUBROUTINE rlib (array, result)
+    REAL, DIMENSION(:,:), INTENT(in) :: array
+    REAL, INTENT(in) :: result
+    IF (ABS(PRODUCT(array) - result) > 2e-6) CALL abort()
+  END SUBROUTINE
+
+  SUBROUTINE rlib_with_dim (array, dim, result)
+    REAL, DIMENSION(:,:), INTENT(in) :: array
+    INTEGER, INTENT(iN)              :: dim
+    REAL, DIMENSION(:), INTENT(in)   :: result
+    IF (ANY (ABS(PRODUCT (array, dim=dim) - result) > 2e-6)) CALL abort()
+  END SUBROUTINE
+END
+
+
diff --git a/gcc/testsuite/gfortran.dg/product_sum_bounds_1.f90 b/gcc/testsuite/gfortran.dg/product_sum_bounds_1.f90
new file mode 100644
index 000000000..c6390896c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/product_sum_bounds_1.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+program main
+  real, dimension(4,3) :: a
+  real, dimension(2) :: b
+  a = 21.
+  b = product(a,dim=1) ! { dg-error "Different shape" }
+  b = sum(a,dim=2) ! { dg-error "Different shape" }
+end program main
diff --git a/gcc/testsuite/gfortran.dg/program_name_1.f90 b/gcc/testsuite/gfortran.dg/program_name_1.f90
new file mode 100644
index 000000000..6d6c79bb0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/program_name_1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! Tests the fix for PR28762 in which the program name would cause
+! the compiler to test the write statement as a variable thereby generating
+! an "Expecting VARIABLE" error.
+!
+! Contributed by David Ham  <David@ham.dropbear.id.au>
+!
+program write
+  integer :: debuglevel = 1
+  if (0 < debuglevel) write (*,*) "Hello World"
+end program write
diff --git a/gcc/testsuite/gfortran.dg/promotion.f90 b/gcc/testsuite/gfortran.dg/promotion.f90
new file mode 100644
index 000000000..fc46d853e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/promotion.f90
@@ -0,0 +1,13 @@
+! { dg-do run { target i?86-*-* x86_64-*-* } }
+! { dg-require-effective-target ilp32 }
+! { dg-options "-fdefault-integer-8 -fdefault-real-8 -fdefault-double-8" }
+program a
+   logical l
+   integer i
+   real x
+   double precision d
+   if (kind(l) /= 8) call abort
+   if (kind(i) /= 8) call abort
+   if (kind(x) /= 8) call abort
+   if (kind(d) /= 8) call abort
+end program a
diff --git a/gcc/testsuite/gfortran.dg/protected_1.f90 b/gcc/testsuite/gfortran.dg/protected_1.f90
new file mode 100644
index 000000000..fbc30e8c6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/protected_1.f90
@@ -0,0 +1,61 @@
+! { dg-do run }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+! PR fortran/23994
+!
+! Test PROTECTED attribute. Within the module everything is allowed.
+! Outside (use-associated): For pointers, their association status
+! may not be changed. For nonpointers, their value may not be changed.
+!
+! Test of a valid code
+
+module protmod
+  implicit none
+  integer          :: a,b
+  integer, target  :: at,bt
+  integer, pointer :: ap,bp
+  protected :: a, at
+  protected :: ap
+contains
+  subroutine setValue()
+    a = 43
+    ap => null()
+    nullify(ap)
+    ap => at
+    ap = 3
+    allocate(ap)
+    ap = 73
+    call increment(a,ap,at)
+    if(a /= 44 .or. ap /= 74 .or. at /= 4) call abort()
+  end subroutine setValue
+  subroutine increment(a1,a2,a3)
+    integer, intent(inout) :: a1, a2, a3
+    a1 = a1 + 1
+    a2 = a2 + 1
+    a3 = a3 + 1
+  end subroutine increment
+end module protmod
+
+program main
+  use protmod
+  implicit none
+  b = 5
+  bp => bt
+  bp = 4
+  bt = 7
+  call setValue()
+  if(a /= 44 .or. ap /= 74 .or. at /= 4) call abort()
+  call plus5(ap)
+  if(a /= 44 .or. ap /= 79 .or. at /= 4) call abort()
+  call checkVal(a,ap,at)
+contains
+  subroutine plus5(j)
+    integer, intent(inout) :: j
+    j = j + 5
+  end subroutine plus5
+  subroutine checkVal(x,y,z)
+    integer, intent(in) :: x, y, z
+    if(a /= 44 .or. ap /= 79 .or. at /= 4) call abort()
+  end subroutine
+end program main
+
+! { dg-final { cleanup-modules "protmod" } }
diff --git a/gcc/testsuite/gfortran.dg/protected_2.f90 b/gcc/testsuite/gfortran.dg/protected_2.f90
new file mode 100644
index 000000000..dcdce51c8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/protected_2.f90
@@ -0,0 +1,55 @@
+! { dg-do run }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+! PR fortran/23994
+!
+! Test PROTECTED attribute. Within the module everything is allowed.
+! Outside (use-associated): For pointers, their association status
+! may not be changed. For nonpointers, their value may not be changed.
+!
+! Test of a valid code
+
+module protmod
+  implicit none
+  integer, protected          :: a
+  integer, protected, target  :: at
+  integer, protected, pointer :: ap
+contains
+  subroutine setValue()
+    a = 43
+    ap => null()
+    nullify(ap)
+    ap => at
+    ap = 3
+    allocate(ap)
+    ap = 73
+    call increment(a,ap,at)
+    if(a /= 44 .or. ap /= 74 .or. at /= 4) call abort()
+  end subroutine setValue
+  subroutine increment(a1,a2,a3)
+    integer, intent(inout) :: a1, a2, a3
+    a1 = a1 + 1
+    a2 = a2 + 1
+    a3 = a3 + 1
+  end subroutine increment
+end module protmod
+
+program main
+  use protmod
+  implicit none
+  call setValue()
+  if(a /= 44 .or. ap /= 74 .or. at /= 4) call abort()
+  call plus5(ap)
+  if(a /= 44 .or. ap /= 79 .or. at /= 4) call abort()
+  call checkVal(a,ap,at)
+contains
+  subroutine plus5(j)
+    integer, intent(inout) :: j
+    j = j + 5
+  end subroutine plus5
+  subroutine checkVal(x,y,z)
+    integer, intent(in) :: x, y, z
+    if(a /= 44 .or. ap /= 79 .or. at /= 4) call abort()
+  end subroutine
+end program main
+
+! { dg-final { cleanup-modules "protmod" } }
diff --git a/gcc/testsuite/gfortran.dg/protected_3.f90 b/gcc/testsuite/gfortran.dg/protected_3.f90
new file mode 100644
index 000000000..e3d31a6bf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/protected_3.f90
@@ -0,0 +1,23 @@
+! { dg-options "-std=f95 -fall-intrinsics" }
+! PR fortran/23994
+!
+! Test PROTECTED attribute. Within the module everything is allowed.
+! Outside (use-associated): For pointers, their association status
+! may not be changed. For nonpointers, their value may not be changed.
+!
+! Reject in Fortran 95
+
+module protmod
+  implicit none
+  integer          :: a
+  integer, target  :: at
+  integer, pointer :: ap
+  protected :: a, at, ap ! { dg-error "Fortran 2003: PROTECTED statement" }
+end module protmod
+
+module protmod2
+  implicit none
+  integer, protected          :: a  ! { dg-error "Fortran 2003: PROTECTED attribute" }
+  integer, protected, target  :: at ! { dg-error "Fortran 2003: PROTECTED attribute" }
+  integer, protected, pointer :: ap ! { dg-error "Fortran 2003: PROTECTED attribute" }
+end module protmod2
diff --git a/gcc/testsuite/gfortran.dg/protected_4.f90 b/gcc/testsuite/gfortran.dg/protected_4.f90
new file mode 100644
index 000000000..7f0e49f09
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/protected_4.f90
@@ -0,0 +1,58 @@
+! { dg-do compile }
+! { dg-shouldfail "Invalid Fortran 2003 code" }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+! PR fortran/23994
+!
+! Test PROTECTED attribute. Within the module everything is allowed.
+! Outside (use-associated): For pointers, their association status
+! may not be changed. For nonpointers, their value may not be changed.
+!
+! Test of a invalid code
+
+module protmod
+  implicit none
+  integer          :: a
+  integer, target  :: at
+  integer, pointer :: ap
+  protected :: a, at, ap
+end module protmod
+
+program main
+  use protmod
+  implicit none
+  integer   :: j 
+  logical   :: asgnd
+  protected :: j ! { dg-error "only allowed in specification part of a module" }
+  a = 43       ! { dg-error "variable definition context" }
+  ap => null() ! { dg-error "pointer association context" }
+  nullify(ap)  ! { dg-error "pointer association context" }
+  ap => at     ! { dg-error "pointer association context" }
+  ap = 3       ! OK
+  allocate(ap) ! { dg-error "pointer association context" }
+  ap = 73      ! OK
+  call increment(a,at) ! { dg-error "variable definition context" }
+  call pointer_assignments(ap) ! { dg-error "pointer association context" }
+  asgnd = pointer_check(ap)
+contains
+  subroutine increment(a1,a3)
+    integer, intent(inout) :: a1, a3
+    a1 = a1 + 1
+    a3 = a3 + 1
+  end subroutine increment
+  subroutine pointer_assignments(p)
+    integer, pointer,intent(out) :: p
+    p => null()           
+  end subroutine pointer_assignments
+  function pointer_check(p)
+    integer, pointer,intent(in) :: p
+    logical :: pointer_check
+    pointer_check = associated(p)
+  end function pointer_check
+end program main
+
+module test
+  real :: a
+  protected :: test ! { dg-error "MODULE attribute conflicts with PROTECTED" }
+end module test
+
+! { dg-final { cleanup-modules "protmod test" } }
diff --git a/gcc/testsuite/gfortran.dg/protected_5.f90 b/gcc/testsuite/gfortran.dg/protected_5.f90
new file mode 100644
index 000000000..85046c3cb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/protected_5.f90
@@ -0,0 +1,57 @@
+! { dg-do compile }
+! { dg-shouldfail "Invalid Fortran 2003 code" }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+! PR fortran/23994
+!
+! Test PROTECTED attribute. Within the module everything is allowed.
+! Outside (use-associated): For pointers, their association status
+! may not be changed. For nonpointers, their value may not be changed.
+!
+! Test of a invalid code
+
+module good1
+  implicit none
+  integer              :: a
+  integer              :: b,c
+  protected            :: c
+  equivalence (a,c) ! { dg-error "Either all or none of the objects in the EQUIVALENCE" }
+end module good1
+
+
+module bad1
+  implicit none
+  integer, protected   :: a
+  integer              :: b,c
+  protected            :: c
+  equivalence (a,b) ! { dg-error "Either all or none of the objects in the EQUIVALENCE" }
+end module bad1
+
+module bad2
+  implicit none
+  integer, protected   :: a
+  integer              :: b,c,d
+  protected            :: c
+  common /one/ a,b  ! { dg-error "PROTECTED attribute conflicts with COMMON" }
+  common /two/ c,d  ! { dg-error "PROTECTED attribute conflicts with COMMON" }
+end module bad2
+
+module good2
+  implicit none
+  type myT
+     integer :: j
+     integer, pointer :: p
+     real, allocatable, dimension(:) :: array
+  end type myT
+  type(myT), save :: t
+  protected :: t
+end module good2
+
+program main
+  use good2
+  implicit none
+  t%j = 15             ! { dg-error "variable definition context" }
+  nullify(t%p)         ! { dg-error "pointer association context" }
+  allocate(t%array(15))! { dg-error "variable definition context" }
+end program main
+
+! { dg-final { cleanup-modules "good1 good2 bad1 bad2" } }
diff --git a/gcc/testsuite/gfortran.dg/protected_6.f90 b/gcc/testsuite/gfortran.dg/protected_6.f90
new file mode 100644
index 000000000..e7f3e4e93
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/protected_6.f90
@@ -0,0 +1,51 @@
+! { dg-do compile }
+! { dg-shouldfail "Invalid Fortran 2003 code" }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+! PR fortran/23994
+!
+! Test PROTECTED attribute. Within the module everything is allowed.
+! Outside (use-associated): For pointers, their association status
+! may not be changed. For nonpointers, their value may not be changed.
+!
+! Test of a invalid code
+
+module protmod
+  implicit none
+  integer, Protected          :: a
+  integer, protected, target  :: at
+  integer, protected, pointer :: ap
+end module protmod
+
+program main
+  use protmod
+  implicit none
+  a = 43       ! { dg-error "variable definition context" }
+  ap => null() ! { dg-error "pointer association context" }
+  nullify(ap)  ! { dg-error "pointer association context" }
+  ap => at     ! { dg-error "pointer association context" }
+  ap = 3       ! OK
+  allocate(ap) ! { dg-error "pointer association context" }
+  ap = 73      ! OK
+  call increment(a,at) ! { dg-error "variable definition context" }
+  call pointer_assignments(ap) ! { dg-error "pointer association context" }
+contains
+  subroutine increment(a1,a3)
+    integer, intent(inout) :: a1, a3
+    a1 = a1 + 1
+    a3 = a3 + 1
+  end subroutine increment
+  subroutine pointer_assignments(p)
+    integer, pointer,intent (inout) :: p
+    p => null()
+  end subroutine pointer_assignments
+end program main
+
+module prot2
+  implicit none
+contains
+  subroutine bar
+    real, protected :: b ! { dg-error "only allowed in specification part of a module" }
+  end subroutine bar
+end module prot2
+
+! { dg-final { cleanup-modules "protmod" } }
diff --git a/gcc/testsuite/gfortran.dg/protected_7.f90 b/gcc/testsuite/gfortran.dg/protected_7.f90
new file mode 100644
index 000000000..abdc9592a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/protected_7.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! PR fortran/37504
+!
+module m
+  implicit none
+  integer, pointer, protected :: protected_pointer
+  integer, target,  protected :: protected_target
+end module m
+
+program p
+  use m
+  implicit none
+  integer, pointer :: unprotected_pointer
+  ! The next two lines should be rejected; see PR 37513 why
+  ! we get such a strange error message.
+  protected_pointer => unprotected_pointer ! { dg-error "pointer association context" }
+  protected_pointer =  unprotected_pointer ! OK
+  unprotected_pointer => protected_target  ! { dg-error "target has PROTECTED attribute" }
+  unprotected_pointer => protected_pointer ! OK
+end program p
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/protected_8.f90 b/gcc/testsuite/gfortran.dg/protected_8.f90
new file mode 100644
index 000000000..aaa34a68f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/protected_8.f90
@@ -0,0 +1,50 @@
+! { dg-do compile }
+!
+! PR fortran/46122
+!
+! PROTECT check
+!
+! Contributed by Jared Ahern
+!
+
+MODULE amod
+   IMPLICIT NONE
+   TYPE foo
+      INTEGER :: i = 4
+      INTEGER, POINTER :: j => NULL()
+   END TYPE foo
+   TYPE(foo), SAVE, PROTECTED :: a
+   TYPE(foo), SAVE, PROTECTED, POINTER :: b
+   INTEGER, SAVE, PROTECTED :: i = 5
+   INTEGER, SAVE, PROTECTED, POINTER :: j => NULL()
+contains
+  subroutine alloc()
+    allocate(b,j)
+  end subroutine alloc
+END MODULE amod
+
+PROGRAM test
+   USE amod
+   IMPLICIT NONE
+   INTEGER, TARGET :: k
+   TYPE(foo), TARGET :: c
+   k = 2   ! local
+   c%i = 9 ! local
+
+   call alloc()
+
+   i = k    ! { dg-error "is PROTECTED" }
+   j => k   ! { dg-error "is PROTECTED" }
+   j = 3    ! OK 1
+   a = c    ! { dg-error "is PROTECTED" }
+   a%i = k  ! { dg-error "is PROTECTED" }
+   a%j => k ! { dg-error "is PROTECTED" }
+   a%j = 5  ! OK 2
+   b => c   ! { dg-error "is PROTECTED" }
+   b%i = k  ! OK 3
+   b%j => k ! OK 4
+   b%j = 5  ! OK 5
+
+END PROGRAM test
+
+! { dg-final { cleanup-modules "amod" } }
diff --git a/gcc/testsuite/gfortran.dg/ptr-func-1.f90 b/gcc/testsuite/gfortran.dg/ptr-func-1.f90
new file mode 100644
index 000000000..b7c1fc93d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ptr-func-1.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+!
+! PR fortran/46100
+!
+! Pointer function as definable actual argument
+! - a Fortran 2008 feature
+!
+integer, target :: tgt
+call one (two ())
+if (tgt /= 774) call abort ()
+contains
+  subroutine one (x)
+    integer, intent(inout) :: x
+    if (x /= 34) call abort ()
+    x = 774
+  end subroutine one
+  function two ()
+    integer, pointer :: two
+    two => tgt 
+    two = 34
+  end function two
+end
+
diff --git a/gcc/testsuite/gfortran.dg/ptr-func-2.f90 b/gcc/testsuite/gfortran.dg/ptr-func-2.f90
new file mode 100644
index 000000000..8275f14c7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ptr-func-2.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+!
+! PR fortran/46100
+!
+! Pointer function as definable actual argument
+! - a Fortran 2008 feature
+!
+integer, target :: tgt
+call one (two ()) ! { dg-error "Fortran 2008: Pointer functions" }
+if (tgt /= 774) call abort ()
+contains
+  subroutine one (x)
+    integer, intent(inout) :: x
+    if (x /= 34) call abort ()
+    x = 774
+  end subroutine one
+  function two ()
+    integer, pointer :: two
+    two => tgt 
+    two = 34
+  end function two
+end
+
diff --git a/gcc/testsuite/gfortran.dg/public_private_module.f90 b/gcc/testsuite/gfortran.dg/public_private_module.f90
new file mode 100644
index 000000000..48e78b60c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/public_private_module.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! See PR fortran/36251.
+module a
+  implicit none
+  integer :: i = 42
+end module a
+
+module b
+  use a
+  implicit none
+  public a  ! { dg-error "attribute applied to" }
+end module b
+
+module d
+  use a
+  implicit none
+  private a  ! { dg-error "attribute applied to" }
+end module d
+! { dg-final { cleanup-modules "a" } }
diff --git a/gcc/testsuite/gfortran.dg/pure_byref_1.f90 b/gcc/testsuite/gfortran.dg/pure_byref_1.f90
new file mode 100644
index 000000000..5e080e5af
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pure_byref_1.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! PR 22607: PURE/ELEMENTAL return-by-reference functions
+program main
+  implicit none
+  character(2), dimension(2) :: a, b
+  a = 'ok'
+  b = fun(a)
+  if (.not.all(b == 'ok')) call abort()
+contains
+  elemental function fun(a) 
+    character(*), intent(in) :: a
+    character(len(a)) :: fun
+    fun = a
+  end function fun
+end program main
diff --git a/gcc/testsuite/gfortran.dg/pure_byref_2.f90 b/gcc/testsuite/gfortran.dg/pure_byref_2.f90
new file mode 100644
index 000000000..805653e2e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pure_byref_2.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! PR 22607: PURE return-by-reference functions
+program main
+  implicit none
+  integer, dimension(2) :: b
+  b = fun(size(b))
+  if (b(1) /= 1 .or. b(2) /= 2) call abort()
+contains
+  pure function fun(n) 
+    integer, intent(in) :: n
+    integer :: fun(n)
+    integer :: i
+    do i = 1, n
+        fun(i) = i
+    end do
+  end function fun
+end program main
diff --git a/gcc/testsuite/gfortran.dg/pure_byref_3.f90 b/gcc/testsuite/gfortran.dg/pure_byref_3.f90
new file mode 100644
index 000000000..a9d860bf0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pure_byref_3.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+! PR 22607: External/module pure return-by-reference functions
+
+pure function hoj()
+    integer :: hoj(3)
+    hoj = (/1, 2, 3/)
+end function hoj
+
+module huj_mod
+contains
+    pure function huj()
+        integer :: huj(3)
+        huj = (/1, 2, 3/)
+    end function huj
+end module huj_mod
+
+program pure_byref_3
+    use huj_mod
+    implicit none
+
+    interface
+        pure function hoj()
+            integer :: hoj(3)
+        end function hoj
+    end interface
+    integer :: a(3)
+
+    a = huj()
+    if (.not. all(a == (/1, 2, 3/))) call abort()
+
+    a = hoj()
+    if (.not. all(a == (/1, 2, 3/))) call abort()
+end program pure_byref_3
+
+! { dg-final { cleanup-modules "huj_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/pure_dummy_length_1.f90 b/gcc/testsuite/gfortran.dg/pure_dummy_length_1.f90
new file mode 100644
index 000000000..c1bc17224
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pure_dummy_length_1.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }

+! Tests fix for PR26107 in which an ICE would occur after the second

+! error message below.  This resulted from a spurious attempt to

+! produce the third error message, without the name of the function.

+!

+! This is an expanded version of the testcase in the PR.

+!

+   pure function equals(self, &     ! { dg-error "must be INTENT" }

+                        string, ignore_case) result(same)

+         character(*), intent(in) :: string

+         integer(4), intent(in) :: ignore_case

+         integer(4) :: same

+         if (len (self) < 1) return ! { dg-error "must be CHARACTER" }

+         same = 1

+   end function

+

+   function impure(self) result(ival)

+         character(*), intent(in) :: self

+         ival = 1

+   end function

+

+   pure function purity(self, string, ignore_case) result(same)

+         character(*), intent(in) :: self

+         character(*), intent(in) :: string

+         integer(4), intent(in) :: ignore_case

+         integer i

+         if (end > impure (self)) & ! { dg-error "non-PURE procedure" }

+           return

+   end function

diff --git a/gcc/testsuite/gfortran.dg/pure_formal_1.f90 b/gcc/testsuite/gfortran.dg/pure_formal_1.f90
new file mode 100644
index 000000000..4e62cf9de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pure_formal_1.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! PR fortran/47507
+!
+! PURE procedures: Allow arguments w/o INTENT if they are VALUE
+!
+
+pure function f(x)
+  real, VALUE :: x
+  real :: f
+  f = sin(x)
+end function f
+
+pure subroutine sub(x)
+  real, VALUE :: x
+end subroutine sub
diff --git a/gcc/testsuite/gfortran.dg/pure_formal_2.f90 b/gcc/testsuite/gfortran.dg/pure_formal_2.f90
new file mode 100644
index 000000000..b3c8a0e0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pure_formal_2.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/47550
+! Follow up to: PR fortran/47507
+!
+! PURE procedures: Allow arguments w/o INTENT if they are VALUE
+!
+
+pure function f(x) ! { dg-error "Fortran 2008: Argument 'x' of pure function" }
+  real, VALUE :: x
+  real :: f
+  f = sin(x)
+end function f
+
+pure subroutine sub(x) ! { dg-error "Fortran 2008: Argument 'x' of pure subroutine" }
+  real, VALUE :: x
+end subroutine sub
diff --git a/gcc/testsuite/gfortran.dg/pure_formal_proc_1.f90 b/gcc/testsuite/gfortran.dg/pure_formal_proc_1.f90
new file mode 100644
index 000000000..4a55563c8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pure_formal_proc_1.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! Test fix for PR30034 in which the legal, pure procedure formal
+! argument was rejected as an error.
+!
+! Contgributed by Troban Trumsko <trumsko@yahoo.com>
+!
+ pure subroutine s_one ( anum, afun )
+    integer, intent(in) :: anum
+    interface
+      pure function afun (k) result (l)
+        implicit none
+        integer, intent(in) :: k
+        integer :: l
+      end function afun
+    end interface
+end subroutine s_one
diff --git a/gcc/testsuite/gfortran.dg/pure_formal_proc_2.f90 b/gcc/testsuite/gfortran.dg/pure_formal_proc_2.f90
new file mode 100644
index 000000000..ec7d06eec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pure_formal_proc_2.f90
@@ -0,0 +1,48 @@
+! { dg-do compile }
+! Tests the fix for PR36526, in which the call to getStrLen would
+! generate an error due to the use of a wrong symbol in interface.c
+!
+! Contributed by Bálint Aradi <aradi@bccms.uni-bremen.de>
+!
+module TestPure
+  implicit none
+
+  type T1
+    character(10) :: str
+  end type T1
+
+contains
+
+  pure function getT1Len(self) result(t1len)
+    type(T1), pointer :: self
+    integer :: t1len
+
+    t1len = getStrLen(self%str)
+
+  end function getT1Len
+
+
+  pure function getStrLen(str) result(length)
+    character(*), intent(in) :: str
+    integer :: length
+
+    length = len_trim(str)
+
+  end function getStrLen
+
+end module TestPure
+
+
+program Test
+  use TestPure
+  implicit none
+
+  type(T1), pointer :: pT1
+
+  allocate(pT1)
+  pT1%str = "test"
+  write (*,*) getT1Len(pT1)
+  deallocate(pT1)
+
+end program Test
+! { dg-final { cleanup-modules "TestPure" } }
diff --git a/gcc/testsuite/gfortran.dg/pure_initializer_1.f90 b/gcc/testsuite/gfortran.dg/pure_initializer_1.f90
new file mode 100644
index 000000000..6f521a04f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pure_initializer_1.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! Tests the fix for PR32881, in which the initialization
+! of 'p' generated an error because the pureness of 'bar'
+! escaped.
+!
+! Contributed by Janne Blomqvist <jb@gcc.gnu.org>
+!
+subroutine foo ()
+  integer, pointer :: p => NULL()
+contains
+  pure function bar (a)
+    integer, intent(in) :: a
+    integer :: bar
+    bar = a
+  end function bar
+end subroutine foo
+
diff --git a/gcc/testsuite/gfortran.dg/pure_initializer_2.f90 b/gcc/testsuite/gfortran.dg/pure_initializer_2.f90
new file mode 100644
index 000000000..4fd2556ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pure_initializer_2.f90
@@ -0,0 +1,46 @@
+! { dg-do compile }
+! PR42008 Wrongly rejected derived types with default initializers
+! in PURE procedures
+module mod_xyz
+ implicit none
+contains
+ pure subroutine psub()
+  type ilist
+    type(ilist), pointer :: next => null() ! Valid
+    integer :: i
+  end type ilist
+ end subroutine psub
+end module mod_xyz
+
+module mod_xyz2
+ implicit none
+contains
+ pure subroutine psub()
+  type ilist
+    type(ilist), pointer :: next
+    integer, pointer :: p => null() ! Valid
+    integer :: i
+  end type ilist
+  type(ilist) :: var ! Valid
+  var%next => null()
+ end subroutine psub
+end module mod_xyz2
+
+module mod_xyz3
+ implicit none
+ type ilist
+   type(ilist), pointer :: next => null() ! Valid
+   integer :: i
+ end type ilist
+contains
+ pure subroutine psub()
+  type(ilist) :: var ! Valid
+ end subroutine psub
+end module mod_xyz3
+
+pure function test()
+  integer,pointer :: p => null() !{ dg-error "not allowed in a PURE procedure" }
+  integer :: test
+  test = p
+end function test
+! { dg-final { cleanup-modules "mod_xyz mod_xyz2 mod_xyz3" } }
diff --git a/gcc/testsuite/gfortran.dg/pure_initializer_3.f90 b/gcc/testsuite/gfortran.dg/pure_initializer_3.f90
new file mode 100644
index 000000000..91ec178f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pure_initializer_3.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+!
+! PR fortran/42922
+!
+! Contributed by mrestelli@gmail.com
+!
+pure subroutine psub()
+  implicit none
+  type ilist
+    integer :: i = 0
+  end type ilist
+  type(ilist) :: x
+  x%i = 1
+end subroutine psub
diff --git a/gcc/testsuite/gfortran.dg/quad_1.f90 b/gcc/testsuite/gfortran.dg/quad_1.f90
new file mode 100644
index 000000000..e75faacdb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/quad_1.f90
@@ -0,0 +1,37 @@
+! { dg-do link }
+!
+! This test checks whether the largest possible
+! floating-point number works. That's usually
+! REAL(16) -- either because the hardware supports it or
+! because of libquadmath. However, it can also be
+! REAL(10) or REAL(8)
+!
+program test_qp
+   use iso_fortran_env, only: real_kinds
+   implicit none
+   integer, parameter :: QP = real_kinds(ubound(real_kinds,dim=1))
+   real(QP), parameter :: Z1 = 1,HALF_PI = asin(Z1),PI = HALF_PI+HALF_PI
+   real(QP) :: x = 0.124_QP
+   complex(QP) :: z = 0.124_QP
+   print *, 'kind = ', qp
+   print *, x
+   print *, PI
+   print *, 16*atan(0.2_QP)-4*atan(Z1/239)
+   print *, sin(PI)
+   print *, cos(HALF_PI)
+   print *, asinh(PI)
+   print *, erfc(Z1)
+   print *, epsilon(x)
+   print *, precision(x)
+   print *, digits(x)
+
+   print *, z
+   print *, PI*cmplx(0.0_qp, 1.0_qp)
+! Disable the complex functions as not all "long-double" systems have
+! a libm with those C99 functions. (libquadmath had), cf. PR 46584
+!   print *, 16*atan(0.2_QP)-4*atan(Z1/239)
+!   print *, sin(z)
+!   print *, cos(z)
+!   print *, sinh(z) ! asinh not implemented in libquadmath, cf. PR 46416
+   print *, precision(z)
+end program test_qp
diff --git a/gcc/testsuite/gfortran.dg/random_3.f90 b/gcc/testsuite/gfortran.dg/random_3.f90
new file mode 100644
index 000000000..8e087c482
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/random_3.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+! Check that the random_seed for real(10) or real(16) exists and that
+! real(8) and real(10) or real(16) random number generators
+! return the same sequence of values.
+! Mostly copied from random_2.f90
+program random_4
+  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+
+  integer, dimension(:), allocatable :: seed
+  real(kind=8), dimension(10) :: r8
+  real(kind=k), dimension(10) :: r10
+  real, parameter :: delta = 1.d-10
+  integer n
+
+  call random_seed (size=n)
+  allocate (seed(n))
+  call random_seed (get=seed)
+  ! Test both array valued and scalar routines.
+  call random_number(r8)
+  call random_number (r8(10))
+
+  ! Reset the seed and get the real(8) values.
+  call random_seed (put=seed)
+  call random_number(r10)
+  call random_number (r10(10))
+
+  if (any ((r8 - r10) .gt. delta)) call abort
+end program random_4
diff --git a/gcc/testsuite/gfortran.dg/random_4.f90 b/gcc/testsuite/gfortran.dg/random_4.f90
new file mode 100644
index 000000000..416b17c00
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/random_4.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+!
+program trs
+  implicit none
+  integer :: size, ierr
+  integer, allocatable, dimension(:) :: seed, check
+  call test_random_seed(size)
+  allocate(seed(size),check(size))
+  call test_random_seed(put=seed)
+  call test_random_seed(get=check)
+  if (any (seed /= check)) call abort
+contains
+  subroutine test_random_seed(size, put, get)
+    integer, optional :: size
+    integer, dimension(:), optional :: put
+    integer, dimension(:), optional :: get
+    call random_seed(size, put, get)
+  end subroutine test_random_seed
+end program trs
diff --git a/gcc/testsuite/gfortran.dg/random_5.f90 b/gcc/testsuite/gfortran.dg/random_5.f90
new file mode 100644
index 000000000..418bd68fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/random_5.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! { dg-shouldfail "" }
+!
+program trs
+  implicit none
+  integer :: size
+  integer :: seed(50)
+  call test_random_seed(size,seed)
+contains
+  subroutine test_random_seed(size, put, get)
+    integer, optional :: size
+    integer, dimension(:), optional :: put
+    integer, dimension(:), optional :: get
+    call random_seed(size, put, get)
+  end subroutine test_random_seed
+end program trs
+! { dg-output "Fortran runtime error: RANDOM_SEED should have at most one argument present.*" }
diff --git a/gcc/testsuite/gfortran.dg/random_6.f90 b/gcc/testsuite/gfortran.dg/random_6.f90
new file mode 100644
index 000000000..078c8af01
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/random_6.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+subroutine test1 (size, put, get)
+  integer :: size
+  integer, dimension(:), optional :: put
+  integer, dimension(:), optional :: get
+  call random_seed(size, put, get)
+end
+
+subroutine test2 (size, put, get)
+  integer, optional :: size
+  integer, dimension(:) :: put
+  integer, dimension(:) :: get
+  call random_seed(size, put, get) ! { dg-error "Too many arguments" }
+end
diff --git a/gcc/testsuite/gfortran.dg/random_7.f90 b/gcc/testsuite/gfortran.dg/random_7.f90
new file mode 100644
index 000000000..6435a34cf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/random_7.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! { dg-options "-fdefault-integer-8" }
+!
+program trs
+  implicit none
+  integer :: size, ierr
+  integer, allocatable, dimension(:) :: seed, check
+  call test_random_seed(size)
+  allocate(seed(size),check(size))
+  seed(:) = huge(seed) / 17
+  call test_random_seed(put=seed)
+  call test_random_seed(get=check)
+  print *, seed
+  print *, check
+  if (any (seed /= check)) call abort
+contains
+  subroutine test_random_seed(size, put, get)
+    integer, optional :: size
+    integer, dimension(:), optional :: put
+    integer, dimension(:), optional :: get
+    call random_seed(size, put, get)
+  end subroutine test_random_seed
+end program trs
diff --git a/gcc/testsuite/gfortran.dg/random_seed_1.f90 b/gcc/testsuite/gfortran.dg/random_seed_1.f90
new file mode 100644
index 000000000..ccbcf00cf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/random_seed_1.f90
@@ -0,0 +1,49 @@
+! { dg-do compile }
+
+! Emit a diagnostic for too small PUT array at compile time
+! See PR fortran/37159
+
+! Possible improvement:
+! Provide a separate testcase for systems that support REAL(16),
+! to test the minimum size of 12 (instead of 8).
+!
+! Updated to check for arrays of unexpected size,
+! this also works for -fdefault-integer-8.
+!
+
+PROGRAM random_seed_1
+  IMPLICIT NONE
+
+  ! Find out what the's largest kind size
+  INTEGER, PARAMETER :: k1 = kind (0.d0)
+  INTEGER, PARAMETER :: &
+    k2 = max (k1, selected_real_kind (precision (0._k1) + 1))
+  INTEGER, PARAMETER :: &
+    k3 = max (k2, selected_real_kind (precision (0._k2) + 1))
+  INTEGER, PARAMETER :: &
+    k4 = max (k3, selected_real_kind (precision (0._k3) + 1))
+
+  INTEGER, PARAMETER :: nbytes = MERGE(48, 32, k4 == 16)
+
+  ! '+1' to avoid out-of-bounds warnings
+  INTEGER, PARAMETER    :: n = nbytes / KIND(n) + 1
+  INTEGER, DIMENSION(n) :: seed
+
+  ! Get seed, array too small
+  CALL RANDOM_SEED(GET=seed(1:(n-2)))  ! { dg-error "too small" }
+
+  ! Get seed, array bigger than necessary
+  CALL RANDOM_SEED(GET=seed(1:n))
+
+  ! Get seed, proper size
+  CALL RANDOM_SEED(GET=seed(1:(n-1)))
+
+  ! Put too few bytes
+  CALL RANDOM_SEED(PUT=seed(1:(n-2)))  ! { dg-error "too small" }
+
+  ! Put too many bytes
+  CALL RANDOM_SEED(PUT=seed(1:n))
+
+  ! Put the right amount of bytes
+  CALL RANDOM_SEED(PUT=seed(1:(n-1)))
+END PROGRAM random_seed_1
diff --git a/gcc/testsuite/gfortran.dg/random_seed_2.f90 b/gcc/testsuite/gfortran.dg/random_seed_2.f90
new file mode 100644
index 000000000..52728f819
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/random_seed_2.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! PR 44595: INTENT of arguments to intrinsic procedures not checked
+!
+! Contributed by Steve Kargl <kargl@gcc.gnu.org>
+
+subroutine reset_seed(iseed)
+    implicit none
+    integer, intent(in) :: iseed
+    call random_seed(iseed)        ! { dg-error "cannot be INTENT.IN." }
+end subroutine reset_seed
diff --git a/gcc/testsuite/gfortran.dg/rank_1.f90 b/gcc/testsuite/gfortran.dg/rank_1.f90
new file mode 100644
index 000000000..6a81e410b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/rank_1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
+! Fortran < 2008 allows 7  dimensions
+! Fortran   2008 allows 15 dimensions (including co-array ranks)
+!
+! FIXME: Rank patch was reverted because of PR 36825.
+integer :: a(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) ! { dg-error "has more than 7 dimensions" }
+integer :: b(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16) ! { dg-error "has more than 7 dimensions" }
+end
diff --git a/gcc/testsuite/gfortran.dg/rank_2.f90 b/gcc/testsuite/gfortran.dg/rank_2.f90
new file mode 100644
index 000000000..cd52cc446
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/rank_2.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! Fortran < 2008 allows 7  dimensions
+! Fortran   2008 allows 15 dimensions (including co-array ranks)
+!
+integer :: a(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) ! { dg-error "more than 7 dimensions" }
+
+! PR fortran/36825:
+integer,parameter                        :: N=10
+complex,dimension(-N:N,-N:N,0:1,0:1,-N:N,-N:N,0:1,0:1)   :: P ! { dg-error "more than 7 dimensions" }
+end
diff --git a/gcc/testsuite/gfortran.dg/read_1.f90 b/gcc/testsuite/gfortran.dg/read_1.f90
new file mode 100644
index 000000000..27f2a1124
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_1.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+!
+! Cf. PR fortran/33232
+program test
+  implicit none
+  integer :: a
+  READ *, a
+  READ '(i3)', a
+end program test
diff --git a/gcc/testsuite/gfortran.dg/read_2.f90 b/gcc/testsuite/gfortran.dg/read_2.f90
new file mode 100644
index 000000000..d12dcef71
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_2.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+!
+! PR fortran/34404
+!
+! Contributed by Joost VandeVondele.
+!
+implicit none
+complex :: x
+character(len=80) :: t="(1.0E-7,4.0E-3)"
+read(t,*) x
+if (real(x) /= 1.0e-7 .or. aimag(x)/=4.0e-3) call abort()
+END
diff --git a/gcc/testsuite/gfortran.dg/read_bad_advance.f90 b/gcc/testsuite/gfortran.dg/read_bad_advance.f90
new file mode 100644
index 000000000..539ada496
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_bad_advance.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! PR27138 Failure to advance line on bad list directed read.
+! Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+      program test
+      implicit none
+      integer :: ntype = 55
+      real    :: rtype
+      complex :: ctype
+      logical :: ltype
+      OPEN (10, status="scratch")
+      write(10,*) "aaaa aaaa aaaa aaaa"
+      write(10,*) "bbbb bbbb bbbb bbbb"
+      write(10,*) "cccc cccc cccc cccc"
+      write(10,*) "dddd dddd dddd dddd"
+      write(10,*) "  "
+      write(10,*) "1234 5678 9012 3456"
+      rewind(10)
+      READ (10,*,END=77,ERR=77) ntype
+      goto 99
+   77 READ (10,*,END=78,ERR=78) rtype
+      goto 99
+   78 READ (10,*,END=79,ERR=79) ctype
+      goto 99
+   79 READ (10,*,END=80,ERR=80) ltype
+      goto 99
+   80 READ (10,*,END=99,ERR=99) ntype
+      if (ntype.ne.1234) goto 99
+      close(10)
+      stop
+   99 close(10)
+      call abort()
+      end program test
diff --git a/gcc/testsuite/gfortran.dg/read_comma.f b/gcc/testsuite/gfortran.dg/read_comma.f
new file mode 100644
index 000000000..024fceae7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_comma.f
@@ -0,0 +1,26 @@
+! { dg-do run { target fd_truncate } }
+! PR25039 This test checks that commas in input fields for formatted sequential
+! reads are interpreted as the read completion.  If no comma is encountered the
+! normal field width determines the end of the read.  The test case also checks
+! that default blanks are interpreted as NULL in numerics.
+! Test case derived from sample provided in PR by Iwan Kawrakow.
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+!
+      program pr25039
+      implicit none
+      integer :: i1, i2, i3
+      character(10) :: a1
+      open(10, status="scratch")
+      write(10,'(a)') "1, 235"
+      rewind(10)
+      read(10,'(3i2)') i1,i2,i3
+      if(i1.ne.1) call abort()
+      if(i2.ne.2) call abort()
+      if(i3.ne.35) call abort()
+      rewind(10)
+!     Make sure commas are read in character strings.      
+      write(10,'(a)') "1234,6789,"
+      rewind(10)
+      read(10,'(a10)') a1
+      if(a1.ne."1234,6789,") call abort()
+      end
diff --git a/gcc/testsuite/gfortran.dg/read_empty_file.f b/gcc/testsuite/gfortran.dg/read_empty_file.f
new file mode 100644
index 000000000..d4077481b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_empty_file.f
@@ -0,0 +1,7 @@
+! { dg-do run }
+! PR43320 Missing EOF on read from empty file.
+      open(8,status='scratch',form='formatted')  ! Create empty file
+      read(8,'(a80)', end=123)  ! Reading from an empty file should be an EOF
+      call abort
+123   continue
+      end
diff --git a/gcc/testsuite/gfortran.dg/read_eof_1.f90 b/gcc/testsuite/gfortran.dg/read_eof_1.f90
new file mode 100644
index 000000000..78ff14a5d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_eof_1.f90
@@ -0,0 +1,27 @@
+! { dg-do run { target fd_truncate } }
+! PR25697 Check that reading from a file that is at end-of-file does not
+! segfault or give error.  Test case derived from example in PR from Dale Ranta.
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+       integer data(9)
+       do i = 1,9
+         data(i)=-3
+       enddo
+       open(unit=11,status='scratch',form='unformatted')
+       write(11)data
+       read(11,end=        1000 )data
+       call abort()
+ 1000  continue
+       backspace 11
+       backspace 11
+       write(11)data
+       rewind 11
+       data = 0
+       read(11,end=        1001 )data
+ 1001  continue
+       read(11,end=        1002 )data
+       call abort
+ 1002  continue
+       if (.not. all(data == -3)) call abort()
+       close(11)
+       end
+
diff --git a/gcc/testsuite/gfortran.dg/read_eof_2.f90 b/gcc/testsuite/gfortran.dg/read_eof_2.f90
new file mode 100644
index 000000000..9017548d4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_eof_2.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! PR25835 Check that reading from a file that is at end-of-file does not
+! segfault or give error.  Test case derived from example in PR from Dale Ranta.
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+       integer data(2045) ! Exceed internal buffer size
+       data=-1
+       open(unit=11,status='scratch', form='unformatted')
+       write(11)data
+       read(11,end=        1000 )data
+       call abort()
+ 1000  continue
+       backspace 11
+       backspace 11
+       data = 0
+       read(11)data
+       if (.not. all(data == -1)) call abort()
+       read(11,end=        1002 )data
+       call abort()
+ 1002  continue
+       close(11)
+       end
diff --git a/gcc/testsuite/gfortran.dg/read_eof_3.f90 b/gcc/testsuite/gfortran.dg/read_eof_3.f90
new file mode 100644
index 000000000..af35aa6d3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_eof_3.f90
@@ -0,0 +1,31 @@
+! { dg-do run { target fd_truncate } }
+! PR25835 Check that reading from a file that is at end-of-file does not
+! segfault or give error.  Test case derived from example in PR from Dale Ranta.
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+       integer data(5000)
+       data=-256
+       open(unit=11,status='scratch', form='unformatted')
+       write(11)data
+       write(11)data
+       read(11,end=        1000 )data
+       call abort()
+ 1000  continue
+       backspace 11
+       rewind 11
+       write(11)data
+       read(11,end=        1001 )data
+       call abort()
+ 1001  continue
+       data = 0
+       backspace 11
+       rewind 11
+       read(11,end=        1002 )data
+       if (.not. all(data == -256)) call abort()
+ 1002  continue
+       read(11,end=        1003 )data
+       call abort()
+ 1003  continue
+       close(11)
+       end
+
+
diff --git a/gcc/testsuite/gfortran.dg/read_eof_4.f90 b/gcc/testsuite/gfortran.dg/read_eof_4.f90
new file mode 100644
index 000000000..ee95268d5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_eof_4.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! PR 27575 and PR 30009: This test checks the error checking for end
+! of file condition.
+! Derived from test case in PR.
+! Submitted by Jerry DeLisle <jvdelisle@verizon.net>, modified by
+! Thomas Koenig <Thomas.Koenig@online.de>
+
+      program test
+      integer i1,i2,i3
+      open(unit=11,form='unformatted')
+      write (11) 1, 2
+      write (11) 3, 4
+      close(11,status='keep')
+
+      open(unit=11,form='unformatted')
+
+      read(11, ERR=100) i1, i2, i3
+      call abort()
+  100 continue
+      if (i1 /= 1 .or. i2 /= 2) call abort
+
+      read(11, ERR=110) i1, i2, i3
+      call abort()
+  110 continue
+      if (i1 /= 3 .or. i2 /= 4) call abort
+
+      read(11, end=120) i3
+      call abort()
+ 120  close(11,status='delete')
+      end
diff --git a/gcc/testsuite/gfortran.dg/read_eof_5.f90 b/gcc/testsuite/gfortran.dg/read_eof_5.f90
new file mode 100644
index 000000000..3c606a024
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_eof_5.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! PR34560 I/O internal read: END expected, but no failure
+program main
+  character(len=2) :: line
+  character(len=1) :: a(3)
+  a = "x"
+  line = 'ab'
+  read (line,'(A)',END=99) a
+  call abort
+  99 continue 
+  if (any(a /= ['a','x','x'])) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/read_eof_6.f b/gcc/testsuite/gfortran.dg/read_eof_6.f
new file mode 100644
index 000000000..d4077481b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_eof_6.f
@@ -0,0 +1,7 @@
+! { dg-do run }
+! PR43320 Missing EOF on read from empty file.
+      open(8,status='scratch',form='formatted')  ! Create empty file
+      read(8,'(a80)', end=123)  ! Reading from an empty file should be an EOF
+      call abort
+123   continue
+      end
diff --git a/gcc/testsuite/gfortran.dg/read_eof_7.f90 b/gcc/testsuite/gfortran.dg/read_eof_7.f90
new file mode 100644
index 000000000..a478f06c7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_eof_7.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! PR43517 Spurious EOF condition when namelist read follows formatted read
+! Test case from the problem reporter - Michael Richmond
+program main
+  namelist /name/ j
+  open (10,status='scratch',form='formatted')
+  write(10,'(a)') "999999"
+  write(10,'(a)') " $name"
+  write(10,'(a)') "  j=73,"
+  write(10,'(a)') " /"
+  rewind(10)
+  i = 54321
+  idum = 6789
+  read (10,'(2i5,4x)') i, idum ! Trailing 4x was setting EOF condition
+  if (i /= 99999 .and. idum /= 9) call abort
+  j = 12345
+  read (10,name) ! EOF condition tripped here.
+  if (j /= 73) call abort
+end program main
+
diff --git a/gcc/testsuite/gfortran.dg/read_eof_8.f90 b/gcc/testsuite/gfortran.dg/read_eof_8.f90
new file mode 100644
index 000000000..7436a2b1b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_eof_8.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! PR43265: See comment #26 in the PR.  Before patch,
+! the test case would fail to read the last line of the file.
+! Thanks to Jean-Baptiste Faure for providing the initial test case.
+program test
+  character (len=6) :: line
+  integer :: n, k=0
+  open(unit=25,file="test.dat",status="replace", &
+       & form="unformatted", access="stream")
+  write(25) "Line 1" // char(10)
+  write(25) "Line 2" // char(10)
+  write(25) "Line 3" // char(10)
+  write(25) "Line 4" // char(10)
+  write(25) "Line 5" ! No EOR marker on the last line.
+  close(25, status="keep")
+  open(25, file="test.dat", status="old")
+  do n=1,10
+   read(25,'(a)',end=100,err=101) line
+   k = k+1
+  enddo
+  call abort
+100 if (k /= 5) call abort
+  stop
+101 call abort
+end program test
+
diff --git a/gcc/testsuite/gfortran.dg/read_eof_all.f90 b/gcc/testsuite/gfortran.dg/read_eof_all.f90
new file mode 100644
index 000000000..db6def487
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_eof_all.f90
@@ -0,0 +1,71 @@
+! { dg-do run }
+! PR43265 Followup patch for miscellaneous EOF conditions.
+! Eaxamples from Tobius Burnus 
+  use iso_fortran_env
+  character(len=2) :: str, str2(2)
+  integer :: a, b, c, ios
+  str = ''
+  str2 = ''
+
+  open(99,file='test.dat',access='stream',form='unformatted', status='replace')
+  write(99) ' '
+  close(99)
+ 
+  open(99,file='test.dat')
+  read(99, '(T7,i2)') i
+  close(99, status="delete")
+  if (i /= 0) call abort
+
+  read(str(1:0), '(T7,i1)') i
+  if (i /= 0) call abort
+
+  read(str,'(i2,/,i2)',end=111) a, b
+  call abort !stop 'ERROR: Expected EOF error (1)'
+  111 continue
+
+  read(str2,'(i2,/,i2)',end=112) a, b
+
+  read(str2,'(i2,/,i2,/,i2)',end=113) a, b, c
+  call abort !stop 'ERROR: Expected EOF error (2)'
+
+  112 call abort !stop 'ERROR: Unexpected EOF (3)'
+
+  113 continue
+  read(str,'(i2,/,i2)',end=121,pad='no') a, b
+  call abort !stop 'ERROR: Expected EOF error (1)'
+  121 continue
+
+  read(str2(:),'(i2,/,i2)', end=122, pad='no') a, b
+  goto 125
+  122 call abort !stop 'ERROR: Expected no EOF error (2)'
+  125 continue
+
+  read(str2(:),'(i2,/,i2,/,i2)',end=123,pad='no') a, b, c
+  call abort !stop 'ERROR: Expected EOF error (3)'
+  123 continue
+
+  read(str(2:1),'(i2,/,i2)',end=131, pad='no') a, b
+  call abort !stop 'ERROR: Expected EOF error (1)'
+  131 continue
+
+  read(str2(:)(2:1),'(i2,/,i2)',end=132, pad='no') a, b
+  call abort !stop 'ERROR: Expected EOF error (2)'
+  132 continue
+
+  read(str2(:)(2:1),'(i2,/,i2,/,i2)',end=133,pad='no') a, b, c
+  call abort !stop 'ERROR: Expected EOF error (3)'
+  133 continue
+
+  read(str(2:1),'(i2,/,i2)',iostat=ios, pad='no') a, b
+  if (ios /= IOSTAT_END) call abort !stop 'ERROR: expected iostat /= 0  (1)'
+
+  read(str2(:)(2:1),'(i2,/,i2)',iostat=ios, pad='no') a, b
+  if (ios /= IOSTAT_END) call  abort !stop 'ERROR: expected iostat /= 0  (2)'
+
+  read(str2(:)(2:1),'(i2,/,i2,/,i2)',iostat=ios,pad='no') a, b, c
+  if (ios /= IOSTAT_END) call abort !stop 'ERROR: expected iostat /= 0  (2)'
+
+  ! print *, "success"
+  end
+
+
diff --git a/gcc/testsuite/gfortran.dg/read_eor.f90 b/gcc/testsuite/gfortran.dg/read_eor.f90
new file mode 100644
index 000000000..e6c849eab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_eor.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR24489 Assure that read does not go past the end of record. The width of
+! the format specifier is 8, but the internal unit record length is 4 so only
+! the first 4 characters should be read.
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+program pr24489
+  character*4, dimension(8) :: abuf = (/"0123","4567","89AB","CDEF", &
+                                        "0123","4567","89AB","CDEF"/)
+  character*4, dimension(2,4) :: buf
+  character*8 :: a
+  equivalence (buf,abuf)
+  read(buf, '(a8)') a
+  if (a.ne.'0123') call abort()
+end program pr24489
diff --git a/gcc/testsuite/gfortran.dg/read_float_1.f90 b/gcc/testsuite/gfortran.dg/read_float_1.f90
new file mode 100644
index 000000000..0848ee675
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_float_1.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR18218
+! The IO library has an algorithm that involved repeated multiplication by 10,
+! resulting in introducing large cumulative floating point errors.
+program foo
+  character*20 s
+  real(kind=8) d
+  s = "-.18774312893273    "
+  read(unit=s, fmt='(g20.14)') d
+  if (d + 0.18774312893273d0 .gt. 1d-13) call abort
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/read_float_2.f03 b/gcc/testsuite/gfortran.dg/read_float_2.f03
new file mode 100644
index 000000000..29344bcb5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_float_2.f03
@@ -0,0 +1,18 @@
+! { dg-do run }
+! Contributed by Dominique Dhumieres <dominiq@lps.ens.fr>
+
+character(15) :: str="+ .339  567+2"
+real, parameter :: should_be = .339567e2
+real, parameter :: eps = 10 * epsilon (should_be)
+real :: x, y
+
+read(str,'(BN,F15.6)') x
+print *, x
+read(str,'(G15.7)') y
+print *, y
+
+if (abs (x - should_be) > eps .or. abs (y - should_be) > eps) then
+  call abort ()
+end if
+
+end
diff --git a/gcc/testsuite/gfortran.dg/read_float_3.f90 b/gcc/testsuite/gfortran.dg/read_float_3.f90
new file mode 100644
index 000000000..0fa2f5c4e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_float_3.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! Contributed by Dominique Dhumieres <dominiq@lps.ens.fr>
+
+character(100) :: str1 = &
+  "123.00456.88 0.123E+01  +0.987+1 -0.2345+02 -0.6879E+2+0.7E+03 0.4E+03" 
+character(100), parameter :: should_be = &
+  "123.00456.88 0.123E+01 0.987E+01-0.2345E+02-0.6879E+02 0.7E+03 0.4E+03"
+character(100) :: output
+complex :: c1, c2, c3, c4
+
+100 format ( 2F6.2, 2E10.3, 2E11.4, 2E8.1)
+read (str1,100) c1, c2, c3, c4
+write (output, 100) c1, c2, c3, c4
+
+print *, output
+if (output /= should_be) then
+  print *, should_be
+  call abort ()
+end if
+
+end
diff --git a/gcc/testsuite/gfortran.dg/read_infnan_1.f90 b/gcc/testsuite/gfortran.dg/read_infnan_1.f90
new file mode 100644
index 000000000..c5023e8fe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_infnan_1.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-add-options ieee }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+
+! PR43298  Fortran library does not read in NaN, NaN(), -Inf, or Inf
+
+! Formatted READ part of PR fortran/43298
+
+! Test case prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program pr43298
+  real(4) :: x4(7)
+  real(8) :: x8(7)
+  character(80) :: output
+
+open(10, status='scratch')
+!                0123456789012345678901234567890123456789012345678901234567890123456789
+write(10,'(a)') "inf           nan   infinity  NaN(dx)      -INf    NAN       InFiNiTy"
+rewind(10)
+x4 = 0.0_4
+x8 = 0.0_8
+read(10,'(7f10.3)') x4
+rewind(10)
+read(10,'(7f10.3)') x8
+write (output, '("x4 =",7G6.0)') x4
+if (output.ne."x4 =   Inf   NaN   Inf   NaN  -Inf   NaN   Inf") call abort
+write (output, '("x8 =",7G6.0)') x8
+if (output.ne."x8 =   Inf   NaN   Inf   NaN  -Inf   NaN   Inf") call abort
+!print '("x4 =",7G6.0)', x4
+!print '("x8 =",7G6.0)', x8
+end program pr43298
+
diff --git a/gcc/testsuite/gfortran.dg/read_list_eof_1.f90 b/gcc/testsuite/gfortran.dg/read_list_eof_1.f90
new file mode 100644
index 000000000..c33bc2e09
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_list_eof_1.f90
@@ -0,0 +1,54 @@
+! { dg-do run }
+! PR 49296 List formatted read of file without EOR marker (\n).
+program read_list_eof_1
+  implicit none
+  character(len=100) :: s
+  integer :: ii
+  real :: rr
+  logical :: ll
+
+  call genfil ('a')
+  open (unit=20, file='read.dat', form='FORMATTED', action='READ', &
+       status='OLD')
+  read (20, fmt=*) s
+  close (20, status='delete')
+  if (trim(s) /= "a") then
+     call abort ()
+  end if
+
+  call genfil ('1')
+  open (unit=20, file='read.dat', form='FORMATTED', action='READ', &
+       status='OLD')
+  read (20, fmt=*) ii
+  close (20, status='delete')
+  if (ii /= 1) then
+     call abort ()
+  end if
+
+  call genfil ('1.5')
+  open (unit=20, file='read.dat', form='FORMATTED', action='READ', &
+       status='OLD')
+  read (20, fmt=*) rr
+  close (20, status='delete')
+  if (rr /= 1.5) then
+     call abort ()
+  end if
+
+  call genfil ('T')
+  open (unit=20, file='read.dat', form='FORMATTED', action='READ', &
+       status='OLD')
+  read (20, fmt=*) ll
+  close (20, status='delete')
+  if (.not. ll) then
+     call abort ()
+  end if
+
+contains
+  subroutine genfil(str)
+    character(len=*), intent(in) :: str
+    open(10, file='read.dat', form='unformatted', action='write', &
+         status='replace', access='stream')
+    write(10) str
+    close(10)
+  end subroutine genfil
+end program read_list_eof_1
diff --git a/gcc/testsuite/gfortran.dg/read_logical.f90 b/gcc/testsuite/gfortran.dg/read_logical.f90
new file mode 100644
index 000000000..7b7ba8c3a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_logical.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR 26554 : Test logical read from string. Test case derived from PR.
+! Submitted by Jerry DeLisle <jvdelisle@verizon.net>.
+program bug
+  implicit none
+  character*30 :: strg
+  logical l
+  l = .true.
+  strg = "false"
+  read (strg,*) l
+  if (l) call abort()
+  strg = "true"
+  read (strg,*) l
+  if (.not.l) call abort()
+  end
+
diff --git a/gcc/testsuite/gfortran.dg/read_many_1.f b/gcc/testsuite/gfortran.dg/read_many_1.f
new file mode 100644
index 000000000..4fac689ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_many_1.f
@@ -0,0 +1,24 @@
+!{ dg-do run }
+! PR26423 Large file I/O error related to buffering
+! Test case derived from case by Dale Ranta.
+! Submitted  by Jerry DeLisle  <jvdelisle@gcc.gnu.org> 
+      integer :: a(3000) , b(2048)
+      a=3
+      b=5
+      a(1) = 1
+      a(3000)=1234
+      write(2) a
+      b(1) = 2
+      b(2048) = 5678
+      write(2) b
+      rewind 2
+      read(2) a
+      read(2) b
+      if (a(1).ne.1) call abort()
+      if (a(2).ne.3) call abort()
+      if (b(1).ne.2) call abort()
+      if (b(2).ne.5) call abort()
+      if (a(3000).ne.1234) call abort()
+      if (b(2048).ne.5678) call abort()
+      close(2, status='delete')
+      end
diff --git a/gcc/testsuite/gfortran.dg/read_no_eor.f90 b/gcc/testsuite/gfortran.dg/read_no_eor.f90
new file mode 100644
index 000000000..118816405
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_no_eor.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+! Handle eor and eof conditions with missing eor in file.
+! Test case modified from case presented by Ian Harvey on clf.
+program eieio_stat
+  use, intrinsic :: iso_fortran_env, only: iostat_end, iostat_eor
+  implicit none
+  integer, parameter :: unit=10
+  integer :: ios1, ios2, ios3
+  character(25) :: buffer
+  character(100) :: themessage
+  !****
+  open(10,file="eieio", form="unformatted", access="stream", status="replace")
+  write(10) "Line-1" // char(10)
+  write(10) "Line-2"
+  close(10)
+
+  open(10,file="eieio")
+  
+  buffer = 'abcdefg'
+  read (unit,"(a)",advance="no",iostat=ios1, pad="yes") buffer
+  if (ios1 /= iostat_eor .and. buffer /= "Line-1") call abort
+
+  buffer = '<'
+  read (unit,"(a)",advance="no",iostat=ios2,pad="yes") buffer
+  if (ios2 /= iostat_eor .and. buffer /= "Line-2") call abort
+  
+  buffer = '5678'
+  read (unit,"(a)",advance="no",iostat=ios3, iomsg=themessage) buffer
+  if (ios3 /= iostat_end .and. buffer /= "5678") call abort
+
+  rewind(10)
+
+  buffer = "abcdefg"
+  read (unit,"(a)",advance="no",iostat=ios1, pad="no") buffer
+  if (ios1 /= iostat_eor .and. buffer /= "abcdefg") call abort
+
+  buffer = '<'
+  read (unit,"(a)",advance="no",iostat=ios2,pad="no") buffer
+  if (ios2 /= iostat_eor .and. buffer /= "<") call abort
+
+  buffer = '1234'
+  read (unit,"(a)",advance="no",iostat=ios3, iomsg=themessage) buffer
+  if (ios3 <= 0 .and. buffer /= "1234") call abort
+  
+  close(unit, status="delete")
+end program eieio_stat 
diff --git a/gcc/testsuite/gfortran.dg/read_noadvance.f90 b/gcc/testsuite/gfortran.dg/read_noadvance.f90
new file mode 100644
index 000000000..e55763ad8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_noadvance.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! pr24719, non-advancing read should read more than one line
+! test contributed by jerry delisle <jvdelisle@gcc.gnu.org>
+      implicit none
+      character(1) :: chr
+      character(20) :: correct = 'foo: bar 123abc'
+      integer :: i
+      open(unit = 11, status = "scratch", action="readwrite")
+      write(11,'(a)') "foo: bar"
+      write(11,'(a)') "123abc"
+      rewind(11)
+      i = 0
+      do
+        i = i + 1
+10      read(unit = 11, fmt = '(a)', advance = 'no', end = 99, eor = 11) chr
+        if (chr.ne.correct(i:i)) call abort()
+        cycle
+11      continue
+      end do
+99    close(11)
+      end
diff --git a/gcc/testsuite/gfortran.dg/read_repeat.f90 b/gcc/testsuite/gfortran.dg/read_repeat.f90
new file mode 100644
index 000000000..e0bf39ee0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_repeat.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! PR39528 repeated entries not read when using list-directed input.
+! Test case derived from reporters example.
+program rread
+  implicit none
+  integer :: iarr(1:7), ia, ib, i
+
+  iarr = 0
+  
+  open(10, status="scratch")
+  write(10,*) " 2*1  3*2 /"
+  write(10,*) " 12"
+  write(10,*) " 13"
+  rewind(10)
+
+  read(10,*) (iarr(i), i=1,7)
+  read(10,*) ia, ib
+
+  if (any(iarr(1:2).ne.1)) call abort
+  if (any(iarr(3:5).ne.2)) call abort
+  if (any(iarr(6:7).ne.0)) call abort
+  if (ia .ne. 12 .or. ib .ne. 13) call abort
+  
+  close(10)
+end program rread
diff --git a/gcc/testsuite/gfortran.dg/read_size_noadvance.f90 b/gcc/testsuite/gfortran.dg/read_size_noadvance.f90
new file mode 100644
index 000000000..e611547b6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_size_noadvance.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! PR26890 Test for use of SIZE variable in IO list.
+! Test case from Paul Thomas.
+! Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+  character(80) :: buffer, line
+  integer :: nchars
+  line = "The quick brown fox jumps over the lazy dog."
+  open (10, status="scratch")
+  write (10, '(a)') trim(line)
+  rewind (10)
+  read (10, '(a)', advance = 'no', size = nchars, eor = 998) buffer
+  call abort()
+998 if (nchars.ne.44) call abort()
+  rewind (10)
+  buffer = "how about some random text here just to be sure on this one."
+  nchars = 80
+  read (10, '(a)', advance = 'no', size = nchars, eor = 999) buffer(:nchars)
+999 if (nchars.ne.44) call abort()
+  if (buffer.ne.line) call abort()
+  close (10)
+end
+
diff --git a/gcc/testsuite/gfortran.dg/read_x_eof.f90 b/gcc/testsuite/gfortran.dg/read_x_eof.f90
new file mode 100644
index 000000000..f79f78522
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_x_eof.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! PR43265 No EOF condition if reading with '(x)' from an empty file
+! Test case from the reporter.
+program pr43265
+implicit none
+integer::i
+open(23,status="scratch")
+write(23,'(a)') "Line 1"
+write(23,'(a)') "Line 2"
+write(23,'(a)') "Line 3"
+rewind(23)
+do i=1,10
+  read(23,'(1x)',end=12)
+enddo
+12 if (i.ne.4) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/read_x_eor.f90 b/gcc/testsuite/gfortran.dg/read_x_eor.f90
new file mode 100644
index 000000000..064835a8b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_x_eor.f90
@@ -0,0 +1,10 @@
+! { dg-do run }
+! ( dg-output "^" }
+!
+! Test fix for pr24785 - EOR used to scrub the 2X.
+! Reduced from PR example submitted by Harald Anlauf <anlauf@gmx.de>
+!
+     program x_with_advance_bug
+     write (*,'(A,2X)',  advance="no") "<"
+     write (*,'(A)') ">" ! { dg-output "<  >" }
+     end
diff --git a/gcc/testsuite/gfortran.dg/read_x_past.f b/gcc/testsuite/gfortran.dg/read_x_past.f
new file mode 100644
index 000000000..eee68d387
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/read_x_past.f
@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-options -w }
+! PR 26661 : Test reading X's past file end with no LF or CR.
+! PR 26880 : Tests that rewind clears the gfc_unit read_bad flag.
+! PR 43265 : Tests that no error occurs with or without X at end.
+! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>.
+      implicit none
+      character(3) a(4)
+      integer i
+      open (10, status="scratch")
+ 10   format(A,$)  ! This is not pedantic
+      write(10,10)' abc def ghi jkl'
+      rewind(10)
+
+      a = ""
+      read(10,20)(a(i),i=1,4)
+      if (a(4).ne."jkl") call abort()
+
+      rewind(10)
+
+      a = ""
+      read(10,30)(a(i),i=1,4)
+      if (a(4).ne."jkl") call abort()
+
+ 20   format(1x,a3,1x,a3,1x,a3,1x,a3,10x)
+ 30   format(1x,a3,1x,a3,1x,a3,1x,a3)
+      close(10)
+      end
diff --git a/gcc/testsuite/gfortran.dg/readwrite_unf_direct_eor_1.f90 b/gcc/testsuite/gfortran.dg/readwrite_unf_direct_eor_1.f90
new file mode 100644
index 000000000..2c19eba39
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/readwrite_unf_direct_eor_1.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! PR 30056 - exceeding the record length was misrepresented as an EOF
+!            on read and ignored on write 
+      program main
+      integer i,j
+      open (10, form="unformatted", access="direct", recl=4)
+      write (10, rec=1, err=10) 1,2
+      call abort()
+ 10   continue
+      read (10,  rec=1, err=20) i, j
+      call abort()
+ 20   continue
+      end
diff --git a/gcc/testsuite/gfortran.dg/real_const_1.f b/gcc/testsuite/gfortran.dg/real_const_1.f
new file mode 100644
index 000000000..97b7f278b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/real_const_1.f
@@ -0,0 +1,24 @@
+c { dg-do run }
+c
+c Fixed form test program for PR 17941 (signed constants with spaces)
+c
+      program real_const_1
+      complex c0, c1, c2, c3, c4
+      real rp(4), rn(4)
+      parameter (c0 = (-0.5, -     0.5))
+      parameter (c1 = (-     0.5, +     0.5))
+      parameter (c2 = (-    0.5E2, +0.5))
+      parameter (c3 = (-0.5, +     0.5E-2))
+      parameter (c4 = (-     1, +     1))
+      data rn /- 1.0, - 1d0, - 1.d0, - 10.d-1/
+      data rp /+ 1.0, + 1d0, + 1.d0, + 10.d-1/
+      real, parameter :: del = 1.e-5
+
+      if (abs(c0 - cmplx(-0.5,-0.5)) > del) call abort
+      if (abs(c1 - cmplx(-0.5,+0.5)) > del) call abort
+      if (abs(c2 - cmplx(-0.5E2,+0.5)) > del) call abort
+      if (abs(c3 - cmplx(-0.5,+0.5E-2)) > del) call abort
+      if (abs(c4 - cmplx(-1.0,+1.0)) > del) call abort
+      if (any (abs (rp - 1.0) > del)) call abort
+      if (any (abs (rn + 1.0) > del)) call abort
+      end program
diff --git a/gcc/testsuite/gfortran.dg/real_const_2.f90 b/gcc/testsuite/gfortran.dg/real_const_2.f90
new file mode 100644
index 000000000..552012e37
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/real_const_2.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+!
+! Free form test program for PR 17941 (signed constants with spaces)
+!
+program real_const_2
+  complex c0, c1, c2, c3, c4
+  real rp(4), rn(4)
+  parameter (c0 = (-0.5, -     0.5))
+  parameter (c1 = (-     0.5, +     0.5))
+  parameter (c2 = (-    0.5E2, +0.5))
+  parameter (c3 = (-0.5, +     0.5E-2))
+  parameter (c4 = (-     1, +     1))
+  data rn /- 1.0, - 1d0, - 1.d0, - 10.d-1/
+  data rp /+ 1.0, + 1d0, + 1.d0, + 10.d-1/
+  real, parameter :: del = 1.e-5
+
+  if (abs(c0 - cmplx(-0.5,-0.5)) > del) call abort
+  if (abs(c1 - cmplx(-0.5,+0.5)) > del) call abort
+  if (abs(c2 - cmplx(-0.5E2,+0.5)) > del) call abort
+  if (abs(c3 - cmplx(-0.5,+0.5E-2)) > del) call abort
+  if (abs(c4 - cmplx(-1.0,+1.0)) > del) call abort
+  if (any (abs (rp - 1.0) > del)) call abort
+  if (any (abs (rn + 1.0) > del)) call abort
+end program
diff --git a/gcc/testsuite/gfortran.dg/real_const_3.f90 b/gcc/testsuite/gfortran.dg/real_const_3.f90
new file mode 100644
index 000000000..9f3f5d837
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/real_const_3.f90
@@ -0,0 +1,56 @@
+!{ dg-do run }
+!{ dg-options "-fno-range-check" }
+!{ dg-add-options ieee }
+!{ dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+! PR19310 and PR19904, allow disabling range check during compile.
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program main
+  character(len=80) str
+  real, parameter :: zero=0, nan=0/zero
+  complex :: z = (-0.1,-2.2)/(0.0,0.0)
+  complex :: z2 = (0.1,1)/0
+  complex :: z3 = (1e35, -2e3)/1.234e-37
+  complex :: z4 = (1e-35, -2e-35)/1234e34
+  real :: a
+  a = exp(1000.0)
+  b = 1/exp(1000.0)
+
+  write(str,*) a
+  if (trim(adjustl(str)) .ne. 'Infinity') call abort
+
+  if (b .ne. 0.) call abort
+
+  write(str,*) -1.0/b
+  if (trim(adjustl(str)) .ne. '-Infinity') call abort
+
+  write(str,*) b/0.0
+  if (trim(adjustl(str)) .ne. 'NaN') call abort
+
+  write(str,*) 0.0/0.0
+  if (trim(adjustl(str)) .ne. 'NaN') call abort
+
+  write(str,*) 1.0/(-0.)
+  if (trim(adjustl(str)) .ne. '-Infinity') call abort
+
+  write(str,*) -2.0/0.
+  if (trim(adjustl(str)) .ne. '-Infinity') call abort
+
+  write(str,*) 3.0/0.
+  if (trim(adjustl(str)) .ne. 'Infinity') call abort
+
+  write(str,*)  nan
+  if (trim(adjustl(str)) .ne. 'NaN') call abort
+
+  write(str,*) z
+  if (trim(adjustl(str)) .ne. '(            NaN,            NaN)') call abort
+
+  write(str,*) z2
+  if (trim(adjustl(str)) .ne. '(            NaN,            NaN)') call abort
+
+  write(str,*) z3
+  if (trim(adjustl(str)) .ne. '(       Infinity,      -Infinity)') call abort
+
+  write(str,*) z4
+  if (trim(adjustl(str)) .ne. '(  0.0000000    , -0.0000000    )') call abort
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/real_dimension_1.f b/gcc/testsuite/gfortran.dg/real_dimension_1.f
new file mode 100644
index 000000000..73e9131aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/real_dimension_1.f
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! PR 34305 - make sure there's an error message for specifying a
+      program test
+      parameter (datasize = 1000) 
+      dimension idata (datasize)  ! { dg-error "must be of INTEGER type|must have constant shape" }
+      idata (1) = -1
+      end
diff --git a/gcc/testsuite/gfortran.dg/real_do_1.f90 b/gcc/testsuite/gfortran.dg/real_do_1.f90
new file mode 100644
index 000000000..95fb47378
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/real_do_1.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-warning "Loop variable" "Loop" { target *-*-* } 13 }
+! { dg-warning "Start expression" "Start" { target *-*-* } 13 }
+! { dg-warning "End expression" "End" { target *-*-* } 13 }
+! { dg-warning "Step expression" "Step" { target *-*-* } 13 }
+! Test REAL type iterators in DO loops
+program real_do_1
+  real x, y
+  integer n
+
+  n = 0
+  y = 1.0
+  do x = 1.0, 2.05, 0.1
+    call check (x, y)
+    y = y + 0.1
+    n = n + 1
+  end do
+  if (n .ne. 11) call abort()
+contains
+subroutine check (a, b)
+  real, intent(in) :: a, b
+
+  if (abs (a - b) .gt. 0.00001) call abort()
+end subroutine
+end program
diff --git a/gcc/testsuite/gfortran.dg/real_index_1.f90 b/gcc/testsuite/gfortran.dg/real_index_1.f90
new file mode 100644
index 000000000..16ceca827
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/real_index_1.f90
@@ -0,0 +1,7 @@
+! { dg-do run }
+! PR 16907 : We didn't support REAL array indices as an extension
+       integer I, A(10)
+       A = 2
+       I=A(1.0) ! { dg-warning "Extension" }
+       if (i/=2) call abort ()
+       end
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_1.f03 b/gcc/testsuite/gfortran.dg/realloc_on_assign_1.f03
new file mode 100644
index 000000000..e80084d97
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_1.f03
@@ -0,0 +1,80 @@
+! { dg-do run }
+! Tests the patch that implements F2003 automatic allocation and
+! reallocation of allocatable arrays on assignment.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+  integer(4), allocatable :: a(:), b(:), c(:,:)
+  integer(4) :: j
+  integer(4) :: src(2:5) = [11,12,13,14]
+  integer(4) :: mat(2:3,5:6)
+  character(4), allocatable :: chr1(:)
+  character(4) :: chr2(2) = ["abcd", "wxyz"]
+
+  allocate(a(1))
+  mat = reshape (src, [2,2])
+
+  a = [4,3,2,1]
+  if (size(a, 1) .ne. 4) call abort
+  if (any (a .ne. [4,3,2,1])) call abort
+
+  a = [((42 - i), i = 1, 10)]
+  if (size(a, 1) .ne. 10) call abort
+  if (any (a .ne. [((42 - i), i = 1, 10)])) call abort
+
+  b = a
+  if (size(b, 1) .ne. 10) call abort
+  if (any (b .ne. a)) call abort
+
+  a = [4,3,2,1]
+  if (size(a, 1) .ne. 4) call abort
+  if (any (a .ne. [4,3,2,1])) call abort
+
+  a = b
+  if (size(a, 1) .ne. 10) call abort
+  if (any (a .ne. [((42 - i), i = 1, 10)])) call abort
+
+  j = 20
+  a = [(i, i = 1, j)]
+  if (size(a, 1) .ne. j) call abort
+  if (any (a .ne. [(i, i = 1, j)])) call abort
+
+  a = foo (15)
+  if (size(a, 1) .ne. 15) call abort
+  if (any (a .ne. [((i + 15), i = 1, 15)])) call abort
+
+  a = src
+  if (lbound(a, 1) .ne. lbound(src, 1)) call abort
+  if (ubound(a, 1) .ne. ubound(src, 1)) call abort
+  if (any (a .ne. [11,12,13,14])) call abort
+
+  k = 7
+  a = b(k:8)
+  if (lbound(a, 1) .ne. lbound (b(k:8), 1)) call abort
+  if (ubound(a, 1) .ne. ubound (b(k:8), 1)) call abort
+  if (any (a .ne. [35,34])) call abort
+
+  c = mat
+  if (any (lbound (c) .ne. lbound (mat))) call abort
+  if (any (ubound (c) .ne. ubound (mat))) call abort
+  if (any (c .ne. mat)) call abort
+
+  deallocate (c)
+  c = mat(2:,:)
+  if (any (lbound (c) .ne. lbound (mat(2:,:)))) call abort
+
+  chr1 = chr2(2:1:-1)
+  if (lbound(chr1, 1) .ne. 1) call abort
+  if (any (chr1 .ne. chr2(2:1:-1))) call abort
+
+  b = c(1, :) + c(2, :)
+  if (lbound(b, 1) .ne. lbound (c(1, :) + c(2, :), 1)) call abort
+  if (any (b .ne. c(1, :) + c(2, :))) call abort
+contains
+  function foo (n) result(res)
+    integer(4), allocatable, dimension(:) :: res
+    integer(4) :: n
+    allocate (res(n))
+    res = [((i + 15), i = 1, n)]
+  end function foo
+end
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_10.f90 b/gcc/testsuite/gfortran.dg/realloc_on_assign_10.f90
new file mode 100644
index 000000000..787a56ae9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_10.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR52012 - with realloc_lhs active(ie. default condition) the
+! offset was wrongly calculated for a, after assignment.
+!
+! Reported by Reinhold Bader and Tobias Burnus  <burnus@gcc.gnu.org>
+! 
+program gf
+  implicit none
+  real, allocatable :: a(:,:,:)
+  real, parameter :: zero = 0.0, one = 1.0
+  real :: b(3,4,5) = zero
+  b(1,2,3) = one
+  allocate (a(size (b, 3), size (b, 2), size (b, 1)))
+  a = reshape (b, shape (a), order = [3, 2, 1])
+  if (any (a(:, 2, 1) .ne. [zero, zero, one, zero, zero])) call abort
+  if (a(3, 2, 1) /= one) call abort()
+  if (sum (abs (a)) /= one) call abort()
+end program
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_11.f90 b/gcc/testsuite/gfortran.dg/realloc_on_assign_11.f90
new file mode 100644
index 000000000..ab96bb9de
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_11.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! PR52012 - tests of automatic reallocation on assignment for variable = array_intrinsic
+!
+! Contributed by Tobias Burnus and Dominique Dhumieres
+!
+  integer, allocatable :: a(:), b(:), e(:,:)
+  integer :: c(1:5,1:5), d(1:5,1:5)
+  allocate(b(3))
+  b = [1,2,3]
+
+! Shape conforms so bounds follow allocation.
+  allocate (a(7:9))
+  a = reshape( b, shape=[size(b)])
+  if (any ([lbound(a), ubound(a), size(a), shape (a)] .ne. [7,9,3,3])) call abort
+
+  deallocate (a)
+! 'a' not allocated so lbound defaults to 1.
+  a = reshape( b, shape=[size(b)])
+  if (any ([lbound(a), ubound(a), size(a), shape (a)] .ne. [1,3,3,3])) call abort
+
+  deallocate (a)
+! Shape conforms so bounds follow allocation.
+  allocate (a(0:0))
+  a(0) = 1
+  if (any ([lbound(a), ubound(a), size(a), shape (a)] .ne. [0,0,1,1])) call abort
+
+! 'a' not allocated so lbound defaults to 1.
+  e = matmul (c(2:5,:), d(:, 3:4))
+  if (any ([lbound(e), ubound(e), size(e), shape (e)] .ne. [1,1,4,2,8,4,2])) call abort
+  deallocate (e)
+
+! Shape conforms so bounds follow allocation.
+  allocate (e(4:7, 11:12))
+  e = matmul (c(2:5,:), d(:, 3:4))
+  if (any ([lbound(e), ubound(e), size(e), shape (e)] .ne. [4,11,7,12,8,4,2])) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_12.f90 b/gcc/testsuite/gfortran.dg/realloc_on_assign_12.f90
new file mode 100644
index 000000000..3e0ceb1e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_12.f90
@@ -0,0 +1,96 @@
+! { dg-do run }
+!
+! PR fortran/52151
+!
+! Check that the bounds/shape/strides are correctly set
+! for (re)alloc on assignment, if the LHS is either not
+! allocated or has the wrong shape. This test is for
+! code which is only invoked for libgfortran intrinsic
+! such as RESHAPE.
+!
+! Based on the example of PR 52117 by Steven Hirshman
+!
+    PROGRAM RESHAPEIT
+      call unalloc ()
+      call wrong_shape ()
+    contains
+    subroutine unalloc ()
+      INTEGER, PARAMETER :: n1=2, n2=2, n3=2
+      INTEGER            :: m1, m2, m3, lc
+      REAL, ALLOCATABLE  :: A(:,:), B(:,:,:)
+      REAL               :: val
+
+      ALLOCATE (A(n1,n2*n3))
+! << B is not allocated
+
+      val = 0
+      lc = 0
+      DO m3=1,n3
+         DO m2=1,n2
+            lc = lc+1
+            DO m1=1,n1
+               val = val+1
+               A(m1, lc) = val
+            END DO
+         END DO
+      END DO
+
+      B = RESHAPE(A, [n1,n2,n3])
+
+      if (any (shape (B)  /= [n1,n2,n3])) call abort ()
+      if (any (ubound (B) /= [n1,n2,n3])) call abort ()
+      if (any (lbound (B) /= [1,1,1])) call abort ()
+
+      lc = 0
+      DO m3=1,n3
+         DO m2=1,n2
+            lc = lc+1
+            DO m1=1,n1
+!               PRINT *,'A(',m1,',',lc,') = ',A(m1,lc),' B = ',B(m1,m2,m3)
+               if (A(m1,lc) /= B(m1,m2,m3)) call abort ()
+            END DO
+         END DO
+      END DO
+      DEALLOCATE(A, B)
+    end subroutine unalloc
+
+    subroutine wrong_shape ()
+      INTEGER, PARAMETER :: n1=2, n2=2, n3=2
+      INTEGER            :: m1, m2, m3, lc
+      REAL, ALLOCATABLE  :: A(:,:), B(:,:,:)
+      REAL               :: val
+
+      ALLOCATE (A(n1,n2*n3))
+      ALLOCATE (B(1,1,1))     ! << shape differs from RHS
+
+      val = 0
+      lc = 0
+      DO m3=1,n3
+         DO m2=1,n2
+            lc = lc+1
+            DO m1=1,n1
+               val = val+1
+               A(m1, lc) = val
+            END DO
+         END DO
+      END DO
+
+      B = RESHAPE(A, [n1,n2,n3])
+
+      if (any (shape (B)  /= [n1,n2,n3])) call abort ()
+      if (any (ubound (B) /= [n1,n2,n3])) call abort ()
+      if (any (lbound (B) /= [1,1,1])) call abort ()
+
+      lc = 0
+      DO m3=1,n3
+         DO m2=1,n2
+            lc = lc+1
+            DO m1=1,n1
+!               PRINT *,'A(',m1,',',lc,') = ',A(m1,lc),' B = ',B(m1,m2,m3)
+               if (A(m1,lc) /= B(m1,m2,m3)) call abort ()
+            END DO
+         END DO
+      END DO
+      DEALLOCATE(A, B)
+    end subroutine wrong_shape
+    END PROGRAM RESHAPEIT
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_13.f90 b/gcc/testsuite/gfortran.dg/realloc_on_assign_13.f90
new file mode 100644
index 000000000..9661d724f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_13.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! Test the fix for PR52386.
+!
+! Contributed by Juergen Reuter  <reuter@physik.uni-freiburg.de>
+!
+module cascades
+  implicit none
+  private
+contains
+    function reduced (array)
+      integer, dimension(:), allocatable :: reduced
+      integer, dimension(:), intent(in) :: array
+      logical, dimension(size(array)) :: mask
+      mask = .true. 
+      allocate (reduced (count (mask)))
+      reduced = pack (array, mask)
+    end function reduced
+end module cascades
+! { dg-final { cleanup-modules "cascades" } }
+
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_15.f90 b/gcc/testsuite/gfortran.dg/realloc_on_assign_15.f90
new file mode 100644
index 000000000..2a0e5be91
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_15.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+!
+! PR fortran/53389
+!
+! The program was leaking memory before due to
+! realloc on assignment and nested functions.
+!
+module foo
+  implicit none
+  contains
+
+  function filler(array, val)
+    real, dimension(:), intent(in):: array
+    real, dimension(size(array)):: filler
+    real, intent(in):: val
+
+    filler=val
+
+  end function filler
+end module
+
+program test
+  use foo
+  implicit none
+
+  real, dimension(:), allocatable:: x, y
+  integer, parameter:: N=1000 !*1000
+  integer:: i
+
+!  allocate( x(N) )
+  allocate( y(N) )
+  y=0.0
+
+  do i=1, N
+!    print *,i
+    x=filler(filler(y, real(2*i)), real(i))
+    y=y+x
+  end do
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_2.f03 b/gcc/testsuite/gfortran.dg/realloc_on_assign_2.f03
new file mode 100644
index 000000000..0564d0d50
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_2.f03
@@ -0,0 +1,153 @@
+! { dg-do run }
+! { dg-skip-if "Too big for local store" { spu-*-* } { "*" } { "" } }
+! Tests the patch that implements F2003 automatic allocation and
+! reallocation of allocatable arrays on assignment.  The tests
+! below were generated in the final stages of the development of
+! this patch.
+! test1 has been corrected for PR47051
+!
+! Contributed by Dominique Dhumieres <dominiq@lps.ens.fr>
+!            and Tobias Burnus <burnus@gcc.gnu.org>
+!
+  integer :: nglobal
+  call test1
+  call test2
+  call test3
+  call test4
+  call test5
+  call test6
+  call test7
+  call test8
+contains
+  subroutine test1
+!
+! Check that the bounds are set correctly, when assigning
+! to an array that already has the correct shape.
+!
+    real :: a(10) = 1, b(51:60) = 2
+    real, allocatable :: c(:), d(:)
+    c=a
+    if (lbound (c, 1) .ne. lbound(a, 1)) call abort
+    if (ubound (c, 1) .ne. ubound(a, 1)) call abort
+    c=b
+! 7.4.1.3 "If variable is an allocated allocatable variable, it is
+! deallocated if expr is an array of different shape or any of the
+! corresponding length type parameter values of variable and expr
+! differ." Here the shape is the same so the deallocation does not
+! occur and the bounds are not recalculated. This was corrected
+! for the fix of PR47051. 
+    if (lbound (c, 1) .ne. lbound(a, 1)) call abort
+    if (ubound (c, 1) .ne. ubound(a, 1)) call abort
+    d=b
+    if (lbound (d, 1) .ne. lbound(b, 1)) call abort
+    if (ubound (d, 1) .ne. ubound(b, 1)) call abort
+    d=a
+! The other PR47051 correction.
+    if (lbound (d, 1) .ne. lbound(b, 1)) call abort
+    if (ubound (d, 1) .ne. ubound(b, 1)) call abort
+  end subroutine
+  subroutine test2
+!
+! Check that the bounds are set correctly, when making an
+! assignment with an implicit conversion.  First with a
+! non-descriptor variable....
+!
+    integer(4), allocatable :: a(:)
+    integer(8) :: b(5:6)
+    a = b
+    if (lbound (a, 1) .ne. lbound(b, 1)) call abort
+    if (ubound (a, 1) .ne. ubound(b, 1)) call abort
+  end subroutine
+  subroutine test3
+!
+! ...and now a descriptor variable.
+!
+    integer(4), allocatable :: a(:)
+    integer(8), allocatable :: b(:)
+    allocate (b(7:11))
+    a = b
+    if (lbound (a, 1) .ne. lbound(b, 1)) call abort
+    if (ubound (a, 1) .ne. ubound(b, 1)) call abort
+  end subroutine
+  subroutine test4
+!
+! Check assignments of the kind a = f(...)
+!
+    integer, allocatable :: a(:)
+    integer, allocatable :: c(:)
+    a = f()
+    if (any (a .ne. [1, 2, 3, 4])) call abort
+    c = a + 8
+    a = f (c)
+    if (any ((a - 8) .ne. [1, 2, 3, 4])) call abort
+    deallocate (c)
+    a = f (c)
+    if (any ((a - 4) .ne. [1, 2, 3, 4])) call abort
+  end subroutine
+  function f(b)
+    integer, allocatable, optional :: b(:)
+    integer :: f(4)
+    if (.not.present (b)) then
+      f = [1,2,3,4]
+    elseif (.not.allocated (b)) then
+      f = [5,6,7,8]
+    else
+      f = b
+    end if
+  end function f
+  
+  subroutine test5
+!
+! Extracted from rnflow.f90, Polyhedron benchmark suite,
+! http://www.polyhedron.com
+!
+    integer, parameter :: ncls = 233, ival = 16, ipic = 17
+    real, allocatable, dimension (:,:) :: utrsft
+    real, allocatable, dimension (:,:) :: dtrsft
+    real, allocatable, dimension (:,:) :: xwrkt
+    allocate (utrsft(ncls, ncls), dtrsft(ncls, ncls))
+    nglobal = 0
+    xwrkt = trs2a2 (ival, ipic, ncls)
+    if (any (shape (xwrkt) .ne. [ncls, ncls])) call abort
+    xwrkt = invima (xwrkt, ival, ipic, ncls)
+    if (nglobal .ne. 1) call abort
+    if (sum(xwrkt) .ne. xwrkt(ival, ival)) call abort
+  end subroutine
+  function trs2a2 (j, k, m)
+    real, dimension (1:m,1:m) :: trs2a2
+    integer, intent (in)      :: j, k, m
+    nglobal = nglobal + 1
+    trs2a2 = 0.0
+  end function trs2a2
+  function invima (a, j, k, m)
+    real, dimension (1:m,1:m)              :: invima
+    real, dimension (1:m,1:m), intent (in) :: a
+    integer, intent (in)            :: j, k
+    invima = 0.0
+    invima (j, j) = 1.0 / (1.0 - a (j, j))
+  end function invima
+  subroutine test6
+    character(kind=1, len=100), allocatable, dimension(:) :: str
+    str = [ "abc" ]
+    if (TRIM(str(1)) .ne. "abc") call abort
+    if (len(str) .ne. 100) call abort
+  end subroutine
+  subroutine test7
+    character(kind=4, len=100), allocatable, dimension(:) :: str
+    character(kind=4, len=3) :: test = "abc"
+    str = [ "abc" ]
+    if (TRIM(str(1)) .ne. test) call abort
+    if (len(str) .ne. 100) call abort
+  end subroutine
+  subroutine test8
+    type t
+      integer, allocatable :: a(:)
+    end type t
+    type(t) :: x
+    x%a= [1,2,3]
+    if (any (x%a .ne. [1,2,3])) call abort
+    x%a = [4]
+    if (any (x%a .ne. [4])) call abort
+  end subroutine
+end
+
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_3.f03 b/gcc/testsuite/gfortran.dg/realloc_on_assign_3.f03
new file mode 100644
index 000000000..d975f4727
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_3.f03
@@ -0,0 +1,88 @@
+! { dg-do run }
+! Test (re)allocation on assignment of scalars
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+  call test_real
+  call test_derived
+  call test_char1
+  call test_char4
+  call test_deferred_char1
+  call test_deferred_char4
+contains
+  subroutine test_real
+    real, allocatable :: x
+    real :: y = 42
+    x = 42.0
+    if (x .ne. y) call abort
+    deallocate (x)
+    x = y
+    if (x .ne. y) call abort
+  end subroutine   
+  subroutine test_derived
+    type :: mytype
+      real :: x
+      character(4) :: c
+    end type
+    type (mytype), allocatable :: t
+    t = mytype (99.0, "abcd")
+    if (t%c .ne. "abcd") call abort
+  end subroutine   
+  subroutine test_char1
+    character(len = 8), allocatable :: c1
+    character(len = 8) :: c2 = "abcd1234"
+    c1 = "abcd1234"
+    if (c1 .ne. c2) call abort
+    deallocate (c1)
+    c1 = c2
+    if (c1 .ne. c2) call abort
+  end subroutine    
+  subroutine test_char4
+    character(len = 8, kind = 4), allocatable :: c1
+    character(len = 8, kind = 4) :: c2 = 4_"abcd1234"
+    c1 = 4_"abcd1234"
+    if (c1 .ne. c2) call abort
+    deallocate (c1)
+    c1 = c2
+    if (c1 .ne. c2) call abort
+  end subroutine
+  subroutine test_deferred_char1  
+    character(:), allocatable :: c
+    c = "Hello"
+    if (c .ne. "Hello") call abort
+    if (len(c) .ne. 5) call abort
+    c = "Goodbye"
+    if (c .ne. "Goodbye") call abort
+    if (len(c) .ne. 7) call abort
+! Check that the hidden LEN dummy is passed by reference
+    call test_pass_c1 (c)
+    if (c .ne. "Made in test!") print *, c
+    if (len(c) .ne. 13) call abort
+  end subroutine
+  subroutine test_pass_c1 (carg)
+    character(:), allocatable :: carg
+    if (carg .ne. "Goodbye") call abort
+    if (len(carg) .ne. 7) call abort
+    carg = "Made in test!"
+  end subroutine
+  subroutine test_deferred_char4
+    character(:, kind = 4), allocatable :: c
+    c = 4_"Hello"
+    if (c .ne. 4_"Hello") call abort
+    if (len(c) .ne. 5) call abort
+    c = 4_"Goodbye"
+    if (c .ne. 4_"Goodbye") call abort
+    if (len(c) .ne. 7) call abort
+! Check that the hidden LEN dummy is passed by reference
+    call test_pass_c4 (c)
+    if (c .ne. 4_"Made in test!") print *, c
+    if (len(c) .ne. 13) call abort
+  end subroutine
+  subroutine test_pass_c4 (carg)
+    character(:, kind = 4), allocatable :: carg
+    if (carg .ne. 4_"Goodbye") call abort
+    if (len(carg) .ne. 7) call abort
+    carg = 4_"Made in test!"
+  end subroutine
+end
+
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_4.f03 b/gcc/testsuite/gfortran.dg/realloc_on_assign_4.f03
new file mode 100644
index 000000000..a71f5d59b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_4.f03
@@ -0,0 +1,50 @@
+! { dg-do run }
+! Tests function return of deferred length scalars.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module m
+contains
+  function mfoo (carg) result(res)
+    character (:), allocatable :: res
+    character (*) :: carg
+    res = carg(2:4)
+  end function
+  function mbar (carg)
+    character (:), allocatable :: mbar
+    character (*) :: carg
+    mbar = carg(2:13)
+  end function
+end module
+
+  use m
+  character (:), allocatable :: lhs
+  lhs = foo ("foo calling ")
+  if (lhs .ne. "foo") call abort
+  if (len (lhs) .ne. 3) call abort
+  deallocate (lhs)
+  lhs = bar ("bar calling - baaaa!")
+  if (lhs .ne. "bar calling") call abort
+  if (len (lhs) .ne. 12) call abort
+  deallocate (lhs)
+  lhs = mfoo ("mfoo calling ")
+  if (lhs .ne. "foo") call abort
+  if (len (lhs) .ne. 3) call abort
+  deallocate (lhs)
+  lhs = mbar ("mbar calling - baaaa!")
+  if (lhs .ne. "bar calling") call abort
+  if (len (lhs) .ne. 12) call abort
+contains
+  function foo (carg) result(res)
+    character (:), allocatable :: res
+    character (*) :: carg
+    res = carg(1:3)
+  end function
+  function bar (carg)
+    character (:), allocatable :: bar
+    character (*) :: carg
+    bar = carg(1:12)
+  end function
+end
+
+
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_5.f03 b/gcc/testsuite/gfortran.dg/realloc_on_assign_5.f03
new file mode 100644
index 000000000..db4233d5f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_5.f03
@@ -0,0 +1,18 @@
+! { dg-do run }
+! Test the fix for PR47523 in which concatenations did not work
+! correctly with assignments to deferred character length scalars.
+!
+! Contributed by Thomas Koenig  <tkoenig@gcc.gnu.org>
+!
+program main
+  implicit none
+  character(:), allocatable :: a, b
+  a = 'a'
+  if (a .ne. 'a') call abort
+  a = a // 'x'
+  if (a .ne. 'ax') call abort
+  if (len (a) .ne. 2) call abort
+  a = (a(2:2))
+  if (a .ne. 'x') call abort
+  if (len (a) .ne. 1) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03 b/gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03
new file mode 100644
index 000000000..7c170ebce
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03
@@ -0,0 +1,129 @@
+! { dg-do compile }
+! Test the fix for PR48456 and PR48360 in which the backend
+! declarations for components were not located in the automatic
+! reallocation on assignments, thereby causing ICEs.
+!
+! Contributed by Keith Refson  <krefson@googlemail.com>
+! and Douglas Foulds  <mixnmaster@gmail.com>
+!
+! This is PR48360
+
+module m
+  type mm
+     real, dimension(3,3) :: h0
+  end type mm
+end module m
+
+module gf33
+
+  real, allocatable, save, dimension(:,:) :: hmat
+  
+contains
+  subroutine assignit
+    
+    use m
+    implicit none
+    
+    type(mm) :: mmv
+    
+    hmat = mmv%h0
+  end subroutine assignit
+end module gf33
+
+! This is PR48456
+
+module custom_type
+
+integer, parameter :: dp = kind(0.d0)
+
+type :: my_type_sub
+    real(dp), dimension(5) :: some_vector
+end type my_type_sub
+
+type :: my_type
+  type(my_type_sub) :: some_element
+end type my_type
+
+end module custom_type
+
+module custom_interfaces
+
+interface
+  subroutine store_data_subroutine(vec_size)
+  implicit none
+  integer, intent(in) :: vec_size
+  integer :: k
+  end subroutine store_data_subroutine
+end interface
+
+end module custom_interfaces
+
+module store_data_test
+
+use custom_type
+
+save
+type(my_type), dimension(:), allocatable :: some_type_to_save
+
+end module store_data_test
+
+program test
+
+use store_data_test
+
+integer :: vec_size
+
+vec_size = 2
+
+call store_data_subroutine(vec_size)
+call print_after_transfer()
+
+end program test
+
+subroutine store_data_subroutine(vec_size)
+
+use custom_type
+use store_data_test
+
+implicit none
+
+integer, intent(in) :: vec_size
+integer :: k
+
+allocate(some_type_to_save(vec_size))
+
+do k = 1,vec_size
+
+  some_type_to_save(k)%some_element%some_vector(1) = 1.0_dp
+  some_type_to_save(k)%some_element%some_vector(2) = 2.0_dp
+  some_type_to_save(k)%some_element%some_vector(3) = 3.0_dp
+  some_type_to_save(k)%some_element%some_vector(4) = 4.0_dp
+  some_type_to_save(k)%some_element%some_vector(5) = 5.0_dp
+
+end do
+
+end subroutine store_data_subroutine
+
+subroutine print_after_transfer()
+
+use custom_type
+use store_data_test
+
+implicit none
+
+real(dp), dimension(:), allocatable :: C_vec
+integer :: k
+
+allocate(C_vec(5))
+
+do k = 1,size(some_type_to_save)
+
+  C_vec = some_type_to_save(k)%some_element%some_vector
+  print *, "C_vec", C_vec
+
+end do
+
+end subroutine print_after_transfer
+! { dg-final { cleanup-modules "m gf33" } }
+! { dg-final { cleanup-modules "custom_type custom_interfaces" } }
+! { dg-final { cleanup-modules "store_data_test" } }
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_7.f03 b/gcc/testsuite/gfortran.dg/realloc_on_assign_7.f03
new file mode 100644
index 000000000..f871d2739
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_7.f03
@@ -0,0 +1,84 @@
+! { dg-do run }
+! Check the fix for PR48462 in which the assignments involving matmul
+! seg faulted because a was automatically freed before the assignment.
+! Since it is related, the test for the fix of PR48746 has been added
+! as a subroutine by that name.
+!
+! Contributed by John Nedney  <ortp21@gmail.com>
+!
+program main
+  implicit none
+  integer, parameter :: dp = kind(0.0d0)
+  real(kind=dp), allocatable :: delta(:,:)
+  real(kind=dp), allocatable, target :: a(:,:)
+  real(kind=dp), pointer :: aptr(:,:)
+
+  allocate(a(3,3))
+  aptr => a
+  
+  call foo
+  if (.not. associated (aptr, a)) call abort () ! reallocated to same size - remains associated
+  call bar
+  if (.not. associated (aptr, a)) call abort () ! reallocated to smaller size - remains associated
+  call foobar
+  if (associated (aptr, a)) call abort () ! reallocated to larger size - disassociates
+
+  call pr48746
+contains
+!
+! Original reduced version from comment #2
+  subroutine foo
+    implicit none
+    real(kind=dp), allocatable :: b(:,:)
+
+    allocate(b(3,3))
+    allocate(delta(3,3))
+
+    a = reshape ([1d0, 2d0, 3d0, 4d0, 5d0, 6d0, 7d0, 8d0, 9d0], [3,3])
+    b = reshape ([1d0, 0d0, 0d0, 0d0, 1d0, 0d0, 0d0, 0d0, 1d0], [3,3])
+
+    a = matmul( matmul( a, b ), b )
+    delta = (a - reshape ([1d0, 2d0, 3d0, 4d0, 5d0, 6d0, 7d0, 8d0, 9d0], [3,3]))**2
+    if (any (delta > 1d-12)) call abort
+    if (any (lbound (a) .ne. [1, 1])) call abort
+  end subroutine
+!
+! Check that all is well when the shape of 'a' changes.
+  subroutine bar
+    implicit none
+    real(kind=dp), allocatable :: a(:,:)
+    real(kind=dp), allocatable :: b(:,:)
+
+    b = reshape ([1d0, 1d0, 1d0], [3,1])
+    a = reshape ([1d0, 2d0, 3d0, 4d0, 5d0, 6d0, 7d0, 8d0, 9d0], [3,3])
+
+    a = matmul( a, matmul( a, b ) )
+
+    delta = (a - reshape ([198d0, 243d0, 288d0], [3,1]))**2
+    if (any (delta > 1d-12)) call abort
+    if (any (lbound (a) .ne. [1, 1])) call abort
+  end subroutine
+  subroutine foobar
+    integer :: i
+    a = reshape ([(real(i, dp), i = 1, 100)],[10,10])
+  end subroutine
+  subroutine pr48746
+! This is a further wrinkle on the original problem and came about
+! because the dtype field of the result argument, passed to matmul,
+! was not being set. This is needed by matmul for the rank.
+!
+! Contributed by Thomas Koenig  <tkoenig@gcc.gnu.org>
+!
+    implicit none
+    integer, parameter :: m=10, n=12, count=4
+    real :: optmatmul(m, n)
+    real :: a(m, count), b(count, n), c(m, n)
+    real, dimension(:,:), allocatable :: tmp
+    call random_number(a)
+    call random_number(b)
+    tmp = matmul(a,b)
+    if (any (lbound (tmp) .ne. [1,1])) call abort
+    if (any (ubound (tmp) .ne. [10,12])) call abort
+  end subroutine
+end program main
+
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_8.f90 b/gcc/testsuite/gfortran.dg/realloc_on_assign_8.f90
new file mode 100644
index 000000000..4f7d28895
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_8.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+!
+! PR fortran/51448
+!
+! Contribued by François Willot
+!
+  PROGRAM MAIN
+  IMPLICIT NONE
+  TYPE mytype
+    REAL b(2)
+  END TYPE mytype
+  TYPE(mytype) a
+  DOUBLE PRECISION, ALLOCATABLE :: x(:)
+  ALLOCATE(x(2))
+  a%b=0.0E0
+  x=a%b
+  END
diff --git a/gcc/testsuite/gfortran.dg/reassoc_1.f90 b/gcc/testsuite/gfortran.dg/reassoc_1.f90
new file mode 100644
index 000000000..3857dedf7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reassoc_1.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-O3 -ffast-math -fdump-tree-optimized" }
+
+function test(b)
+  real a
+  a = (b + 5.) - 5.
+  test = a
+end
+
+! We need an explicit +5 and -5, and an intermediate ((bla)) expression
+! (the reassoc barrier).  Make use of "." matching lineends.
+! { dg-final { scan-tree-dump "\\\+ 5.*\\\)\\\).* - 5" "optimized" } }
+! { dg-final { cleanup-tree-dump "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/reassoc_2.f90 b/gcc/testsuite/gfortran.dg/reassoc_2.f90
new file mode 100644
index 000000000..053cb865f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reassoc_2.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-O3 -ffast-math -fdump-tree-optimized" }
+
+! Make sure that FRE does not replace c with b in d = c - 5
+
+function test(a)
+  real a, b, c, d
+  b = a + 5.
+  c = (a + 5.)
+  d = c - 5.
+  call foo(b)
+  test = d
+end
+
+! { dg-final { scan-tree-dump "- 5" "optimized" } }
+! { dg-final { cleanup-tree-dump "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/reassoc_3.f90 b/gcc/testsuite/gfortran.dg/reassoc_3.f90
new file mode 100644
index 000000000..84a339722
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reassoc_3.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-O -ffast-math -fdump-tree-original -fdump-tree-optimized" }
+
+! Verify we associate properly during folding
+! Verify we propagate constants in the presence of PAREN_EXPR
+
+function test(a)
+  real b, c, d
+  c = a
+  d = 5
+  b = (c + 5 - c)
+  b = (c + d - c)
+  test = a + b - 5
+end
+
+! { dg-final { scan-tree-dump "b = 5" "original" } }
+! { dg-final { scan-tree-dump "c_. = .a" "optimized" } }
+! { dg-final { scan-tree-dump "return c_.;" "optimized" } }
+! { dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-tree-dump "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/reassoc_4.f b/gcc/testsuite/gfortran.dg/reassoc_4.f
new file mode 100644
index 000000000..1bcdf1893
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reassoc_4.f
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-options "-O3 -ffast-math -fdump-tree-reassoc1" }
+! { dg-options "-O3 -ffast-math -fdump-tree-reassoc1 --param max-completely-peel-times=16" { target spu-*-* } }
+      subroutine anisonl(w,vo,anisox,s,ii1,jj1,weight)
+      integer ii1,jj1,i1,iii1,j1,jjj1,k1,l1,m1,n1
+      real*8 w(3,3),vo(3,3),anisox(3,3,3,3),s(60,60),weight
+!
+!     This routine replaces the following lines in e_c3d.f for
+!     an anisotropic material
+!
+                      do i1=1,3
+                        iii1=ii1+i1-1
+                        do j1=1,3
+                          jjj1=jj1+j1-1
+                          do k1=1,3
+                            do l1=1,3
+                              s(iii1,jjj1)=s(iii1,jjj1)
+     &                          +anisox(i1,k1,j1,l1)*w(k1,l1)*weight
+                              do m1=1,3
+                                s(iii1,jjj1)=s(iii1,jjj1)
+     &                              +anisox(i1,k1,m1,l1)*w(k1,l1)
+     &                                 *vo(j1,m1)*weight
+     &                              +anisox(m1,k1,j1,l1)*w(k1,l1)
+     &                                 *vo(i1,m1)*weight
+                                do n1=1,3
+                                  s(iii1,jjj1)=s(iii1,jjj1)
+     &                              +anisox(m1,k1,n1,l1)
+     &                              *w(k1,l1)*vo(i1,m1)*vo(j1,n1)*weight
+                                enddo
+                              enddo
+                            enddo
+                          enddo
+                        enddo
+                      enddo
+
+      return
+      end
+
+! There should be 22 multiplications left after un-distributing
+! weigth, w(k1,l1), vo(i1,m1) and vo(j1,m1) on the innermost two
+! unrolled loops.
+
+! { dg-final { scan-tree-dump-times "\[0-9\] \\\* " 22 "reassoc1" } }
+! { dg-final { cleanup-tree-dump "reassoc1" } }
diff --git a/gcc/testsuite/gfortran.dg/reassoc_5.f90 b/gcc/testsuite/gfortran.dg/reassoc_5.f90
new file mode 100644
index 000000000..8d3086ab4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reassoc_5.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-O3 -ffast-math -fdump-tree-optimized -fno-protect-parens" }
+!
+! PR fortran/35259
+! Test for -fno-protect-parens
+!
+function test(b)
+  real a
+  a = (b + 5.) - 5.
+  test = a
+end
+
+! Test copied from reassoc_1.f90 which checked for -fprotect-parens (default),
+! and thus for the occurance of "5 - 5".
+!
+! We need an explicit +5 and -5, and an intermediate ((bla)) expression
+! (the reassoc barrier).  Make use of "." matching lineends.
+! { dg-final { scan-tree-dump-times "\\\+ 5.*\\\)\\\).* - 5" 0 "optimized" } }
+! { dg-final { cleanup-tree-dump "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/reassoc_6.f b/gcc/testsuite/gfortran.dg/reassoc_6.f
new file mode 100644
index 000000000..97a5de8a7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reassoc_6.f
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-optimized" }
+
+        subroutine test(nb,nx,r2)
+        implicit none
+        integer nb,nx,i,l
+        real*8 r2(nb,nx)
+
+
+             do i=1,nx
+                do l=1,nb
+                   r2(l,i)=0.0d0
+                enddo
+             enddo
+
+        return
+        end
+! Verify that offset of the first element is simplified
+! While we understand to combine x + ~x IVOPTs now messes things
+! up by hiding that operation in casts to unsigned.
+! { dg-final { scan-tree-dump-not "~" "optimized" { xfail *-*-* } } }
+! { dg-final { cleanup-tree-dump "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/record_marker_1.f90 b/gcc/testsuite/gfortran.dg/record_marker_1.f90
new file mode 100644
index 000000000..5bcfbc611
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/record_marker_1.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! { dg-options "-frecord-marker=4" }
+
+program main
+  implicit none
+  integer(kind=4) :: i1, i2, i3
+
+  open(15,form="UNFORMATTED")
+  write (15) 1_4
+  close (15)
+  open (15,form="UNFORMATTED",access="DIRECT",recl=4)
+  i1 = 1_4
+  i2 = 2_4
+  i3 = 3_4
+  read (15,rec=1) i1
+  read (15,rec=2) i2
+  read (15,rec=3) i3
+  close (15, status="DELETE")
+  if (i1 /= 4_4) call abort
+  if (i2 /= 1_4) call abort
+  if (i3 /= 4_4) call abort
+
+  open(15,form="UNFORMATTED",convert="SWAP")
+  write (15) 1_4
+  close (15)
+  open (15,form="UNFORMATTED",access="DIRECT",convert="SWAP",recl=4)
+  i1 = 1_4
+  i2 = 2_4
+  i3 = 3_4
+  read (15,rec=1) i1
+  read (15,rec=2) i2
+  read (15,rec=3) i3
+  close(15,status="DELETE")
+  if (i1 /= 4_4) call abort
+  if (i2 /= 1_4) call abort
+  if (i3 /= 4_4) call abort
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/record_marker_2.f b/gcc/testsuite/gfortran.dg/record_marker_2.f
new file mode 100644
index 000000000..83ee7feac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/record_marker_2.f
@@ -0,0 +1,83 @@
+! { dg-do run { target fd_truncate } }
+! { dg-options "-frecord-marker=4" }
+! This file is all about BACKSPACE
+! Adapted from gfortran.dg/backspace.f
+
+      integer i, n, nr
+      real x(10), y(10)
+
+! PR libfortran/20068
+      open (20, status='scratch')
+      write (20,*) 1
+      write (20,*) 2
+      write (20,*) 3
+      rewind (20)
+      read (20,*) i
+      if (i .ne. 1) call abort
+      backspace (20)
+      read (20,*) i
+      if (i .ne. 1) call abort
+      close (20)
+
+! PR libfortran/20125
+      open (20, status='scratch')
+      write (20,*) 7
+      backspace (20)
+      read (20,*) i
+      if (i .ne. 7) call abort
+      close (20)
+
+      open (20, status='scratch', form='unformatted')
+      write (20) 8
+      backspace (20)
+      read (20) i
+      if (i .ne. 8) call abort
+      close (20)
+
+! PR libfortran/20471
+      do n = 1, 10
+        x(n) = sqrt(real(n))
+      end do
+      open (3, form='unformatted', status='scratch')
+      write (3) (x(n),n=1,10)
+      backspace (3)
+      rewind (3)
+      read (3) (y(n),n=1,10)
+
+      do n = 1, 10
+        if (abs(x(n)-y(n)) > 0.00001) call abort
+      end do
+      close (3)
+
+! PR libfortran/20156
+      open (3, form='unformatted', status='scratch')
+      do i = 1, 5
+        x(1) = i
+        write (3) n, (x(n),n=1,10)
+      end do
+      nr = 0
+      rewind (3)
+  20  continue
+      read (3,end=30,err=90) n, (x(n),n=1,10)
+      nr = nr + 1
+      goto 20
+  30  continue
+      if (nr .ne. 5) call abort
+
+      do i = 1, nr+1
+        backspace (3)
+      end do
+
+      do i = 1, nr
+        read(3,end=70,err=90) n, (x(n),n=1,10)
+        if (abs(x(1) - i) .gt. 0.001) call abort
+      end do
+      close (3)
+      stop
+
+  70  continue
+      call abort
+  90  continue
+      call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/record_marker_3.f90 b/gcc/testsuite/gfortran.dg/record_marker_3.f90
new file mode 100644
index 000000000..7459d7210
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/record_marker_3.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! { dg-options "-frecord-marker=8" }
+
+program main
+  implicit none
+  integer (kind=8) :: i1, i2, i3
+
+  open(15,form="UNFORMATTED")
+  write (15) 1_8
+  close (15)
+  open (15,form="UNFORMATTED",access="DIRECT",recl=8)
+  i1 = 1
+  i2 = 2
+  i3 = 3
+  read (15,rec=1) i1
+  read (15,rec=2) i2
+  read (15,rec=3) i3
+  close (15, status="DELETE")
+  if (i1 /= 8) call abort
+  if (i2 /= 1) call abort
+  if (i3 /= 8) call abort
+
+  open(15,form="UNFORMATTED",convert="SWAP")
+  write (15) 1_8
+  close (15)
+  open (15,form="UNFORMATTED",access="DIRECT",convert="SWAP",recl=8)
+  i1 = 1
+  i2 = 2
+  i3 = 3
+  read (15,rec=1) i1
+  read (15,rec=2) i2
+  read (15,rec=3) i3
+  close(15,status="DELETE")
+  if (i1 /= 8) call abort
+  if (i2 /= 1) call abort
+  if (i3 /= 8) call abort
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_1.f b/gcc/testsuite/gfortran.dg/recursive_check_1.f
new file mode 100644
index 000000000..7c292af08
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_1.f
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! PR fortran/26551
+      SUBROUTINE SUB()
+      CALL SUB() ! { dg-error "is not RECURSIVE" }
+      END SUBROUTINE
+
+      FUNCTION FUNC() RESULT (FOO)
+      INTEGER FOO
+      FOO = FUNC() ! { dg-error "is not RECURSIVE" }
+      END FUNCTION
+
+      SUBROUTINE SUB2()
+      ENTRY ENT2()
+      CALL ENT2() ! { dg-error "is not RECURSIVE" }
+      END SUBROUTINE
+
+      function func2()
+      integer func2
+      func2 = 42
+      return
+      entry c() result (foo)
+      foo = b() ! { dg-error "is not RECURSIVE" }
+      return
+      entry b() result (bar)
+      bar = 12
+      return
+      end function
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_10.f90 b/gcc/testsuite/gfortran.dg/recursive_check_10.f90
new file mode 100644
index 000000000..a30b82caa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_10.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fcheck=recursion" }
+!
+! PR fortran/39577
+!
+! OK - no recursion
+program test
+ integer :: i
+ i = f(.false.)
+ print *,i
+ i = f(.false.)
+ print *,i
+contains
+  integer function f(rec) 
+    logical :: rec
+    if(rec) then
+      f = g()
+    else
+      f = 42
+    end if
+  end function f
+  integer function g()
+    g = f(.false.)
+  end function g
+end program test
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_11.f90 b/gcc/testsuite/gfortran.dg/recursive_check_11.f90
new file mode 100644
index 000000000..870c1127d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_11.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-options "-fcheck=recursion" }
+! { dg-shouldfail "Recursion check" }
+!
+! { dg-output "Fortran runtime error: Recursive call to nonrecursive procedure 'f'" }
+!
+! PR fortran/39577
+!
+! wrong - recursion
+program test
+ integer :: i
+ i = f(.false.)
+ print *,i
+ i = f(.true.)
+ print *,i
+contains
+  integer function f(rec) 
+    logical :: rec
+    if(rec) then
+      f = g()
+    else
+      f = 42
+    end if
+  end function f
+  integer function g()
+    g = f(.false.)
+  end function g
+end program test
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_12.f90 b/gcc/testsuite/gfortran.dg/recursive_check_12.f90
new file mode 100644
index 000000000..22eaf7d0f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_12.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-options "-fcheck=recursion" }
+!
+! PR fortran/39577
+!
+! OK - no recursion
+module m
+  implicit none
+contains
+  subroutine f(rec) 
+    logical :: rec
+    if(rec) then
+      call h()
+    end if
+    return
+  entry g()
+  end subroutine f
+  subroutine h()
+    call f(.false.)
+  end subroutine h
+end module m
+
+program test
+ use m
+ implicit none
+ call f(.false.)
+ call f(.false.)
+end program test
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_13.f90 b/gcc/testsuite/gfortran.dg/recursive_check_13.f90
new file mode 100644
index 000000000..ed222a322
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_13.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! { dg-options "-fcheck=recursion" }
+! { dg-shouldfail "Recursion check" }
+!
+! { dg-output "Fortran runtime error: Recursive call to nonrecursive procedure 'master.0.f'" }
+!
+! PR fortran/39577
+!
+! invalid - recursion
+module m
+  implicit none
+contains
+  subroutine f(rec) 
+    logical :: rec
+    if(rec) then
+      call h()
+    end if
+    return
+  entry g()
+  end subroutine f
+  subroutine h()
+    call f(.false.)
+  end subroutine h
+end module m
+
+program test
+ use m
+ implicit none
+ call f(.false.)
+ call f(.true.)
+end program test
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_14.f90 b/gcc/testsuite/gfortran.dg/recursive_check_14.f90
new file mode 100644
index 000000000..e68e5fc56
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_14.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! { dg-options "-fcheck=recursion" }
+!
+! PR fortran/39577
+!
+! Recursive but valid program
+! Contributed by Dominique Dhumieres
+!
+recursive function fac(i) result (res)
+  integer :: i, j, k, res
+  k = 1
+  goto 100
+entry bifac(i,j) result (res)
+  k = j
+100 continue
+  if (i < k) then
+    res = 1
+  else
+    res = i * bifac(i-k,k)
+  end if
+end function
+
+program test
+interface
+  recursive function fac(n) result (res)
+    integer :: res
+    integer :: n
+  end function fac
+  recursive function bifac(m,n) result (res)
+    integer :: m, n, res
+  end function  bifac
+end interface
+
+  print *, fac(5)
+  print *, bifac(5,2)
+  print*, fac(6)
+  print *, bifac(6,2)
+  print*, fac(0)
+  print *, bifac(1,2)
+end program test
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_15.f90 b/gcc/testsuite/gfortran.dg/recursive_check_15.f90
new file mode 100644
index 000000000..4e381804e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_15.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! PR41909 ICE with "call foo" in "program foo"
+program test ! { dg-error "Global name" }
+  implicit none
+  call test()  ! { dg-error "" }
+contains
+  subroutine one(a)
+    real, dimension(:,:), intent(inout), optional :: a
+    call two(a)
+  end subroutine one
+end program test
+
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_2.f90 b/gcc/testsuite/gfortran.dg/recursive_check_2.f90
new file mode 100644
index 000000000..15608eea1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_2.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! PR fortran/26551
+ function func2()
+   integer func2
+   func2 = 42
+   return
+ entry c() result (foo)
+   foo = barbar()
+   return
+ entry b() result (bar)
+   bar = 12
+   return
+ contains
+   function barbar ()
+     barbar = b () ! { dg-error "is not RECURSIVE" }
+   end function barbar
+ end function
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_3.f90 b/gcc/testsuite/gfortran.dg/recursive_check_3.f90
new file mode 100644
index 000000000..767828610
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_3.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+module m1
+contains
+pure pure subroutine a1(b) ! { dg-error "Duplicate PURE attribute specified" }
+  real, intent(in) :: b    ! { dg-error "Unexpected data declaration statement" }
+end subroutine a1          ! { dg-error "Expecting END MODULE" }
+end module m1
+
+module m2
+contains
+elemental elemental subroutine a2(b) ! { dg-error "Duplicate ELEMENTAL attribute" }
+  real, intent(in) :: b    ! { dg-error "Unexpected data declaration statement" }
+end subroutine a2          ! { dg-error "Expecting END MODULE" }
+end module m2
+
+module m3
+contains
+recursive recursive subroutine a3(b) ! { dg-error "Duplicate RECURSIVE attribute" }
+  real, intent(in) :: b    ! { dg-error "Unexpected data declaration statement" }
+end subroutine a3          ! { dg-error "Expecting END MODULE" }
+end module m3
+! { dg-final { cleanup-modules "m1 m2 m3" } }
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_4.f03 b/gcc/testsuite/gfortran.dg/recursive_check_4.f03
new file mode 100644
index 000000000..d33e53555
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_4.f03
@@ -0,0 +1,36 @@
+! { dg-do compile }
+
+! PR fortran/37779
+! Check that using a non-recursive procedure as "value" is an error.
+
+MODULE m
+  IMPLICIT NONE
+
+CONTAINS
+
+  SUBROUTINE test ()
+    IMPLICIT NONE
+    PROCEDURE(test), POINTER :: procptr
+
+    CALL bar (test) ! { dg-warning "Non-RECURSIVE" }
+    procptr => test ! { dg-warning "Non-RECURSIVE" }
+  END SUBROUTINE test
+
+  INTEGER FUNCTION test2 () RESULT (x)
+    IMPLICIT NONE
+    PROCEDURE(test2), POINTER :: procptr
+
+    CALL bar (test2) ! { dg-warning "Non-RECURSIVE" }
+    procptr => test2 ! { dg-warning "Non-RECURSIVE" }
+
+    x = 1812
+  END FUNCTION test2
+
+  INTEGER FUNCTION func ()
+    ! Using a result variable is ok of course!
+    func = 42 ! { dg-bogus "Non-RECURSIVE" }
+  END FUNCTION func
+
+END MODULE m
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_5.f03 b/gcc/testsuite/gfortran.dg/recursive_check_5.f03
new file mode 100644
index 000000000..4014986b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_5.f03
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-frecursive" }
+
+! PR fortran/37779
+! Check that -frecursive allows using procedures in as procedure expressions.
+
+MODULE m
+  IMPLICIT NONE
+
+CONTAINS
+
+  SUBROUTINE test ()
+    IMPLICIT NONE
+    PROCEDURE(test), POINTER :: procptr
+
+    CALL bar (test) ! { dg-bogus "Non-RECURSIVE" }
+    procptr => test ! { dg-bogus "Non-RECURSIVE" }
+  END SUBROUTINE test
+
+  INTEGER FUNCTION func ()
+    ! Using a result variable is ok of course!
+    func = 42 ! { dg-bogus "Non-RECURSIVE" }
+  END FUNCTION func
+
+END MODULE m
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_6.f03 b/gcc/testsuite/gfortran.dg/recursive_check_6.f03
new file mode 100644
index 000000000..478539e6a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_6.f03
@@ -0,0 +1,66 @@
+! { dg-do compile }
+
+! PR fortran/37779
+! Check that a call to a procedure's containing procedure counts as recursive
+! and is rejected if the containing procedure is not RECURSIVE.
+
+MODULE m
+  IMPLICIT NONE
+
+CONTAINS
+
+  SUBROUTINE test_sub ()
+    CALL bar ()
+  CONTAINS
+    SUBROUTINE bar ()
+      IMPLICIT NONE
+      PROCEDURE(test_sub), POINTER :: procptr
+
+      CALL test_sub () ! { dg-error "not RECURSIVE" }
+      procptr => test_sub ! { dg-warning "Non-RECURSIVE" }
+      CALL foobar (test_sub) ! { dg-warning "Non-RECURSIVE" }
+    END SUBROUTINE bar
+  END SUBROUTINE test_sub
+
+  INTEGER FUNCTION test_func () RESULT (x)
+    x = bar ()
+  CONTAINS
+    INTEGER FUNCTION bar ()
+      IMPLICIT NONE
+      PROCEDURE(test_func), POINTER :: procptr
+
+      bar = test_func () ! { dg-error "not RECURSIVE" }
+      procptr => test_func ! { dg-warning "Non-RECURSIVE" }
+      CALL foobar (test_func) ! { dg-warning "Non-RECURSIVE" }
+    END FUNCTION bar
+  END FUNCTION test_func
+
+  SUBROUTINE sub_entries ()
+  ENTRY sub_entry_1 ()
+  ENTRY sub_entry_2 ()
+    CALL bar ()
+  CONTAINS
+    SUBROUTINE bar ()
+      CALL sub_entry_1 () ! { dg-error "is not RECURSIVE" }
+    END SUBROUTINE bar
+  END SUBROUTINE sub_entries
+
+  INTEGER FUNCTION func_entries () RESULT (x)
+  ENTRY func_entry_1 () RESULT (x)
+  ENTRY func_entry_2 () RESULT (x)
+    x = bar ()
+  CONTAINS
+    INTEGER FUNCTION bar ()
+      bar = func_entry_1 () ! { dg-error "is not RECURSIVE" }
+    END FUNCTION bar
+  END FUNCTION func_entries
+
+  SUBROUTINE main ()
+    CALL test_sub ()
+    CALL sub_entries ()
+    PRINT *, test_func (), func_entries ()
+  END SUBROUTINE main
+
+END MODULE m
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_7.f90 b/gcc/testsuite/gfortran.dg/recursive_check_7.f90
new file mode 100644
index 000000000..c1af8adc8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_7.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! { dg-options "-fcheck=recursion" }
+! { dg-shouldfail "Recursion check" }
+!
+! PR fortran/32626
+! Recursion run-time check
+!
+
+subroutine NormalFunc()
+end subroutine NormalFunc
+
+recursive subroutine valid(x)
+  logical :: x
+  if(x) call sndValid()
+  print *, 'OK'
+end subroutine valid
+
+subroutine sndValid()
+  call valid(.false.)
+end subroutine sndValid
+
+subroutine invalid(x)
+  logical :: x
+  if(x) call sndInvalid()
+  print *, 'BUG'
+  call abort()
+end subroutine invalid
+
+subroutine sndInvalid()
+  call invalid(.false.)
+end subroutine sndInvalid
+
+call valid(.true.)
+call valid(.true.)
+call NormalFunc()
+call NormalFunc()
+call invalid(.true.)
+end
+
+! { dg-output "Fortran runtime error: Recursive call to nonrecursive procedure 'invalid'" }
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_8.f90 b/gcc/testsuite/gfortran.dg/recursive_check_8.f90
new file mode 100644
index 000000000..4d83498c7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_8.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options "-fcheck=recursion" }
+!
+! PR fortran/39577
+!
+! OK - no recursion
+program test
+ call f(.false.)
+ call f(.false.)
+contains
+  subroutine f(rec) 
+    logical :: rec
+    if(rec) then
+      call g()
+    end if
+    return
+  end subroutine f
+  subroutine g()
+    call f(.false.)
+    return
+  end subroutine g
+end program test
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_9.f90 b/gcc/testsuite/gfortran.dg/recursive_check_9.f90
new file mode 100644
index 000000000..50af06787
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_9.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fcheck=recursion" }
+! { dg-shouldfail "Recursion check" }
+!
+! { dg-output "Fortran runtime error: Recursive call to nonrecursive procedure 'f'" }
+!
+! PR fortran/39577
+!
+! Invalid - recursion
+program test
+ call f(.false.)
+ call f(.true.)
+contains
+  subroutine f(rec) 
+    logical :: rec
+    if(rec) then
+      call g()
+    end if
+    return
+  end subroutine f
+  subroutine g()
+    call f(.false.)
+    return
+  end subroutine g
+end program test
diff --git a/gcc/testsuite/gfortran.dg/recursive_parameter_1.f90 b/gcc/testsuite/gfortran.dg/recursive_parameter_1.f90
new file mode 100644
index 000000000..8a13d254f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_parameter_1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! Tests the fix for PR39334 in which the recursive parameter declaration
+! caused a sgfault.
+!
+! Reported by James van Buskirk on comp.lang.fortran
+!
+program recursive_parameter
+   implicit none
+   integer, parameter :: dp = kind(1.0_dp) ! { dg-error "Missing kind-parameter" }
+   write(*,*) dp ! { dg-error "has no IMPLICIT type" }
+end program recursive_parameter
diff --git a/gcc/testsuite/gfortran.dg/recursive_reference_1.f90 b/gcc/testsuite/gfortran.dg/recursive_reference_1.f90
new file mode 100644
index 000000000..3ca6bcb17
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_reference_1.f90
@@ -0,0 +1,50 @@
+! { dg-do compile }
+! Tests the patch for PR27613, in which directly recursive, scalar
+! functions were generating an "unclassifiable statement" error
+! for the recursive statement(s).  This was subsequently determined
+! to be wrong code and the error on 'bad_stuff' was removed.
+! See 12.5.2.1 of the standard and PR30876.
+!
+! Based on PR testcase by Nicolas Bock  <nicolasbock@gmail.com>
+!
+program test
+  if (original_stuff(1) .ne. 5) call abort ()
+  if (scalar_stuff(-4) .ne. 10) call abort ()
+  if (any (array_stuff((/-19,-30/)) .ne. (/25,25/))) call abort ()
+contains
+  recursive function original_stuff(n)
+    integer :: original_stuff
+    integer :: n
+    original_stuff = 1
+    if(n < 5) then
+      original_stuff = original_stuff + original_stuff (n+1) ! { dg-error "name of a recursive function" }
+    endif
+  end function original_stuff
+
+  recursive function scalar_stuff(n) result (tmp)
+    integer :: tmp
+    integer :: n
+    tmp = 1
+    if(n < 5) then
+      tmp = tmp + scalar_stuff (n+1)
+    endif
+  end function scalar_stuff
+
+  recursive function array_stuff(n) result (tmp)
+    integer :: tmp (2)
+    integer :: n (2)
+    tmp = 1
+    if(maxval (n) < 5) then
+      tmp = tmp + array_stuff (n+1)
+    endif
+  end function array_stuff
+
+  recursive function bad_stuff(n)
+    integer :: bad_stuff (2)
+    integer :: n(2)
+    bad_stuff = 1
+    if(maxval (n) < 5) then
+      bad_stuff = bad_stuff + bad_stuff (n+1)
+    endif
+  end function bad_stuff
+end program test
diff --git a/gcc/testsuite/gfortran.dg/recursive_reference_2.f90 b/gcc/testsuite/gfortran.dg/recursive_reference_2.f90
new file mode 100644
index 000000000..59df43cdf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_reference_2.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! Tests the fix for PR30876 in which interface derived types were
+! not always being associated.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+MODULE M1
+CONTAINS
+ FUNCTION correct_input(i)
+   INTEGER :: i,correct_input(5), ans(5) = 0
+   IF (i<1) correct_input=test(1)
+   IF (i>5) correct_input=test(5)
+ END FUNCTION correct_input
+
+ RECURSIVE FUNCTION test(i)
+  INTEGER :: test(5),i,j
+  IF (i<1 .OR. i>5) THEN
+    test=correct_input(i)
+  ELSE
+    test=0
+    test(1:6-i)=(/(j,j=i,5)/)
+    test=test(3)
+  ENDIF
+ END FUNCTION
+
+END MODULE M1
+
+USE M1
+integer :: ans(5)
+IF (ANY(TEST(3).NE.(/5,5,5,5,5/))) CALL ABORT()
+IF (ANY(TEST(6).NE.(/0,0,0,0,0/))) CALL ABORT()
+END
+! { dg-final { cleanup-modules "m1" } }
+
diff --git a/gcc/testsuite/gfortran.dg/recursive_stack.f90 b/gcc/testsuite/gfortran.dg/recursive_stack.f90
new file mode 100644
index 000000000..c555c0d9f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_stack.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-frecursive" }
+program recursive_stack
+  call foo (.true.)
+end program recursive_stack
+
+subroutine foo (recurse)
+  logical recurse
+  integer iarray(100,100)
+  if (recurse) then
+     iarray(49,49) = 17
+     call bar
+     if (iarray(49,49) .ne. 17) call abort
+  else
+     iarray(49,49) = 21
+  end if
+end subroutine foo
+
+subroutine bar
+  call foo (.false.)
+end subroutine bar
diff --git a/gcc/testsuite/gfortran.dg/recursive_statement_functions.f90 b/gcc/testsuite/gfortran.dg/recursive_statement_functions.f90
new file mode 100644
index 000000000..bcf51f8d5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_statement_functions.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! PR20866 - A statement function cannot be recursive.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+! Modified 20051110 to check that regressions PR24655 and PR24755
+! are fixed. Thanks to pavarini@pv.infn.it and tdeutsch@cea.fr for
+! the tests.
+!
+  INTEGER :: i, st1, st2, st3, lambda, n
+  REAL :: x, z(2,2)
+  character(8) :: ch
+  real(8)   :: fi, arg, sigma, dshpfunc
+  real(8), parameter :: one=1d0
+!
+! Test check for recursion via other statement functions, string
+! length references, function actual arguments and array index
+! references.
+!
+  st1 (i) = len (ch(st2 (1):8))
+  st2 (i) = max (st3 (1), 4)
+  st3 (i) = 2 + cos (z(st1 (1), i)) ! { dg-error "is recursive" }
+!
+! Test the two regressions.
+!
+  fi (n) = n *one
+  dshpfunc (arg)=-lambda/sigma*(arg/sigma)**(lambda-1)*exp(-(arg/sigma)**lambda)
+!
+! References to each statement function.
+!
+  write(6,*) st1 (1), fi (2), dshpfunc (1.0_8)
+  END
diff --git a/gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment.f90 b/gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment.f90
new file mode 100644
index 000000000..8eb47e19b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! Tests the fix for PR25077 in which no diagnostic was produced
+! for the redefinition of an intrinsic type assignment.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+MODULE M1
+ IMPLICIT NONE
+ INTERFACE ASSIGNMENT(=)
+  MODULE PROCEDURE T1
+ END INTERFACE
+CONTAINS
+ SUBROUTINE T1(I,J) ! { dg-error "redefine an INTRINSIC type assignment" }
+   INTEGER, INTENT(OUT)  :: I
+   INTEGER, INTENT(IN)  :: J
+   I=-J
+ END SUBROUTINE T1
+END MODULE M1
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment_2.f90 b/gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment_2.f90
new file mode 100644
index 000000000..ba7090209
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment_2.f90
@@ -0,0 +1,68 @@
+! { dg-do compile }
+!
+! PR fortran/47448
+!
+! ASSIGNMENT(=) checks. Defined assignment is allowed if and only if
+! it does not override an intrinsic assignment.
+!
+
+module test1
+  interface assignment(=)
+     module procedure valid, valid2
+  end interface
+contains
+  ! Valid: scalar = array
+  subroutine valid (lhs,rhs)
+    integer, intent(out) ::  lhs
+    integer, intent(in) :: rhs(:)
+    lhs = rhs(1) 
+  end subroutine valid
+
+  ! Valid: array of different ranks
+  subroutine valid2 (lhs,rhs)
+    integer, intent(out) ::  lhs(:)
+    integer, intent(in) :: rhs(:,:)
+    lhs(:) = rhs(:,1) 
+  end subroutine valid2
+end module test1
+
+module test2
+  interface assignment(=)
+     module procedure invalid
+  end interface
+contains
+  ! Invalid: scalar = scalar
+  subroutine invalid (lhs,rhs) ! { dg-error "must not redefine an INTRINSIC type assignment" }
+    integer, intent(out) ::  lhs
+    integer, intent(in) :: rhs
+    lhs = rhs
+  end subroutine invalid
+end module test2
+
+module test3
+  interface assignment(=)
+     module procedure invalid2
+  end interface
+contains
+  ! Invalid: array = scalar
+  subroutine invalid2 (lhs,rhs) ! { dg-error "must not redefine an INTRINSIC type assignment" }
+    integer, intent(out) ::  lhs(:)
+    integer, intent(in) :: rhs
+    lhs(:) = rhs
+  end subroutine invalid2
+end module test3
+
+module test4
+  interface assignment(=)
+     module procedure invalid3
+  end interface
+contains
+  ! Invalid: array = array for same rank
+  subroutine invalid3 (lhs,rhs) ! { dg-error "must not redefine an INTRINSIC type assignment" }
+    integer, intent(out) ::  lhs(:)
+    integer, intent(in) :: rhs(:)
+    lhs(:) = rhs(:)
+  end subroutine invalid3
+end module test4
+
+! { dg-final { cleanup-modules "test1" } }
diff --git a/gcc/testsuite/gfortran.dg/reduction.f90 b/gcc/testsuite/gfortran.dg/reduction.f90
new file mode 100644
index 000000000..82193542f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reduction.f90
@@ -0,0 +1,85 @@
+! { dg-do run }
+! PR 16946
+! Not all allowed combinations of arguments for MAXVAL, MINVAL,
+! PRODUCT and SUM were supported.
+program reduction_mask
+  implicit none
+  logical :: equal(3)
+  
+  integer, parameter :: res(4*9) = (/ 3, 3, 3, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, &
+       1, 1, 1, 1, 1, 6, 6, 6, 2, 2, 2, 2, 2, 2, 6, 6, 6, 3, 3, 3, 3, 3, 3 /)
+  integer :: val(4*9)
+  complex :: cval(2*9), cin(3)
+  
+  equal = (/ .true., .true., .false. /)
+  
+  ! use all combinations of the dim and mask arguments for the
+  ! reduction intrinsics
+  val( 1) = maxval((/ 1, 2, 3 /))
+  val( 2) = maxval((/ 1, 2, 3 /), 1)
+  val( 3) = maxval((/ 1, 2, 3 /), dim=1)
+  val( 4) = maxval((/ 1, 2, 3 /), equal)
+  val( 5) = maxval((/ 1, 2, 3 /), mask=equal)
+  val( 6) = maxval((/ 1, 2, 3 /), 1, equal)
+  val( 7) = maxval((/ 1, 2, 3 /), 1, mask=equal)
+  val( 8) = maxval((/ 1, 2, 3 /), dim=1, mask=equal)
+  val( 9) = maxval((/ 1, 2, 3 /), mask=equal, dim=1)
+       
+  val(10) = minval((/ 1, 2, 3 /))
+  val(11) = minval((/ 1, 2, 3 /), 1)
+  val(12) = minval((/ 1, 2, 3 /), dim=1)
+  val(13) = minval((/ 1, 2, 3 /), equal)
+  val(14) = minval((/ 1, 2, 3 /), mask=equal)
+  val(15) = minval((/ 1, 2, 3 /), 1, equal)
+  val(16) = minval((/ 1, 2, 3 /), 1, mask=equal)
+  val(17) = minval((/ 1, 2, 3 /), dim=1, mask=equal)
+  val(18) = minval((/ 1, 2, 3 /), mask=equal, dim=1)
+       
+  val(19) = product((/ 1, 2, 3 /))
+  val(20) = product((/ 1, 2, 3 /), 1)
+  val(21) = product((/ 1, 2, 3 /), dim=1)
+  val(22) = product((/ 1, 2, 3 /), equal)
+  val(23) = product((/ 1, 2, 3 /), mask=equal)
+  val(24) = product((/ 1, 2, 3 /), 1, equal)
+  val(25) = product((/ 1, 2, 3 /), 1, mask=equal)
+  val(26) = product((/ 1, 2, 3 /), dim=1, mask=equal)
+  val(27) = product((/ 1, 2, 3 /), mask=equal, dim=1)
+       
+  val(28) = sum((/ 1, 2, 3 /))
+  val(29) = sum((/ 1, 2, 3 /), 1)
+  val(30) = sum((/ 1, 2, 3 /), dim=1)
+  val(31) = sum((/ 1, 2, 3 /), equal)
+  val(32) = sum((/ 1, 2, 3 /), mask=equal)
+  val(33) = sum((/ 1, 2, 3 /), 1, equal)
+  val(34) = sum((/ 1, 2, 3 /), 1, mask=equal)
+  val(35) = sum((/ 1, 2, 3 /), dim=1, mask=equal)
+  val(36) = sum((/ 1, 2, 3 /), mask=equal, dim=1)
+  
+  if (any (val /= res)) call abort
+
+  ! Tests for complex arguments. These were broken by the original fix.
+
+  cin = cmplx((/1,2,3/))
+
+  cval(1) = product(cin)
+  cval(2) = product(cin, 1)
+  cval(3) = product(cin, dim=1)
+  cval(4) = product(cin, equal)
+  cval(5) = product(cin, mask=equal)
+  cval(6) = product(cin, 1, equal)
+  cval(7) = product(cin, 1, mask=equal)
+  cval(8) = product(cin, dim=1, mask=equal)
+  cval(9) = product(cin, mask=equal, dim=1)
+       
+  cval(10) = sum(cin)
+  cval(11) = sum(cin, 1)
+  cval(12) = sum(cin, dim=1)
+  cval(13) = sum(cin, equal)
+  cval(14) = sum(cin, mask=equal)
+  cval(15) = sum(cin, 1, equal)
+  cval(16) = sum(cin, 1, mask=equal)
+  cval(17) = sum(cin, dim=1, mask=equal)
+  cval(18) = sum(cin, mask=equal, dim=1)
+
+  if (any (cval /= cmplx(res(19:36)))) call abort
+end program reduction_mask
diff --git a/gcc/testsuite/gfortran.dg/repack_arrays_1.f90 b/gcc/testsuite/gfortran.dg/repack_arrays_1.f90
new file mode 100644
index 000000000..adf20aa90
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/repack_arrays_1.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-options "-frepack-arrays" }
+!
+! Check that arrays marked with TARGET attribute are not repacked.
+!
+program test2
+   use iso_c_binding
+   implicit none
+   real, target :: x(7)
+   type(c_ptr) cp1, cp2
+
+   x = 42
+   if (.not. c_associated(c_loc(x(3)),point(x(::2)))) call abort
+contains
+  function point(x)
+    use iso_c_binding
+    real, intent(in), target :: x(:)
+    type(c_ptr) point
+    real, pointer :: p
+
+    p => x(2)
+    point = c_loc(p)
+  end function point
+end program test2 
diff --git a/gcc/testsuite/gfortran.dg/repeat_1.f90 b/gcc/testsuite/gfortran.dg/repeat_1.f90
new file mode 100644
index 000000000..7a1d6f929
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/repeat_1.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-shouldfail "negative NCOPIES argument to REPEAT intrinsic" }
+  character(len=80) :: str
+  integer :: i
+  i = -1
+  write(str,"(a)") repeat ("a", f())
+  if (trim(str) /= "aaaa") call abort
+  write(str,"(a)") repeat ("a", i)
+
+contains
+
+  integer function f()
+    integer :: x = 5
+    save x
+
+    x = x - 1
+    f = x
+  end function f
+end
+! { dg-output "Fortran runtime error: Argument NCOPIES of REPEAT intrinsic is negative .* line 6)"
diff --git a/gcc/testsuite/gfortran.dg/repeat_2.f90 b/gcc/testsuite/gfortran.dg/repeat_2.f90
new file mode 100644
index 000000000..d71f1860a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/repeat_2.f90
@@ -0,0 +1,92 @@
+! REPEAT intrinsic
+!
+! { dg-do run }
+subroutine foo(i, j, s, t)
+  implicit none
+  integer, intent(in) :: i, j
+  character(len=i), intent(in) :: s
+  character(len=i*j), intent(in) :: t
+
+  if (repeat(s,j) /= t) call abort
+  call bar(j,s,t)
+end subroutine foo
+
+subroutine bar(j, s, t)
+  implicit none
+  integer, intent(in) :: j
+  character(len=*), intent(in) :: s
+  character(len=len(s)*j), intent(in) :: t
+
+  if (repeat(s,j) /= t) call abort
+end subroutine bar
+
+program test
+  implicit none
+  character(len=0), parameter :: s0 = "" 
+  character(len=1), parameter :: s1 = "a"
+  character(len=2), parameter :: s2 = "ab"
+  character(len=0) :: t0 
+  character(len=1) :: t1
+  character(len=2) :: t2
+  integer :: i
+
+  t0 = ""
+  t1 = "a"
+  t2 = "ab"
+
+  if (repeat(t0, 0) /= "") call abort
+  if (repeat(t1, 0) /= "") call abort
+  if (repeat(t2, 0) /= "") call abort
+  if (repeat(t0, 1) /= "") call abort
+  if (repeat(t1, 1) /= "a") call abort
+  if (repeat(t2, 1) /= "ab") call abort
+  if (repeat(t0, 2) /= "") call abort
+  if (repeat(t1, 2) /= "aa") call abort
+  if (repeat(t2, 2) /= "abab") call abort
+
+  if (repeat(s0, 0) /= "") call abort
+  if (repeat(s1, 0) /= "") call abort
+  if (repeat(s2, 0) /= "") call abort
+  if (repeat(s0, 1) /= "") call abort
+  if (repeat(s1, 1) /= "a") call abort
+  if (repeat(s2, 1) /= "ab") call abort
+  if (repeat(s0, 2) /= "") call abort
+  if (repeat(s1, 2) /= "aa") call abort
+  if (repeat(s2, 2) /= "abab") call abort
+
+  i = 0
+  if (repeat(t0, i) /= "") call abort
+  if (repeat(t1, i) /= "") call abort
+  if (repeat(t2, i) /= "") call abort
+  i = 1
+  if (repeat(t0, i) /= "") call abort
+  if (repeat(t1, i) /= "a") call abort
+  if (repeat(t2, i) /= "ab") call abort
+  i = 2
+  if (repeat(t0, i) /= "") call abort
+  if (repeat(t1, i) /= "aa") call abort
+  if (repeat(t2, i) /= "abab") call abort
+
+  i = 0
+  if (repeat(s0, i) /= "") call abort
+  if (repeat(s1, i) /= "") call abort
+  if (repeat(s2, i) /= "") call abort
+  i = 1
+  if (repeat(s0, i) /= "") call abort
+  if (repeat(s1, i) /= "a") call abort
+  if (repeat(s2, i) /= "ab") call abort
+  i = 2
+  if (repeat(s0, i) /= "") call abort
+  if (repeat(s1, i) /= "aa") call abort
+  if (repeat(s2, i) /= "abab") call abort
+
+  call foo(0,0,"","")
+  call foo(0,1,"","")
+  call foo(0,2,"","")
+  call foo(1,0,"a","")
+  call foo(1,1,"a","a")
+  call foo(1,2,"a","aa")
+  call foo(2,0,"ab","")
+  call foo(2,1,"ab","ab")
+  call foo(2,2,"ab","abab")
+end program test
diff --git a/gcc/testsuite/gfortran.dg/repeat_3.f90 b/gcc/testsuite/gfortran.dg/repeat_3.f90
new file mode 100644
index 000000000..d571fc6e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/repeat_3.f90
@@ -0,0 +1,29 @@
+! REPEAT intrinsic, test for PR 31304
+! We check that REPEAT accepts all kind arguments for NCOPIES
+!
+! { dg-do run }
+program test
+  implicit none
+
+  integer(kind=1) i1
+  integer(kind=2) i2
+  integer(kind=4) i4
+  integer(kind=4) i8
+  real(kind=8) r
+  character(len=2) s1, s2
+
+  i1 = 1 ; i2 = 1 ; i4 = 1 ; i8 = 1
+  r = 1
+  s1 = '42'
+  r = nearest(r,r)
+
+  s2 = repeat(s1,i1)
+  if (s2 /= s1) call abort
+  s2 = repeat(s1,i2)
+  if (s2 /= s1) call abort
+  s2 = repeat(s1,i4)
+  if (s2 /= s1) call abort
+  s2 = repeat(s1,i8)
+  if (s2 /= s1) call abort
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/repeat_4.f90 b/gcc/testsuite/gfortran.dg/repeat_4.f90
new file mode 100644
index 000000000..e5b5acc60
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/repeat_4.f90
@@ -0,0 +1,38 @@
+! REPEAT intrinsic -- various checks should be enforced
+!
+! { dg-do compile }
+program test
+  implicit none
+  character(len=0), parameter :: s0 = "" 
+  character(len=1), parameter :: s1 = "a"
+  character(len=2), parameter :: s2 = "ab"
+  character(len=0) :: t0
+  character(len=1) :: t1
+  character(len=2) :: t2
+
+  t0 = "" ; t1 = "a" ; t2 = "ab"
+
+  ! Check for negative NCOPIES argument
+  print *, repeat(s0, -1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is negative" }
+  print *, repeat(s1, -1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is negative" }
+  print *, repeat(s2, -1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is negative" }
+  print *, repeat(t0, -1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is negative" }
+  print *, repeat(t1, -1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is negative" }
+  print *, repeat(t2, -1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is negative" }
+
+  ! Check for too large NCOPIES argument and limit cases
+  print *, repeat(t0, huge(0))
+  print *, repeat(t1, huge(0))
+  print *, repeat(t2, huge(0)) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is too large " }
+  print *, repeat(s2, huge(0)) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is too large " }
+
+  print *, repeat(t0, huge(0)/2)
+  print *, repeat(t1, huge(0)/2)
+  print *, repeat(t2, huge(0)/2)
+
+  print *, repeat(t0, huge(0)/2+1)
+  print *, repeat(t1, huge(0)/2+1)
+  print *, repeat(t2, huge(0)/2+1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is too large " }
+  print *, repeat(s2, huge(0)/2+1) ! { dg-error "Argument NCOPIES of REPEAT intrinsic is too large " }
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/repeat_5.f90 b/gcc/testsuite/gfortran.dg/repeat_5.f90
new file mode 100644
index 000000000..48acea53f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/repeat_5.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+!
+! PR32472 -- character literals were not implemented in REPEAT.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+  CHARACTER(len=1025) :: string2 = repeat('?',1025)
+  print *, string2
+end
diff --git a/gcc/testsuite/gfortran.dg/repeat_6.f90 b/gcc/testsuite/gfortran.dg/repeat_6.f90
new file mode 100644
index 000000000..308941f9a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/repeat_6.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+!
+! PR34559 -- ICE on empty string literals
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+
+  character(len=200) :: string = "a" // repeat ("", 3)       &
+                                     // repeat ("xxx", 0)    &
+                                     // repeat ("string", 2)
+
+  if (string /= "astringstring") CALL abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/reshape-alloc.f90 b/gcc/testsuite/gfortran.dg/reshape-alloc.f90
new file mode 100644
index 000000000..c4c7a0e2a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape-alloc.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! PR 20074: This used to segfault at runtime.
+! Test case contributed by "Alfredo Buttari" <pitagoras@tin.it>
+
+program tryreshape
+
+  integer,allocatable :: vect1(:),resh1(:,:)
+  integer,pointer :: vect(:),resh(:,:)
+  integer :: vect2(2*4), resh2(2,4)
+  integer :: r, s(2)
+
+  r=2;  nb=4
+
+  s(:)=(/r,nb/)
+
+  allocate(vect(nb*r),vect1(nb*r))
+  allocate(resh(r,nb),resh1(r,nb))
+
+  vect =1
+  vect1=1
+  vect2=1
+
+  resh2 = reshape(vect2,s)
+  if (resh2(1,1) /= 1.0) call abort
+
+  resh1 = reshape(vect1,s)
+  if (resh1(1,1) /= 1.0) call abort
+
+  resh = reshape(vect,s)
+  if (resh(1,1) /= 1.0) call abort
+
+end program tryreshape
diff --git a/gcc/testsuite/gfortran.dg/reshape-complex.f90 b/gcc/testsuite/gfortran.dg/reshape-complex.f90
new file mode 100644
index 000000000..72cafe4f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape-complex.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! PR 21127:  Reshape of complex didn't work.
+! PR 21480:  Reshape of packed complex arrays didn't work either.
+program main
+  complex, dimension(8) :: b
+  complex, dimension(2,2) :: a
+  complex, dimension(2) :: c,d
+  integer :: i
+  b = (/(i,i=1,8)/)
+  a = reshape(b(1:8:2),shape(a))
+  if (a(1,1) /= (1.0, 0.0) .or. a(2,1) /= (3.0, 0.0) .or.  &
+      a(1,2) /= (5.0, 0.0) .or. a(2,2) /= (7.0, 0.0)) call abort
+  c = (/( 3.14, -3.14), (2.71, -2.71)/)
+  d = reshape(c, shape (d))
+  if (any (c .ne. d)) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/reshape.f90 b/gcc/testsuite/gfortran.dg/reshape.f90
new file mode 100644
index 000000000..3dba09892
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! This tests a few reshape PRs.
+program resh
+  implicit none
+  real, dimension (2,3) :: a,c
+  real, dimension (12) :: b
+  type foo
+    real :: r
+  end type foo
+  type(foo), dimension (2,3) :: ar
+  type(foo), dimension (12) :: br
+
+  character (len=80) line1, line2, line3
+  integer :: i
+
+  ! PR 21108:  This used to give undefined results.
+  b = (/(i,i=1,12)/)
+  a = reshape(b(1:12:2),shape(a),order=(/2,1/))
+  c = reshape(b(1:12:2),shape(a),order=(/2,1/))
+  if (any (a /= c)) call abort
+
+  ! Test generic reshape
+  br%r = b
+  ar = reshape(br(1:12:2),shape(a),order=(/2,1/))
+  if (any (ar%r /= a)) call abort
+
+  ! Test callee-allocated memory with a write statement
+  write (line1,'(6F8.3)') reshape(b(1:12:2),shape(a),order=(/2,1/))
+  write (line2,'(6F8.3)') a
+  if (line1 /= line2 ) call abort
+  write (line3,'(6F8.3)') reshape(br(1:12:2),shape(ar),order=(/2,1/))
+  if (line1 /= line3 ) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/reshape_2.f90 b/gcc/testsuite/gfortran.dg/reshape_2.f90
new file mode 100644
index 000000000..d28058ddd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_2.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! PR34556 Rejects valid with bogus error message: parameter initalization
+! Found using the Fortran Company Fortran 90 Test Suite (Lite),
+! Version 1.4
+! Test case modified by Jerry DeLisle  <jvdelisle@gcc.gnu.org to
+! show correct results.
+module splitprms
+      integer, parameter  :: nplam = 3 ! # of plans to expand TABs
+      integer, parameter  :: linem = 132 ! max. line length
+      integer, parameter  :: ncntm = 39 ! max. # cont. lines
+      integer, parameter, dimension (linem, nplam) :: nxttab =  &
+      reshape ([[(6, i= 1, 2*linem) ], [(i, i= 1,linem)],    &
+                max ([(i, i= 1,linem)], [(10*i, i= 1,linem)])],      &
+               [linem, nplam ])
+end module splitprms
+
+program test
+  use splitprms
+  if (nxttab(1, 1) .ne. 6) call abort
+  if (nxttab(1, nplam) .ne. 1) call abort
+  if (nxttab(linem, 1) .ne. 6) call abort
+  if (nxttab(linem, nplam) .ne. 132) call abort
+end program test
+! { dg-final { cleanup-modules "splitprms" } }
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/reshape_3.f90 b/gcc/testsuite/gfortran.dg/reshape_3.f90
new file mode 100644
index 000000000..a9f44b414
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_3.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+program main
+  implicit none
+  integer, dimension(2,2) :: a4
+  integer(kind=1), dimension(2,2) :: a1
+  character(len=100) line
+  data a4 /1, 2, 3, 4/
+  a1 = a4
+  write (unit=line,fmt='(4I3)') reshape(a4,(/4/))
+  write (unit=line,fmt='(4I3)') reshape(a1,(/4/))
+end program main
diff --git a/gcc/testsuite/gfortran.dg/reshape_4.f90 b/gcc/testsuite/gfortran.dg/reshape_4.f90
new file mode 100644
index 000000000..92208e57d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_4.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+program main
+  real, dimension(2,2) :: result
+  real, dimension(6) :: source
+  real, dimension(2) :: pad
+
+  call random_number (source)
+  call random_number (pad)
+
+  result = reshape(source, shape(result),pad=pad(1:0))
+  result = reshape(source, shape(result))
+  result = reshape(source, shape(result),pad=pad)
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/reshape_empty_1.f03 b/gcc/testsuite/gfortran.dg/reshape_empty_1.f03
new file mode 100644
index 000000000..cac7e7360
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_empty_1.f03
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/38184
+! invariant RESHAPE not expanded if SOURCE is empty.
+!
+! Original program by James Van Buskirk
+
+integer, parameter :: N = 3
+integer, parameter :: A(N,N) = reshape([integer::],[N,N],reshape([1],[N+1],[2]))
+integer, parameter :: K = N*A(2,2)+A(2,3)
+integer :: B(N,N) = reshape([1,2,2,2,1,2,2,2,1],[3,3])
+integer :: i
+i = 5
+if (any(A /= B)) call abort
+if (K /= i) call abort
+end
+
+! { dg-final { scan-tree-dump-times "\\\{1, 2, 2, 2, 1, 2, 2, 2, 1\\\}" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/reshape_order_1.f90 b/gcc/testsuite/gfortran.dg/reshape_order_1.f90
new file mode 100644
index 000000000..880d9d76b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_order_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Duplicate value 2 in ORDER argument to RESHAPE intrinsic" }
+program main
+  implicit none
+  integer(kind=1), dimension(6) :: source1 = (/ 1, 2, 3, 4, 5, 6 /)
+  integer, dimension(2) :: shape1 = (/ 2, 3/)
+  integer(kind=1), dimension(2) :: pad1 = (/ 0, 0/)
+  character(len=200) :: l1, l2
+  integer :: i1, i2
+
+  l1 = "2 2"
+  read(unit=l1,fmt=*) i1, i2
+  write (unit=l2,fmt=*) reshape(source1, shape1, pad1, (/i1, i2/)) ! Invalid
+end program main
+! { dg-output "Fortran runtime error: Duplicate value 2 in ORDER argument to RESHAPE intrinsic" }
+
+
diff --git a/gcc/testsuite/gfortran.dg/reshape_order_2.f90 b/gcc/testsuite/gfortran.dg/reshape_order_2.f90
new file mode 100644
index 000000000..20a6f19b9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_order_2.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Value 3 out of range in ORDER argument to RESHAPE intrinsic" }
+program main
+  implicit none
+  integer(kind=1), dimension(6) :: source1 = (/ 1, 2, 3, 4, 5, 6 /)
+  integer, dimension(2) :: shape1 = (/ 2, 3/)
+  integer(kind=1), dimension(2) :: pad1 = (/ 0, 0/)
+  character(len=200) :: l1, l2
+  integer :: i1, i2
+
+  l1 = "3 2"
+  read(unit=l1,fmt=*) i1, i2
+  write (unit=l2,fmt=*) reshape(source1, shape1, pad1, (/i1, i2/)) ! Invalid
+end program main
+! { dg-output "Fortran runtime error: Value 3 out of range in ORDER argument to RESHAPE intrinsic" }
diff --git a/gcc/testsuite/gfortran.dg/reshape_order_3.f90 b/gcc/testsuite/gfortran.dg/reshape_order_3.f90
new file mode 100644
index 000000000..4b757f81c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_order_3.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Duplicate value 2 in ORDER argument to RESHAPE intrinsic" }
+program main
+  implicit none
+  integer(kind=4), dimension(6) :: source1 = (/ 1, 2, 3, 4, 5, 6 /)
+  integer, dimension(2) :: shape1 = (/ 2, 3/)
+  integer(kind=4), dimension(2) :: pad1 = (/ 0, 0/)
+  character(len=200) :: l1, l2
+  integer :: i1, i2
+  
+  l1 = "2 2"
+  read(unit=l1,fmt=*) i1, i2
+  write (unit=l2,fmt=*) reshape(source1, shape1, pad1, (/i1, i2/)) ! Invalid
+end program main
+! { dg-output "Fortran runtime error: Duplicate value 2 in ORDER argument to RESHAPE intrinsic" }
diff --git a/gcc/testsuite/gfortran.dg/reshape_order_4.f90 b/gcc/testsuite/gfortran.dg/reshape_order_4.f90
new file mode 100644
index 000000000..c66df8e83
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_order_4.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Value 0 out of range in ORDER argument to RESHAPE intrinsic" }
+program main
+  implicit none
+  integer(kind=4), dimension(6) :: source1 = (/ 1, 2, 3, 4, 5, 6 /)
+  integer, dimension(2) :: shape1 = (/ 2, 3/)
+  integer(kind=4), dimension(2) :: pad1 = (/ 0, 0/)
+  character(len=200) :: l1, l2
+  integer :: i1, i2
+
+  l1 = "0 2"
+  read(unit=l1,fmt=*) i1, i2
+  write (unit=l2,fmt=*) reshape(source1, shape1, pad1, (/i1, i2/)) ! Invalid
+end program main
+! { dg-output "Fortran runtime error: Value 0 out of range in ORDER argument to RESHAPE intrinsic" }
diff --git a/gcc/testsuite/gfortran.dg/reshape_order_5.f90 b/gcc/testsuite/gfortran.dg/reshape_order_5.f90
new file mode 100644
index 000000000..2ef5fce6d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_order_5.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! PR fortran/37203 - check RESHAPE arguments
+!
+
+  integer, dimension(6) :: source1 = (/ 1, 2, 3, 4, 5, 6 /)
+  integer, dimension(2) :: shape1 = (/ 2, 5/)
+  integer, dimension(2) :: pad1 = (/ 0, 0/)
+  integer, dimension(2) :: t(2,5)
+
+  t = reshape(source1, shape1, pad1, (/2, 1/))        ! ok
+  t = reshape(source1, shape1, pad1, (/2.1, 1.2/))    ! { dg-error "must be INTEGER" }
+  t = reshape(source1, shape1, pad1, (/2, 2/))        ! { dg-error "invalid permutation" }
+  t = reshape(source1, shape1, pad1, (/2, 3/))        ! { dg-error "out-of-range dimension" }
+  t = reshape(source1, shape1, pad1, (/2/))           ! { dg-error "wrong number of elements" }
+end
diff --git a/gcc/testsuite/gfortran.dg/reshape_pad_1.f90 b/gcc/testsuite/gfortran.dg/reshape_pad_1.f90
new file mode 100644
index 000000000..33afd89e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_pad_1.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! PR 38135 - pad to RESHAPE didn't work correctly when SOURCE
+! was an empty array.
+
+program main
+  implicit none
+  integer, parameter :: N = 3
+  integer(kind=1) :: A1(N,N)
+  integer(kind=1) :: b1(n+1)
+  integer(kind=4) :: A4(n,n)
+  integer(kind=4) :: b4(n+1)
+  character(len=9) :: line
+
+  b1 = (/ 1, 2, 2, 2 /)
+
+  A1(1:N,1:N)=reshape(A1(1:0,1),(/N,N/),b1)
+  write(unit=line,fmt='(100i1)') A1
+  if (line .ne. "122212221") call abort
+
+  b4 = (/ 3, 4, 4, 4 /)
+
+  a4 = reshape(a4(:0,1),(/n,n/),b4)
+  write(unit=line,fmt='(100i1)') a4
+  if (line .ne. "344434443") call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/reshape_rank7.f90 b/gcc/testsuite/gfortran.dg/reshape_rank7.f90
new file mode 100644
index 000000000..a003de013
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_rank7.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! PR 21075:  Reshape with rank 7 used to segfault.
+program main
+  integer :: a(256), b(2,2,2,2,2,2,2)
+  do i=1,256
+     a(i) = i
+  end do
+  b = reshape(a(1:256:2), shape(b))
+  do i1=1,2
+     do i2=1,2
+        do i3=1,2
+           do i4=1,2
+              do i5=1,2
+                 do i6=1,2
+                    do i7=1,2
+                       if (b(i1,i2,i3,i4,i5,i6,i7) /= &
+                            2*((i1-1)+(i2-1)*2+(i3-1)*4+(i4-1)*8+&
+                            (i5-1)*16+(i6-1)*32+(i7-1)*64)+1) &
+                            call abort
+              end do
+            end do
+          end do
+        end do
+      end do
+    end do
+  end do
+end program main
diff --git a/gcc/testsuite/gfortran.dg/reshape_shape_1.f90 b/gcc/testsuite/gfortran.dg/reshape_shape_1.f90
new file mode 100644
index 000000000..bd5e3cb40
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_shape_1.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+!
+! PR fortran/37203 - check RESHAPE arguments
+!
+
+  integer, dimension(6) :: source1 = (/ 1, 2, 3, 4, 5, 6 /)
+  integer, dimension(2) :: pad1 = (/ 0, 0/)
+  integer, dimension(2) :: t(2,5)
+  integer :: i
+
+  t = reshape(source1, SHAPE(0), pad1, (/2, 1/))      ! { dg-error "is empty" }
+  t = reshape(source1, (/(i,i=1,32)/), pad1, (/2, 1/))    ! { dg-error "has more than" }
+  t = reshape(source1, (/ 2, -5/), pad1, (/2, 1/))    ! { dg-error "negative element" }
+end
diff --git a/gcc/testsuite/gfortran.dg/reshape_source_size_1.f90 b/gcc/testsuite/gfortran.dg/reshape_source_size_1.f90
new file mode 100644
index 000000000..8290f6135
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_source_size_1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! Tests patch for PR29758, which arose from PR29431.  There was no check that there
+! were enough elements in the source to match the shape.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+   real :: a(2,2), b = 1.0, c(3), d(4)
+   a = reshape ([b], [2,2]) ! { dg-error "not enough elements" }
+   a = reshape (c, [2,2])   ! { dg-error "not enough elements" }
+   a = reshape (d, [2,2])
+end
diff --git a/gcc/testsuite/gfortran.dg/reshape_transpose_1.f90 b/gcc/testsuite/gfortran.dg/reshape_transpose_1.f90
new file mode 100644
index 000000000..5ca52640f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_transpose_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR 31196 - reshape of transposed derived types generated
+!            wront results.
+program main
+  implicit none
+  TYPE datatype
+     INTEGER :: I
+  END TYPE datatype
+  character (len=20) line1, line2
+  TYPE(datatype), dimension(2,2) :: data, result
+  data(1,1)%i = 1
+  data(2,1)%i = 2
+  data(1,2)%i = 3
+  data(2,2)%i = 4
+  write (unit=line1, fmt="(4I4)") reshape(transpose(data),shape(data))
+  write (unit=line2, fmt="(4I4)") (/ 1, 3, 2, 4 /)
+  if (line1 /= line2) call abort
+END program main
diff --git a/gcc/testsuite/gfortran.dg/reshape_zerosize_1.f90 b/gcc/testsuite/gfortran.dg/reshape_zerosize_1.f90
new file mode 100644
index 000000000..61896ab97
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_zerosize_1.f90
@@ -0,0 +1,39 @@
+!  { dg-do run }
+!  PR 35960 - there was a run-time abort when the SHAPE argument to
+!  RESHAPE was zero-sized.
+!  Test case contributed by Dick Henderson.
+      program try_gf1065
+
+
+! fails on Windows XP
+! gcc version 4.4.0 20080312 (experimental) [trunk revision 133139]
+
+
+      call       gf1065(1,  2,  3,  4,  7,  8,  9)
+      end
+
+      SUBROUTINE GF1065(nf1,nf2,nf3,nf4,nf7,nf8,nf9)
+
+      REAL RDA(10,9)
+      REAL RCA1(90)
+      integer ila(2)
+      RDA(NF9:NF8, NF7:NF3) = RESHAPE(RCA1,(/0,0/), (/1.0/),(/2,1/))
+
+      rDA(NF9:NF8, NF7:NF3) = RESHAPE(rCA1,(/0,0/),ORDER=(/2,1/))
+
+      ILA(1) = 5
+      ILA(2) = 0
+      rDA(NF4:NF8, NF7:NF3) = RESHAPE(rcA1,ILA)
+
+      RdA(NF4:NF8, NF7:NF3) = RESHAPE(RcA1,ILA,PAD=(/-1.0/))
+
+      ILA(1) = 0
+      ILA(2) = 5
+      RdA(NF9:NF8,NF4:NF8)=RESHAPE(RcA1,ILA,(/-1.0/),(/NF2,NF1/))
+
+      ILA(1) = 5
+      ILA(2) = 0
+      RdA(NF4:NF8, NF7:NF3) = RESHAPE(RcA1,ILA,ORDER=(/NF1,NF2/))
+
+
+      END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/reshape_zerosize_2.f90 b/gcc/testsuite/gfortran.dg/reshape_zerosize_2.f90
new file mode 100644
index 000000000..474ea300d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_zerosize_2.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+
+  ! Simplifier of RESHAPE was broken when reshaping an empty array.
+  INTEGER, PARAMETER :: empty(0,0) = RESHAPE(SHAPE(1), (/0, 0/))
+
+  ! same with surplus padding
+  INTEGER, PARAMETER :: empty_padding(0,0) = RESHAPE(SHAPE(1), (/0, 0/), PAD=( (/ 1, 2 /) ))
+
+  ! same with required padding
+  INTEGER, PARAMETER :: non_empty(2,2) = RESHAPE(SHAPE(1), (/2, 2/), PAD=( (/ 1, 2 /) ))
+END
diff --git a/gcc/testsuite/gfortran.dg/reshape_zerosize_3.f90 b/gcc/testsuite/gfortran.dg/reshape_zerosize_3.f90
new file mode 100644
index 000000000..870a76c65
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_zerosize_3.f90
@@ -0,0 +1,43 @@
+! { dg-do run }
+! PR 49479 - this used not to print anything.
+! Test case by Joost VandeVondele.
+MODULE M1
+  IMPLICIT NONE
+  type foo
+     character(len=5) :: x
+  end type foo
+CONTAINS
+  SUBROUTINE S1(data)
+    INTEGER, DIMENSION(:), INTENT(IN), &
+         OPTIONAL                               :: DATA
+    character(20) :: line
+    IF (.not. PRESENT(data)) call abort
+    write (unit=line,fmt='(I5)') size(data)
+    if (line /= '    0               ') call abort
+  END SUBROUTINE S1
+
+  subroutine s_type(data)
+    type(foo), dimension(:), intent(in), optional :: data
+    character(20) :: line
+    IF (.not. PRESENT(data)) call abort
+    write (unit=line,fmt='(I5)') size(data)
+    if (line /= '    0               ') call abort
+  end subroutine s_type
+
+  SUBROUTINE S2(N)
+    INTEGER :: N
+    INTEGER, ALLOCATABLE, DIMENSION(:, :)    :: blki
+    type(foo), allocatable, dimension(:, :)  :: bar
+    ALLOCATE(blki(3,N))
+    allocate (bar(3,n))
+    blki=0
+    CALL S1(RESHAPE(blki,(/3*N/)))
+    call s_type(reshape(bar, (/3*N/)))
+  END SUBROUTINE S2
+
+END MODULE M1
+
+USE M1
+CALL S2(0)
+END
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/restricted_expression_1.f90 b/gcc/testsuite/gfortran.dg/restricted_expression_1.f90
new file mode 100644
index 000000000..45211a585
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/restricted_expression_1.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-pedantic -ffixed-form" }
+
+! PR fortran/35723
+! An argument subscript into a parameter array was not allowed as
+! dimension.  Check this is fixed.
+
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+
+      call       vf0016(  1,  2,  3)
+
+      end
+      SUBROUTINE VF0016(nf1,nf2,nf3)
+      CHARACTER(LEN=9,KIND=1),DIMENSION(3), PARAMETER
+     $     ::  TEST_STRINGS =
+     $  (/'       HI','ABC      ','  CDEFG  '/)
+      CHARACTER :: TEST_ARRAY
+     $(LEN_TRIM(ADJUSTL(TEST_STRINGS(nf1))),
+     $ SUM(LEN_TRIM(ADJUSTL(TEST_STRINGS))),
+     $ LEN_TRIM(ADJUSTL(ADJUSTR(TEST_STRINGS(3)))),
+     $ SUM(LEN_TRIM(ADJUSTL(ADJUSTR(TEST_STRINGS(NF1:NF3:NF2)))))   )
+
+       print *, 2, 10, 5, 7
+       print *, shape (test_array)
+         end
diff --git a/gcc/testsuite/gfortran.dg/restricted_expression_2.f90 b/gcc/testsuite/gfortran.dg/restricted_expression_2.f90
new file mode 100644
index 000000000..9c281664a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/restricted_expression_2.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-pedantic -ffixed-form" }
+
+! PR fortran/35723
+! Check that a program using a local variable subscript is still rejected.
+
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+      call       vf0016(  1,  2,  3)
+
+      end
+      SUBROUTINE VF0016(nf1,nf2,nf3)
+      CHARACTER(LEN=9,KIND=1),DIMENSION(3), PARAMETER
+     $     ::  TEST_STRINGS =
+     $  (/'       HI','ABC      ','  CDEFG  '/)
+      INTEGER :: i = 2
+      CHARACTER :: TEST_ARRAY
+     $(LEN_TRIM(ADJUSTL(TEST_STRINGS(i))), ! { dg-error "'i' cannot appear" }
+     $ SUM(LEN_TRIM(ADJUSTL(TEST_STRINGS))),
+     $ LEN_TRIM(ADJUSTL(ADJUSTR(TEST_STRINGS(3)))),
+     $ SUM(LEN_TRIM(ADJUSTL(ADJUSTR(TEST_STRINGS(NF1:NF3:NF2)))))   )
+
+       print *, 2, 10, 5, 7
+       print *, shape (test_array)
+         end
diff --git a/gcc/testsuite/gfortran.dg/restricted_expression_3.f90 b/gcc/testsuite/gfortran.dg/restricted_expression_3.f90
new file mode 100644
index 000000000..0b84f67aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/restricted_expression_3.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+
+! PR fortran/35723
+! Check that a dummy-argument array with non-restricted subscript is
+! rejected and some more reference-checks.
+
+PROGRAM main
+  IMPLICIT NONE
+  CALL test (5, (/ 1, 2, 3, 4, 5, 6, 7, 8, 9 /), "0123456789" )
+
+CONTAINS
+
+  SUBROUTINE test (n, arr, str)
+    IMPLICIT NONE
+    INTEGER :: n, arr(:)
+    CHARACTER(len=10) :: str
+
+    INTEGER :: i = 5
+    INTEGER :: ok1(arr(n)), ok2(LEN_TRIM (str(3:n)))
+    INTEGER :: ok3(LEN_TRIM("hello, world!"(2:n)))
+    INTEGER :: wrong1(arr(i)) ! { dg-error "'i' cannot appear" }
+    INTEGER :: wrong2(LEN_TRIM (str(i:n))) ! { dg-error "'i' cannot appear" }
+    INTEGER :: wrong3(LEN_TRIM ("hello, world!"(i:n))) ! { dg-error "'i' cannot appear" }
+  END SUBROUTINE test
+
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/result_1.f90 b/gcc/testsuite/gfortran.dg/result_1.f90
new file mode 100644
index 000000000..162ffaf58
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/result_1.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+!
+! PR 36704: Procedure pointer as function result
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+function f() result(r)
+real, parameter :: r = 5.0    ! { dg-error "attribute conflicts" }
+end function 
+
+function g() result(s)
+real :: a,b,c
+namelist /s/ a,b,c    ! { dg-error "attribute conflicts" }
+end function
+
+function h() result(t)
+type t    ! { dg-error "attribute conflicts" }
+end function
diff --git a/gcc/testsuite/gfortran.dg/result_default_init_1.f90 b/gcc/testsuite/gfortran.dg/result_default_init_1.f90
new file mode 100644
index 000000000..58872dfa6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/result_default_init_1.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! { dg-options "-O" }
+! Test the fix for PR29216 in which function results did not
+! get default initialization.
+! Contributed by Stephan Kramer  <stephan.kramer@imperial.ac.uk>  
+!
+  type A
+    integer, pointer:: p => null ()
+    integer:: i=3
+  end type A
+  type(A):: x,y
+  if (associated(x%p) .or. x%i /= 3) call abort ()
+  x=f()
+  if (associated(x%p) .or. x%i /= 3) call abort ()
+  x=g()
+  if (associated(x%p) .or. x%i /= 3) call abort ()
+contains
+  function f() result (fr)
+    type(A):: fr
+    if (associated(fr%p) .or. fr%i /= 3) call abort ()
+  end function f
+  function g()
+    type(A):: g
+    if (associated(g%p) .or. g%i /= 3) call abort ()
+  end function g
+end
diff --git a/gcc/testsuite/gfortran.dg/result_in_spec_1.f90 b/gcc/testsuite/gfortran.dg/result_in_spec_1.f90
new file mode 100644
index 000000000..cbeb60f2d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/result_in_spec_1.f90
@@ -0,0 +1,52 @@
+! { dg-do run }
+! Tests the check for PR31215, in which actual/formal interface 
+! was not being correctly handled for the size of 'r' because
+! it is a result.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+module test1
+  implicit none
+contains
+  character(f(x)) function test2(x) result(r)
+    implicit integer (x)
+    dimension r(len(r)+1)
+    integer, intent(in) :: x
+    interface
+      pure function f(x)
+        integer, intent(in) :: x
+        integer f
+      end function f
+    end interface
+    integer i
+    do i = 1, len(r)
+      r(:)(i:i) = achar(mod(i,32)+iachar('@'))
+    end do
+  end function test2
+end module test1
+
+program test
+  use test1
+  implicit none
+! Original problem
+  if (len(test2(10)) .ne. 21) call abort ()
+! Check non-intrinsic calls are OK and check that fix does
+! not confuse result variables.
+  if (any (myfunc (test2(1)) .ne. "ABC")) call abort ()
+contains
+  function myfunc (ch) result (chr)
+    character (*) :: ch(:)
+    character(len(ch)) :: chr(4)
+    if (len (ch) .ne. 3) call abort ()
+    if (any (ch .ne. "ABC")) call abort ()
+    chr = test2 (1)
+    if (len(test2(len(chr))) .ne. 7) call abort ()
+  end function myfunc
+end program test
+
+pure function f(x)
+  integer, intent(in) :: x
+  integer f
+  f = 2*x+1
+end function f
+! { dg-final { cleanup-modules "test1" } }
diff --git a/gcc/testsuite/gfortran.dg/result_in_spec_2.f90 b/gcc/testsuite/gfortran.dg/result_in_spec_2.f90
new file mode 100644
index 000000000..cffa2300c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/result_in_spec_2.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! Tests the fix for PR32047, in which the null agument
+! function for the character length would cause an ICE.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org >
+!
+module test1
+  implicit none
+contains
+  character(f()) function test2() result(r)
+    interface
+      pure function f()
+        integer f
+      end function f
+    end interface
+    r = '123'
+  end function test2
+end module test1
+
+pure function f()
+  integer :: f
+  f = 3
+end function f
+
+program test
+  use test1
+  implicit none
+  if(len (test2()) /= 3) call abort ()
+  if(test2() /= '123') call abort ()
+end program test
+! { dg-final { cleanup-modules "test1" } }
diff --git a/gcc/testsuite/gfortran.dg/result_in_spec_3.f90 b/gcc/testsuite/gfortran.dg/result_in_spec_3.f90
new file mode 100644
index 000000000..32743c32c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/result_in_spec_3.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-std=gnu -Wreturn-type" }
+! PR fortran/34248
+!
+! There was an ICE for assumed-length functions
+! if RESULT(...) was used and no value assigned
+! to the result variable.
+!
+character(*) FUNCTION test() RESULT(ctab)
+  ctab = "Hello"
+END function test
+
+FUNCTION test2() RESULT(res)      ! { dg-warning "not set" }
+  character(*) :: res
+END function test2
diff --git a/gcc/testsuite/gfortran.dg/result_in_spec_4.f90 b/gcc/testsuite/gfortran.dg/result_in_spec_4.f90
new file mode 100644
index 000000000..3f0e9a379
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/result_in_spec_4.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+!
+! PR fortran/49648
+! ICE for calls to a use-associated function returning an array whose spec
+! depends on a function call.
+
+! Contributed by Tobias Burnus <burnus@net-b.de>
+
+module m2
+  COMPLEX, SAVE, ALLOCATABLE :: P(:)
+contains
+  FUNCTION getPhaseMatrix() RESULT(PM)
+    COMPLEX:: PM(SIZE(P),3)
+    PM=0.0
+  END FUNCTION
+end module m2
+
+module m
+  use m2
+contains
+   SUBROUTINE gf_generateEmbPot()
+      COMPLEX :: sigma2(3,3)
+      sigma2 = MATMUL(getPhaseMatrix(), sigma2)
+   END SUBROUTINE
+end module m
+
+! { dg-final { cleanup-modules "m m2" } }
diff --git a/gcc/testsuite/gfortran.dg/ret_array_1.f90 b/gcc/testsuite/gfortran.dg/ret_array_1.f90
new file mode 100644
index 000000000..45e5a07c1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ret_array_1.f90
@@ -0,0 +1,63 @@
+! { dg-do run }
+! Test functions returning arrays of indeterminate size.
+program ret_array_1
+  integer, dimension(:, :), allocatable :: a
+  integer, dimension(2) :: b
+
+  allocate (a(2, 3))
+  a = reshape ((/1, 2, 3, 4, 5, 6/), (/2, 3/))
+  
+  ! Using the return value as an actual argument
+  b = 0;
+  b = sum (transpose (a), 1);
+  if (any (b .ne. (/9, 12/))) call abort ()
+
+  ! Using the return value in an expression
+  b = 0;
+  b = sum (transpose (a) + 1, 1);
+  if (any (b .ne. (/12, 15/))) call abort ()
+
+  ! Same again testing a user function
+! TODO: enable these once this is implemented
+!  b = 0;
+!  b = sum (my_transpose (a), 1);
+!  if (any (b .ne. (/9, 12/))) call abort ()
+!
+!  ! Using the return value in an expression
+!  b = 0;
+!  b = sum (my_transpose (a) + 1, 1);
+!  if (any (b .ne. (/12, 15/))) call abort ()
+contains
+subroutine test(x, n)
+  integer, dimension (:, :) :: x
+  integer n
+
+  if (any (shape (x) .ne. (/3, 2/))) call abort
+  if (any (x .ne. (n + reshape((/1, 4, 2, 5, 3, 6/), (/3, 2/))))) call abort
+end subroutine
+
+function my_transpose (x) result (r)
+  interface
+    pure function obfuscate (i)
+      integer obfuscate
+      integer, intent(in) :: i
+    end function
+  end interface
+  integer, dimension (:, :) :: x
+  integer, dimension (obfuscate(ubound(x, 2)), &
+                      obfuscate(ubound(x, 1))) :: r
+  integer i
+
+  do i = 1, ubound(x, 1)
+    r(:, i) = x(i, :)
+  end do
+end function
+end program
+
+pure function obfuscate (i)
+  integer obfuscate
+  integer, intent(in) :: i
+
+  obfuscate = i
+end function
+
diff --git a/gcc/testsuite/gfortran.dg/ret_pointer_1.f90 b/gcc/testsuite/gfortran.dg/ret_pointer_1.f90
new file mode 100644
index 000000000..765f20a2f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ret_pointer_1.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! Test functions returning array pointers
+program ret_pointer_1
+  integer, pointer, dimension(:) :: a
+  integer, target, dimension(2) :: b
+  integer, pointer, dimension (:) :: p
+
+  a => NULL()
+  a => foo()
+  p => b
+  if (.not. associated (a, p)) call abort
+contains
+subroutine bar(p)
+  integer, pointer, dimension(:) :: p
+end subroutine
+function foo() result(r)
+  integer, pointer, dimension(:) :: r
+
+  r => b
+end function
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/ret_pointer_2.f90 b/gcc/testsuite/gfortran.dg/ret_pointer_2.f90
new file mode 100644
index 000000000..939411b7b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ret_pointer_2.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! PR 25806: Functions returning pointers to arrays
+program a 
+    integer, target :: storage(5)
+    integer :: s(3)
+
+
+    print *, x(3)  ! { dg-output " *1  *2  *3" }
+
+    if (ssum(x(3)) /= 6) call abort()
+
+    s = 0
+    s = x(3)
+    if (any(s /= (/1, 2, 3/))) call abort()
+
+contains
+
+    function x(n) result(t)
+        integer, intent(in) :: n
+        integer, pointer :: t(:)
+        integer :: i
+
+        t => storage(1:n)
+        t = (/ (i, i = 1, n) /)
+
+    end function x
+
+
+    integer function ssum(a)
+        integer, intent(in) :: a(:)
+
+        ssum = sum(a)
+        
+    end function ssum
+
+end program a
+
+
diff --git a/gcc/testsuite/gfortran.dg/return_1.f90 b/gcc/testsuite/gfortran.dg/return_1.f90
new file mode 100644
index 000000000..a8067b03c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/return_1.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! Test cases where no blank is required after RETURN
+subroutine sub(*)
+return(1)
+return1 ! { dg-error "" }
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/rewind_1.f90 b/gcc/testsuite/gfortran.dg/rewind_1.f90
new file mode 100644
index 000000000..92edf6dfe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/rewind_1.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! Check that rewind doesn't delete a file.
+! Writing to the file truncates it at the end of the current record.  Out
+! IO library was defering the actual truncation until the file was rewound.
+! A second rewind would then (incorrectly) think the file had just been
+! written to, and truncate the file to zero length.
+program foo
+  character*11 s
+  open(unit=11, status="SCRATCH")
+  write(11, '(a11)') "Hello World"
+  rewind(11)
+  rewind(11)
+  s = ""
+  read(11, '(a11)') s
+  close(11)
+  if (s .ne. "Hello World") call abort
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/round_1.f03 b/gcc/testsuite/gfortran.dg/round_1.f03
new file mode 100644
index 000000000..db5d6ec92
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/round_1.f03
@@ -0,0 +1,28 @@
+! { dg-do run }
+! PR35962 Implement F2003 rounding modes.
+! Test case prepared by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+character(11) :: fmt(7)
+character(80) :: line
+integer :: i
+fmt = (/'(RU,6F10.1)', '(RD,6F10.1)', '(RZ,6F10.1)', &
+        '(RN,6F10.2)', '(RC,6F10.2)', '(RP,6F10.1)', &
+        '(SP,6F10.1)' /)
+do i = 1, 7
+   !print fmt(i), 1.20, 1.22, 1.25, 1.27, 1.30, 1.125
+end do
+write(line, fmt(1)) 1.20, 1.22, 1.25, 1.27, 1.30, 1.125
+if (line.ne."       1.3       1.3       1.3       1.3       1.3       1.2") call abort
+write(line, fmt(2)) 1.20, 1.22, 1.25, 1.27, 1.30, 1.125
+if (line.ne."       1.2       1.2       1.2       1.2       1.2       1.1") call abort
+write(line, fmt(3)) 1.20, 1.22, 1.25, 1.27, 1.30, 1.125
+if (line.ne."       1.2       1.2       1.2       1.2       1.2       1.1") call abort
+write(line, fmt(4)) 1.20, 1.22, 1.25, 1.27, 1.30, 1.125
+if (line.ne."      1.20      1.22      1.25      1.27      1.30      1.12") call abort
+write(line, fmt(5)) 1.20, 1.22, 1.25, 1.27, 1.30, 1.125
+if (line.ne."      1.20      1.22      1.25      1.27      1.30      1.13") call abort
+write(line, fmt(6)) 1.20, 1.22, 1.25, 1.27, 1.30, 1.125
+if (line.ne."       1.2       1.2       1.3       1.3       1.3       1.1") call abort
+write(line, fmt(7)) 1.20, 1.22, 1.25, 1.27, 1.30, 1.125
+if (line.ne."      +1.2      +1.2      +1.3      +1.3      +1.3      +1.1") call abort
+
+end
diff --git a/gcc/testsuite/gfortran.dg/round_2.f03 b/gcc/testsuite/gfortran.dg/round_2.f03
new file mode 100644
index 000000000..62190d716
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/round_2.f03
@@ -0,0 +1,24 @@
+! { dg-do run }
+! PR35962 Implement F2003 rounding modes.
+! Test case prepared by Jerry Delisle  <jvdelisle@gcc.gnu.org>
+integer,parameter :: j = max(4, selected_real_kind (precision (0.0_4) + 1))
+integer,parameter :: k = max(4, selected_real_kind (precision (0.0_8) + 1))
+character(64) :: line
+  write(line, '(RN, 4F10.3)') 0.0625_j, 0.1875_j
+  if (line.ne."     0.062     0.188") call abort
+  write(line, '(RN, 4F10.2)') 0.125_j, 0.375_j, 1.125_j, 1.375_j
+  if (line.ne."      0.12      0.38      1.12      1.38") call abort
+  write(line, '(RN, 4F10.1)') 0.25_j, 0.75_j, 1.25_j, 1.75_j
+  if (line.ne."       0.2       0.8       1.2       1.8") call abort
+  write(line, '(RN, 4F10.0)') 0.5_j, 1.5_j, 2.5_j, 3.5_j
+  if (line.ne."        0.        2.        2.        4.") call abort
+
+  write(line, '(RN, 4F10.3)') 0.0625_k, 0.1875_k
+  if (line.ne."     0.062     0.188") call abort
+  write(line, '(RN, 4F10.2)') 0.125_k, 0.375_k, 1.125_k, 1.375_k
+  if (line.ne."      0.12      0.38      1.12      1.38") call abort
+  write(line, '(RN, 4F10.1)') 0.25_k, 0.75_k, 1.25_k, 1.75_k
+  if (line.ne."       0.2       0.8       1.2       1.8") call abort
+  write(line, '(RN, 4F10.0)') 0.5_k, 1.5_k, 2.5_k, 3.5_k
+  if (line.ne."        0.        2.        2.        4.") call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/rrspacing_1.f90 b/gcc/testsuite/gfortran.dg/rrspacing_1.f90
new file mode 100644
index 000000000..8b866aaa2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/rrspacing_1.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+program m
+  integer i
+  real x,y
+  real, parameter :: a = -3.0
+  i = int(rrspacing(a))
+  if (i /= 12582912) call abort
+end program m
diff --git a/gcc/testsuite/gfortran.dg/runtime_warning_1.f90 b/gcc/testsuite/gfortran.dg/runtime_warning_1.f90
new file mode 100644
index 000000000..2894136a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/runtime_warning_1.f90
@@ -0,0 +1,17 @@
+! Test runtime warnings using non-standard $ editing - PR20006.
+!
+! Contributor Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+!
+! { dg-options "-pedantic" }
+! { dg-do run }
+!
+     character(5) c
+     open (42,status='scratch')
+     write (42,'(A,$)') 'abc' ! { dg-warning ".*descriptor" "" }
+     write (42,'(A)') 'de'
+     rewind (42)
+     read (42,'(A)') c
+     close (42)
+     if (c /= 'abcde') call abort ()
+     end
+
diff --git a/gcc/testsuite/gfortran.dg/same_name_1.f90 b/gcc/testsuite/gfortran.dg/same_name_1.f90
new file mode 100644
index 000000000..5cf13a93b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/same_name_1.f90
@@ -0,0 +1,15 @@
+! { dg-do assemble }
+module n
+private u
+contains
+  subroutine u
+  end subroutine u
+end module n
+module m
+  private :: u
+contains
+  subroutine u
+  end subroutine u
+end module m
+
+! { dg-final { cleanup-modules "n m" } }
diff --git a/gcc/testsuite/gfortran.dg/same_name_2.f90 b/gcc/testsuite/gfortran.dg/same_name_2.f90
new file mode 100644
index 000000000..c8da3e1db
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/same_name_2.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! Tests the fix for PR27701, in which two same name procedures
+! were not diagnosed if they had no arguments.
+!
+! Contributed by Arjen Markus  <arjen.markus@wldelft.nl>
+!
+module aha
+contains
+subroutine aa ! { dg-error "Procedure" }
+   write(*,*) 'AA'
+end subroutine aa
+subroutine aa ! { dg-error "is already defined" }
+   write(*,*) 'BB'
+end subroutine aa
+end module
+! { dg-final { cleanup-modules "aha" } }
diff --git a/gcc/testsuite/gfortran.dg/same_type_as_1.f03 b/gcc/testsuite/gfortran.dg/same_type_as_1.f03
new file mode 100644
index 000000000..45b5d2662
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/same_type_as_1.f03
@@ -0,0 +1,27 @@
+! { dg-do compile }
+!
+! Error checking for the intrinsic functions SAME_TYPE_AS and EXTENDS_TYPE_OF.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+ type :: t1
+  integer :: i
+ end type 
+
+ type :: ts
+  sequence
+  integer :: j
+ end type
+
+ TYPE(t1) :: x1
+ TYPE(ts) :: x2
+
+ integer :: i
+
+ print *, SAME_TYPE_AS (i,x1)   ! { dg-error "must be of a derived type" }
+ print *, SAME_TYPE_AS (x1,x2)  ! { dg-error "must be of an extensible type" }
+
+ print *, EXTENDS_TYPE_OF (i,x1)   ! { dg-error "must be of a derived type" }
+ print *, EXTENDS_TYPE_OF (x1,x2)  ! { dg-error "must be of an extensible type" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/same_type_as_2.f03 b/gcc/testsuite/gfortran.dg/same_type_as_2.f03
new file mode 100644
index 000000000..6fd031170
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/same_type_as_2.f03
@@ -0,0 +1,51 @@
+! { dg-do run }
+!
+! Verifying the runtime behavior of the intrinsic function SAME_TYPE_AS.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+ type :: t1
+  integer :: i
+ end type 
+
+ type, extends(t1) :: t2
+  integer :: j
+ end type
+
+ CLASS(t1), pointer :: c1,c2
+ TYPE(t1), target :: x1
+ TYPE(t2) ,target :: x2
+
+ intrinsic :: SAME_TYPE_AS
+ logical :: l
+
+ c1 => NULL()
+
+ l = SAME_TYPE_AS (x1,x1)
+ print *,l
+ if (.not.l) call abort()
+ l = SAME_TYPE_AS (x1,x2)
+ print *,l
+ if (l) call abort()
+
+ c1 => x1
+ l = SAME_TYPE_AS (c1,x1)
+ print *,l
+ if (.not.l) call abort()
+ l = SAME_TYPE_AS (c1,x2)
+ print *,l
+ if (l) call abort()
+
+ c1 => x2
+ c2 => x2
+ l = SAME_TYPE_AS (c1,c2)
+ print *,l
+ if (.not.l) call abort()
+
+ c1 => x1
+ c2 => x2
+ l = SAME_TYPE_AS (c1,c2)
+ print *,l
+ if (l) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/save_1.f90 b/gcc/testsuite/gfortran.dg/save_1.f90
new file mode 100644
index 000000000..614986277
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/save_1.f90
@@ -0,0 +1,30 @@
+! { dg-options "-O2 -fno-automatic" }
+      subroutine foo (b)
+	logical b
+	integer i, j
+	character*24 s
+	save i
+	if (b) then
+	  i = 26
+	  j = 131
+	  s = 'This is a test string'
+	else
+	  if (i .ne. 26 .or. j .ne. 131) call abort
+	  if (s .ne. 'This is a test string') call abort
+	end if
+      end subroutine foo
+      subroutine bar (s)
+	character*42 s
+	if (s .ne. '0123456789012345678901234567890123456') call abort
+	call foo (.false.)
+      end subroutine bar
+      subroutine baz
+	character*42 s
+	! Just clobber stack a little bit.
+	s = '0123456789012345678901234567890123456'
+	call bar (s)
+      end subroutine baz
+      call foo (.true.)
+      call baz
+      call foo (.false.)
+      end
diff --git a/gcc/testsuite/gfortran.dg/save_2.f90 b/gcc/testsuite/gfortran.dg/save_2.f90
new file mode 100644
index 000000000..87ef8ab25
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/save_2.f90
@@ -0,0 +1,22 @@
+! PR fortran/28415
+! { dg-do run }
+! { dg-options "-O2 -fno-automatic" }
+
+      program foo
+      integer arrlen
+      arrlen = 30
+      call bar(arrlen)
+      stop
+      end
+
+      subroutine bar(arg)
+      integer arg
+      double precision arr(arg)
+      do i = 1, arg
+         arr(i) = 1.0d0
+      enddo
+      do i = 1, arg
+         write(*,*) i, arr(i)
+      enddo
+      return
+      end
diff --git a/gcc/testsuite/gfortran.dg/save_3.f90 b/gcc/testsuite/gfortran.dg/save_3.f90
new file mode 100644
index 000000000..ab2ee5268
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/save_3.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+
+! PR fortran/35837
+! We used do have a problem with resolving "save all" and nested namespaces.
+
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+module g95bug
+save
+integer :: i=20
+contains
+pure function tell_i() result (answer)
+  integer :: answer
+  answer=i
+end function tell_i
+end module g95bug
+
+! { dg-final { cleanup-modules "g95bug" } }
diff --git a/gcc/testsuite/gfortran.dg/save_4.f90 b/gcc/testsuite/gfortran.dg/save_4.f90
new file mode 100644
index 000000000..74ea6e835
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/save_4.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/53597
+!
+MODULE somemodule
+  IMPLICIT NONE
+  TYPE sometype
+    INTEGER :: i
+    DOUBLE PRECISION, POINTER, DIMENSION(:,:) :: coef => NULL()
+  END TYPE sometype
+  TYPE(sometype) :: somevariable ! { dg-error "Fortran 2008: Implied SAVE for module variable 'somevariable' at .1., needed due to the default initialization" }
+END MODULE somemodule
diff --git a/gcc/testsuite/gfortran.dg/save_common.f90 b/gcc/testsuite/gfortran.dg/save_common.f90
new file mode 100644
index 000000000..c9878026c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/save_common.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! PR20847 - A common variable may not have the SAVE attribute.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+INTEGER, SAVE :: X
+COMMON /COM/ X ! { dg-error "conflicts with SAVE attribute" }
+END
diff --git a/gcc/testsuite/gfortran.dg/save_parameter.f90 b/gcc/testsuite/gfortran.dg/save_parameter.f90
new file mode 100644
index 000000000..dd879bb86
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/save_parameter.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! PR fortran/32633 - implied SAVE conflicts with parameter attribute
+! Testcase contributed by: Joost VandeVondele <jv244@cam.ac.uk>
+
+MODULE test
+  CHARACTER(len=1), PARAMETER :: backslash = '\\'
+  PUBLIC :: backslash
+END MODULE
+
+! { dg-final { cleanup-modules "test" } }
diff --git a/gcc/testsuite/gfortran.dg/save_result.f90 b/gcc/testsuite/gfortran.dg/save_result.f90
new file mode 100644
index 000000000..de70cc38f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/save_result.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! PR20856 - A function result may not have SAVE attribute.
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+FUNCTION X() RESULT(Y)
+REAL, SAVE :: Y ! { dg-error "RESULT attribute conflicts with SAVE" }
+y = 1
+END FUNCTION X
+END
diff --git a/gcc/testsuite/gfortran.dg/saved_automatic_1.f90 b/gcc/testsuite/gfortran.dg/saved_automatic_1.f90
new file mode 100644
index 000000000..53e7dce83
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/saved_automatic_1.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! Tests patch for PR23091, in which autmatic objects caused
+! an ICE if they were given the SAVE attribute.
+!
+! Contributed by Valera Veryazov  <valera.veryazov@teokem.lu.se>
+!
+Subroutine My(n1)
+  integer :: myArray(n1)
+  character(n1) :: ch
+  save      ! OK because only allowed objects are saved globally.
+  call xxx(myArray, ch)
+  return
+  end
+
+Subroutine Thy(n1)
+  integer, save :: myArray(n1) ! { dg-error "SAVE attribute" }
+  character(n1), save :: ch ! { dg-error "SAVE attribute" }
+  call xxx(myArray, ch)
+  return
+  end
+
diff --git a/gcc/testsuite/gfortran.dg/scalar_mask_1.f90 b/gcc/testsuite/gfortran.dg/scalar_mask_1.f90
new file mode 100644
index 000000000..e2e5d6c42
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/scalar_mask_1.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+program main
+  implicit none
+  real, dimension(2) :: a
+  a(1) = 2.0
+  a(2) = 3.0
+  if (product (a, .false.) /= 1.0) call abort
+  if (product (a, .true.) /= 6.0) call abort
+  if (sum (a, .false.) /= 0.0) call abort
+  if (sum (a, .true.) /= 5.0) call abort
+  if (maxval (a, .true.) /= 3.0) call abort
+  if (maxval (a, .false.) > -1e38) call abort
+  if (maxloc (a, 1, .true.) /= 2) call abort
+  if (maxloc (a, 1, .false.) /= 0) call abort ! Change to F2003 requirement.
+end program main
diff --git a/gcc/testsuite/gfortran.dg/scalar_mask_2.f90 b/gcc/testsuite/gfortran.dg/scalar_mask_2.f90
new file mode 100644
index 000000000..967ac5c22
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/scalar_mask_2.f90
@@ -0,0 +1,33 @@
+! { dg-do run { xfail spu-*-* } }
+! FAILs on SPU because of rounding error reading kinds.h
+program main
+  ! Test scalar masks for different intrinsics.
+  real, dimension(2,2) :: a
+  logical(kind=2) :: lo
+  lo = .false.
+  a(1,1) = 1.
+  a(1,2) = -1.
+  a(2,1) = 13.
+  a(2,2) = -31.
+  if (any (minloc (a, lo) /= 0)) call abort
+  if (any (minloc (a, .true.) /= (/ 2, 2 /))) call abort
+  if (any (minloc(a, 1, .true.) /= (/ 1, 2/))) call abort
+  if (any (minloc(a, 1, lo ) /= (/ 0, 0/))) call abort
+
+  if (any (maxloc (a, lo) /= 0)) call abort
+  if (any (maxloc (a, .true.) /= (/ 2,1 /))) call abort
+  if (any (maxloc(a, 1, .true.) /= (/ 2, 1/))) call abort
+  if (any (maxloc(a, 1, lo) /= (/ 0, 0/))) call abort
+
+  if (any (maxval(a, 1, lo) /= -HUGE(a))) call abort
+  if (any (maxval(a, 1, .true.) /= (/13., -1./))) call abort
+  if (any (minval(a, 1, lo) /= HUGE(a))) call abort
+  if (any (minval(a, 1, .true.) /= (/1., -31./))) call abort
+
+  if (any (product(a, 1, .true.) /= (/13., 31./))) call abort
+  if (any (product(a, 1, lo ) /= (/1., 1./))) call abort
+
+  if (any (sum(a, 1, .true.) /= (/14., -32./))) call abort
+  if (any (sum(a, 1, lo) /= (/0., 0./))) call abort
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/scalar_return_1.f90 b/gcc/testsuite/gfortran.dg/scalar_return_1.f90
new file mode 100644
index 000000000..df206458e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/scalar_return_1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! tests the fix for pr25082 in which the return of an array by a
+! subroutine went undremarked.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+SUBROUTINE S1(*)
+INTEGER :: a(2)
+RETURN a ! { dg-error " requires a SCALAR" }
+END SUBROUTINE S1
diff --git a/gcc/testsuite/gfortran.dg/scalarize_parameter_array_1.f90 b/gcc/testsuite/gfortran.dg/scalarize_parameter_array_1.f90
new file mode 100644
index 000000000..86bc92df4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/scalarize_parameter_array_1.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! Tests the fix for pr32682, in which the scalarization loop variables
+! were not being determined when 'c' came first in an expression.
+!
+! Contributed by Janus Weil <jaydub66@gmail.com>
+!
+program matrix
+
+  implicit none
+  real,dimension(2,2),parameter::c=reshape((/1,2,3,4/),(/2,2/))
+  real,dimension(2,2)::m, n
+
+  m=f()+c
+  if (any (m .ne. reshape((/2,3,4,5/),(/2,2/)))) call abort ()
+  m=c+f()
+  if (any (m .ne. reshape((/2,3,4,5/),(/2,2/)))) call abort ()
+  call sub(m+f())
+  if (any (n .ne. reshape((/3,4,5,6/),(/2,2/)))) call abort ()
+  call sub(c+m)
+  if (any (n .ne. reshape((/3,5,7,9/),(/2,2/)))) call abort ()
+  call sub(f()+c)
+  if (any (n .ne. reshape((/2,3,4,5/),(/2,2/)))) call abort ()
+  call sub(c+f())
+  if (any (n .ne. reshape((/2,3,4,5/),(/2,2/)))) call abort ()
+
+contains
+
+  function f()    
+    implicit none
+    real, dimension(2,2)::f
+    f=1
+  end function f
+
+  subroutine sub(a)
+    implicit none
+    real, dimension(2,2)::a
+    n = a
+  end subroutine sub
+
+end program matrix
diff --git a/gcc/testsuite/gfortran.dg/scale_1.f90 b/gcc/testsuite/gfortran.dg/scale_1.f90
new file mode 100644
index 000000000..72a9fd8d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/scale_1.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+! inspired by PR17175
+REAL X
+DOUBLE PRECISION Y
+
+INTEGER, PARAMETER :: DP = KIND(Y)
+
+INTEGER(kind=1) I1
+INTEGER(kind=2) I2
+INTEGER(kind=4) I4
+INTEGER(kind=8) I8
+
+X = 1.
+Y = 1._DP
+
+I1 = 10
+I2 = -10
+I4 = 20
+I8 = -20
+
+X = SCALE (X, I1)
+X = SCALE (X, I2)
+IF (X.NE.1.) CALL ABORT()
+X = SCALE (X, I4)
+X = SCALE (X, I8)
+IF (X.NE.1.) CALL ABORT()
+
+Y = SCALE (Y, I1)
+Y = SCALE (Y, I2)
+IF (Y.NE.1._DP) CALL ABORT()
+Y = SCALE (Y, I4)
+Y = SCALE (Y, I8)
+IF (Y.NE.1._DP) CALL ABORT()
+
+END
diff --git a/gcc/testsuite/gfortran.dg/scan_1.f90 b/gcc/testsuite/gfortran.dg/scan_1.f90
new file mode 100644
index 000000000..ceaa9eb62
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/scan_1.f90
@@ -0,0 +1,31 @@
+program b
+   integer w
+   character(len=2) s, t
+   s = 'xi'
+
+   w = scan(s, 'iI')
+   if (w /= 2) call abort
+   w = scan(s, 'xX', .true.)
+   if (w /= 1) call abort
+   w = scan(s, 'ab')
+   if (w /= 0) call abort
+   w = scan(s, 'ab', .true.)
+   if (w /= 0) call abort
+
+   s = 'xi'
+   t = 'iI'
+   w = scan(s, t)
+   if (w /= 2) call abort
+   t = 'xX'
+   w = scan(s, t, .true.)
+   if (w /= 1) call abort
+   t = 'ab'
+   w = scan(s, t)
+   if (w /= 0) call abort
+   w = scan(s, t, .true.)
+   if (w /= 0) call abort
+
+end program b
+   
+
+   
diff --git a/gcc/testsuite/gfortran.dg/secnds-1.f b/gcc/testsuite/gfortran.dg/secnds-1.f
new file mode 100644
index 000000000..c5f528357
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/secnds-1.f
@@ -0,0 +1,30 @@
+C { dg-do run }
+C { dg-options "-ffloat-store" }
+C Tests fix for PR29099 - SECNDS intrinsic wrong result with no delay.
+C
+C Contributed by Paul Thomas  <pault@gcc.gnu.org>
+C
+      character*20 dum1, dum2, dum3
+      real t1, t1a, t2, t2a
+      real*4 dat1, dat2
+      integer i, j, values(8), k
+      t1 = secnds (0.0)
+      call date_and_time (dum1, dum2, dum3, values)
+      t1a = secnds (0.0)
+      dat1 = 0.001 * real(values(8)) + real(values(7)) +
+     &        60.0 * real(values(6)) + 3600.0 * real(values(5))
+      ! handle midnight shift
+      if ((t1a - t1) < -12.0*3600.0 ) t1 = t1 - 24.0*3600.0
+      if ((t1a - dat1) < -12.0*3600.0 ) dat1 = dat1 - 24.0*3600.0
+      if ((dat1 < nearest(t1, -1.)) .or. (dat1  > nearest(t1a, 1.)))
+     &    call abort ()
+      t2a = secnds (t1a)
+      call date_and_time (dum1, dum2, dum3, values)
+      t2 = secnds (t1)
+      dat2 = 0.001 * real(values(8)) + real(values(7)) +
+     &        60.0 * real(values(6)) + 3600.0 * real(values(5))
+      ! handle midnight shift
+      if ((dat2 - dat1) < -12.0*3600.0 ) dat1 = dat1 - 24.0*3600.0
+      if (((dat2 - dat1) < t2a - 0.008) .or.
+     &    ((dat2 - dat1) > t2 + 0.008)) call abort ()
+      end
diff --git a/gcc/testsuite/gfortran.dg/secnds.f b/gcc/testsuite/gfortran.dg/secnds.f
new file mode 100644
index 000000000..3131598a2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/secnds.f
@@ -0,0 +1,34 @@
+C { dg-do run }
+C { dg-options "-O0 -ffloat-store" }
+C Tests fix for PR14994 - SECNDS intrinsic not supported.
+C
+C Contributed by Paul Thomas  <pault@gcc.gnu.org>
+C
+      character*20 dum1, dum2, dum3
+      real t1, t1a, t2, t2a
+      real*4 dat1, dat2
+      integer i, j, values(8), k
+      t1 = secnds (0.0)
+      call date_and_time (dum1, dum2, dum3, values)
+      t1a = secnds (0.0)
+      dat1 = 0.001 * real(values(8)) + real(values(7)) +
+     &        60.0 * real(values(6)) + 3600.0 * real(values(5))
+      ! handle midnight shift
+      if ((t1a - t1) < -12.0*3600.0 ) t1 = t1 - 24.0*3600.0
+      if ((t1a - dat1) < -12.0*3600.0 ) dat1 = dat1 - 24.0*3600.0
+      if ((dat1 < nearest(t1, -1.)) .or. (dat1  > nearest(t1a, 1.)))
+     &    call abort ()
+      do j=1,10000
+        do i=1,10000
+        end do
+      end do
+      t2a = secnds (t1a)
+      call date_and_time (dum1, dum2, dum3, values)
+      t2 = secnds (t1)
+      dat2 = 0.001 * real(values(8)) + real(values(7)) +
+     &        60.0 * real(values(6)) + 3600.0 * real(values(5))
+      ! handle midnight shift
+      if ((dat2 - dat1) < -12.0*3600.0 ) dat1 = dat1 - 24.0*3600.0
+      if (((dat2 - dat1) < t2a - 0.008) .or.
+     &    ((dat2 - dat1) > t2 + 0.008)) call abort ()
+      end
diff --git a/gcc/testsuite/gfortran.dg/select_1.f90 b/gcc/testsuite/gfortran.dg/select_1.f90
new file mode 100644
index 000000000..4d9d597f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+!  Simple test for SELECT CASE
+!
+program select_2
+  integer i
+  do i = 1, 5
+     select case(i)
+     case (1)
+       if (i /= 1) call abort
+     case (2:3)
+       if (i /= 2 .and. i /= 3) call abort
+     case (4)
+       if (i /= 4) call abort
+     case default
+       if (i /= 5) call abort
+     end select
+  end do
+end program select_2
diff --git a/gcc/testsuite/gfortran.dg/select_2.f90 b/gcc/testsuite/gfortran.dg/select_2.f90
new file mode 100644
index 000000000..6ece65840
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_2.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+!  Simple test program to see if gfortran eliminates the 'case (3:2)'
+!  statement.  This is an unreachable CASE because the range is empty.
+!
+program select_3
+  integer i
+  do i = 1, 4
+     select case(i)
+     case (1)
+       if (i /= 1) call abort
+     case (3:2)
+       call abort
+     case (4)
+       if (i /= 4) call abort
+     case default
+       if (i /= 2 .and. i /= 3) call abort
+     end select
+  end do
+end program select_3
diff --git a/gcc/testsuite/gfortran.dg/select_3.f90 b/gcc/testsuite/gfortran.dg/select_3.f90
new file mode 100644
index 000000000..d1f2d6904
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_3.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+!  Short test program with a CASE statement that uses a range.
+!
+program select_4
+  integer i
+  do i = 1, 34, 4
+     select case(i)
+     case (:5)
+       if (i /= 1 .and. i /= 5) call abort
+     case (13:21)
+       if (i /= 13 .and. i /= 17 .and. i /= 21) call abort
+     case (29:)
+       if (i /= 29 .and. i /= 33) call abort
+     case default
+       if (i /= 9 .and. i /= 25) call abort
+     end select
+  end do
+end program select_4
diff --git a/gcc/testsuite/gfortran.dg/select_4.f90 b/gcc/testsuite/gfortran.dg/select_4.f90
new file mode 100644
index 000000000..dbced6e4c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_4.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! Check for overlapping case range diagnostics.
+!
+program select_5
+  integer i
+  select case(i)
+  case (20:30) ! { dg-error "overlaps with CASE" }
+  case (25:) ! { dg-error "overlaps with CASE" }
+  end select
+  select case(i)
+  case (30)  ! { dg-error "overlaps with CASE" }
+  case (25:) ! { dg-error "overlaps with CASE" }
+  end select
+  select case(i)
+  case (20:30) ! { dg-error "overlaps with CASE" }
+  case (25) ! { dg-error "overlaps with CASE" }
+  end select
+end program select_5
diff --git a/gcc/testsuite/gfortran.dg/select_5.f90 b/gcc/testsuite/gfortran.dg/select_5.f90
new file mode 100644
index 000000000..9afc1603b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_5.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! Test mismatched type kinds in a select statement.
+program select_5
+  integer(kind=1) i          ! kind = 1, -128 <= i < 127
+  do i = 1, 3
+    select case (i)
+
+    ! kind = 4, reachable
+    case (1_4)
+      if (i /=  1_4) call abort
+
+    ! kind = 8, reachable
+    case (2_8)
+      if (i /= 2_8) call abort
+
+    ! kind = 4, unreachable because of range of i
+    case (200)                       ! { dg-warning "not in the range" }
+      call abort
+
+    case default
+      if (i /= 3) call abort
+    end select
+  end do
+end program select_5
diff --git a/gcc/testsuite/gfortran.dg/select_6.f90 b/gcc/testsuite/gfortran.dg/select_6.f90
new file mode 100644
index 000000000..0e0f05244
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_6.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! PR fortran/27457
+! This lead to a segfault previously.
+        implicit none
+        integer(kind=1) :: i
+        real :: r(3)
+        select case (i)
+        case (129) r(4) = 0  ! { dg-error "Syntax error in CASE specification" }
+        end select
+        end
diff --git a/gcc/testsuite/gfortran.dg/select_7.f90 b/gcc/testsuite/gfortran.dg/select_7.f90
new file mode 100644
index 000000000..15b0750c4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_7.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! Tests the fix for PR25073 in which overlap in logical case
+! expressions was permitted.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+LOGICAL :: L
+SELECT CASE(L)
+CASE(.true.)
+CASE(.false.)
+CASE(.true.) ! { dg-error "value in CASE statement is repeated" }
+END SELECT
+END
diff --git a/gcc/testsuite/gfortran.dg/select_char_1.f90 b/gcc/testsuite/gfortran.dg/select_char_1.f90
new file mode 100644
index 000000000..83c526830
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_char_1.f90
@@ -0,0 +1,76 @@
+integer function char_select (s)
+  character(len=*), intent(in) :: s
+
+  select case(s)
+    case ("foo")
+      char_select = 1
+    case ("bar", "gee")
+      char_select = 2
+    case ("111", "999")
+      char_select = 3
+    case ("1024", "1900")
+      char_select = 4
+    case ("12", "17890")
+      char_select = 5
+    case default
+      char_select = -1
+  end select
+end function char_select
+
+integer function char_select2 (s)
+  character(len=*), intent(in) :: s
+
+  char_select2 = -1
+  select case(s)
+    case ("foo")
+      char_select2 = 1
+    case ("bar", "gee")
+      char_select2 = 2
+    case ("111", "999")
+      char_select2 = 3
+    case ("1024", "1900")
+      char_select2 = 4
+    case ("12", "17890")
+      char_select2 = 5
+  end select
+end function char_select2
+
+
+program test
+  interface
+    integer function char_select (s)
+      character(len=*), intent(in) :: s
+    end function char_select
+    integer function char_select2 (s)
+      character(len=*), intent(in) :: s
+    end function char_select2
+  end interface
+
+  if (char_select("foo") /= 1) call abort
+  if (char_select("foo ") /= 1) call abort
+  if (char_select("foo2 ") /= -1) call abort
+  if (char_select("bar") /= 2) call abort
+  if (char_select("gee") /= 2) call abort
+  if (char_select("000") /= -1) call abort
+  if (char_select("101") /= -1) call abort
+  if (char_select("109") /= -1) call abort
+  if (char_select("111") /= 3) call abort
+  if (char_select("254") /= -1) call abort
+  if (char_select("999") /= 3) call abort
+  if (char_select("9989") /= -1) call abort
+  if (char_select("1882") /= -1) call abort
+
+  if (char_select2("foo") /= 1) call abort
+  if (char_select2("foo ") /= 1) call abort
+  if (char_select2("foo2 ") /= -1) call abort
+  if (char_select2("bar") /= 2) call abort
+  if (char_select2("gee") /= 2) call abort
+  if (char_select2("000") /= -1) call abort
+  if (char_select2("101") /= -1) call abort
+  if (char_select2("109") /= -1) call abort
+  if (char_select2("111") /= 3) call abort
+  if (char_select2("254") /= -1) call abort
+  if (char_select2("999") /= 3) call abort
+  if (char_select2("9989") /= -1) call abort
+  if (char_select2("1882") /= -1) call abort
+end program test
diff --git a/gcc/testsuite/gfortran.dg/select_char_2.f90 b/gcc/testsuite/gfortran.dg/select_char_2.f90
new file mode 100644
index 000000000..22af1c76d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_char_2.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+! { dg-options "-O -fdump-tree-original" }
+
+  if (foo ('E') .ne. 1) call abort
+  if (foo ('e') .ne. 1) call abort
+  if (foo ('f') .ne. 2) call abort
+  if (foo ('g') .ne. 2) call abort
+  if (foo ('h') .ne. 2) call abort
+  if (foo ('Q') .ne. 3) call abort
+  if (foo (' ') .ne. 4) call abort
+  if (bar ('e') .ne. 1) call abort
+  if (bar ('f') .ne. 3) call abort
+contains
+  function foo (c)
+    character :: c
+    integer :: foo
+    select case (c)
+      case ('E','e')
+        foo = 1
+      case ('f':'h  ')
+        foo = 2
+      case default
+        foo = 3
+      case ('')
+        foo = 4
+    end select
+  end function
+  function bar (c)
+    character :: c
+    integer :: bar
+    select case (c)
+      case ('ea':'ez')
+        bar = 2
+      case ('e')
+        bar = 1
+      case default
+        bar = 3
+      case ('fd')
+        bar = 4
+    end select
+  end function
+end
+
+! { dg-final { scan-tree-dump-not "_gfortran_select_string" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/select_char_3.f90 b/gcc/testsuite/gfortran.dg/select_char_3.f90
new file mode 100644
index 000000000..f0a7c8741
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_char_3.f90
@@ -0,0 +1,15 @@
+! PR fortran/40206
+! { dg-do compile }
+! { dg-options "-O2 -Wuninitialized" }
+
+function char2type (char)
+  character, intent(in) :: char
+  integer :: char2type
+
+  select case (char)
+    case ('E','e')
+      char2type=1
+    case default
+      char2type=-1234
+  end select
+end function
diff --git a/gcc/testsuite/gfortran.dg/select_type_1.f03 b/gcc/testsuite/gfortran.dg/select_type_1.f03
new file mode 100644
index 000000000..af0db3c84
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_1.f03
@@ -0,0 +1,71 @@
+! { dg-do compile }
+!
+! Error checking for the SELECT TYPE statement
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+  type :: t1
+    integer :: i = 42
+    class(t1),pointer :: cp
+  end type
+
+  type, extends(t1) :: t2
+    integer :: j = 99
+  end type
+
+  type :: t3
+    real :: r
+  end type
+
+  type :: ts
+    sequence
+    integer :: k = 5
+  end type
+
+  class(t1), pointer :: a => NULL()
+  type(t1), target :: b
+  type(t2), target :: c
+  a => b
+  print *, a%i
+
+  type is (t1)  ! { dg-error "Unexpected TYPE IS statement" }
+
+  select type (3.5)  ! { dg-error "is not a named variable" }
+  select type (a%cp) ! { dg-error "is not a named variable" }
+  select type (b)    ! { dg-error "Selector shall be polymorphic" }
+  end select
+
+  select type (a)
+    print *,"hello world!"  ! { dg-error "Expected TYPE IS, CLASS IS or END SELECT" }
+  type is (t1)
+    print *,"a is TYPE(t1)"
+  type is (t2)
+    print *,"a is TYPE(t2)"
+  class is (ts)  ! { dg-error "must be extensible" }
+    print *,"a is TYPE(ts)"
+  type is (t3)   ! { dg-error "must be an extension of" }
+    print *,"a is TYPE(t3)"
+  type is (t4)   ! { dg-error "error in TYPE IS specification" }
+    print *,"a is TYPE(t3)"
+  class is (t1)
+    print *,"a is CLASS(t1)"
+  class is (t2) label  ! { dg-error "Syntax error" }
+    print *,"a is CLASS(t2)"
+  class default  ! { dg-error "cannot be followed by a second DEFAULT CASE" }
+    print *,"default"
+  class default  ! { dg-error "cannot be followed by a second DEFAULT CASE" }
+    print *,"default2"
+  end select
+
+label: select type (a)
+  type is (t1) label
+    print *,"a is TYPE(t1)"
+  type is (t2)  ! { dg-error "overlaps with CASE label" }
+    print *,"a is TYPE(t2)"
+  type is (t2)  ! { dg-error "overlaps with CASE label" }
+    print *,"a is still TYPE(t2)"
+  class is (t1) labe   ! { dg-error "Expected block name" }
+    print *,"a is CLASS(t1)"
+  end select label
+
+end
diff --git a/gcc/testsuite/gfortran.dg/select_type_10.f03 b/gcc/testsuite/gfortran.dg/select_type_10.f03
new file mode 100644
index 000000000..217d72a83
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_10.f03
@@ -0,0 +1,34 @@
+! { dg-do compile }
+!
+! PR 42167: [OOP] SELECT TYPE with function return value
+!
+! Contributed by Damian Rouson <damian@rouson.net>
+
+module bar_module
+
+  implicit none
+  type :: bar
+    real ,dimension(:) ,allocatable :: f
+  contains
+    procedure :: total
+  end type
+
+contains
+
+  function total(lhs,rhs)
+    class(bar) ,intent(in) :: lhs
+    class(bar) ,intent(in) :: rhs
+    class(bar) ,pointer :: total
+    select type(rhs)
+      type is (bar)
+        allocate(bar :: total)
+        select type(total)
+          type is (bar)
+            total%f = lhs%f + rhs%f
+        end select
+    end select
+  end function
+
+end module 
+
+! { dg-final { cleanup-modules "bar_module" } }
diff --git a/gcc/testsuite/gfortran.dg/select_type_11.f03 b/gcc/testsuite/gfortran.dg/select_type_11.f03
new file mode 100644
index 000000000..c3bd9bac8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_11.f03
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR 42335: [OOP] ICE on CLASS IS (bad_identifier)
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+
+  implicit none
+  type, abstract :: vector_class
+  end type vector_class
+
+  type, extends(vector_class) :: trivial_vector_type
+    real :: elements(100)
+  end type trivial_vector_type
+
+contains
+
+  subroutine bar (this,v)
+    class(trivial_vector_type), intent(inout) :: this
+    class(vector_class),        intent(in)    :: v
+
+    select type (v)
+    class is (bad_id)                    ! { dg-error " error in CLASS IS specification" }
+       this%elements(:) = v%elements(:)  ! { dg-error "is not a member of" }
+    end select
+
+  end subroutine bar
+
+end
diff --git a/gcc/testsuite/gfortran.dg/select_type_12.f03 b/gcc/testsuite/gfortran.dg/select_type_12.f03
new file mode 100644
index 000000000..eb942d1e1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_12.f03
@@ -0,0 +1,51 @@
+! { dg-do compile }
+!
+! PR 44044: [OOP] SELECT TYPE with class-valued function
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+implicit none
+
+type :: t1
+  integer :: i
+end type
+
+type, extends(t1) :: t2
+end type
+
+type(t1),target :: x1
+type(t2),target :: x2
+
+select type ( y => fun(1) )
+type is (t1)
+  print *,"t1"
+type is (t2)
+  print *,"t2"
+class default
+  print *,"default"
+end select
+
+select type ( y => fun(-1) )
+type is (t1)
+  print *,"t1"
+type is (t2)
+  print *,"t2"
+class default
+  print *,"default"
+end select
+
+contains
+
+  function fun(i)
+    class(t1),pointer :: fun
+    integer :: i
+    if (i>0) then
+      fun => x1
+    else if (i<0) then
+      fun => x2
+    else
+      fun => NULL()
+    end if
+  end function
+
+end
diff --git a/gcc/testsuite/gfortran.dg/select_type_13.f03 b/gcc/testsuite/gfortran.dg/select_type_13.f03
new file mode 100644
index 000000000..8546ccbe8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_13.f03
@@ -0,0 +1,26 @@
+! { dg-do run }
+
+! PR fortran/45384
+! Double free happened, check that it works now.
+
+! Contributed by Salvatore Filippone  <salvatore.filippone@uniroma2.it>
+
+program bug20
+
+  type :: d_base_sparse_mat
+    integer :: v(10) = 0.
+  end type d_base_sparse_mat
+
+  class(d_base_sparse_mat),allocatable :: a
+
+  allocate (d_base_sparse_mat :: a)
+
+  select type(aa => a)
+  type is (d_base_sparse_mat)
+    write(0,*) 'NV = ',size(aa%v)
+    if (size(aa%v) /= 10) call abort ()
+  class default 
+    write(0,*) 'Not implemented yet '
+  end select
+
+end program bug20
diff --git a/gcc/testsuite/gfortran.dg/select_type_14.f03 b/gcc/testsuite/gfortran.dg/select_type_14.f03
new file mode 100644
index 000000000..2d37bbc7f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_14.f03
@@ -0,0 +1,24 @@
+! { dg-do run }
+
+! PR fortran/44047
+! Double free happened, check that it works now.
+
+! Contributed by Janus Weil, janus@gcc.gnu.org.
+
+implicit none
+type t0
+ integer :: j = 42
+end type t0
+type t
+ integer :: i
+ class(t0), allocatable :: foo
+end type t
+type(t) :: m
+allocate(t0 :: m%foo)
+m%i = 5
+select type(bar => m%foo)
+type is(t0)
+ print *, bar
+ if (bar%j /= 42) call abort ()
+end select
+end
diff --git a/gcc/testsuite/gfortran.dg/select_type_15.f03 b/gcc/testsuite/gfortran.dg/select_type_15.f03
new file mode 100644
index 000000000..6be045c09
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_15.f03
@@ -0,0 +1,77 @@
+! { dg-do run }
+!
+! PR 45420: [OOP] polymorphic TBP call in a CLASS DEFAULT clause
+!
+! Contributed by Salvatore Filippone <salvatore.filippone@uniroma2.it>
+
+
+module base_mat_mod
+
+ type  :: base_sparse_mat
+ contains
+   procedure, pass(a) :: get_fmt => base_get_fmt
+ end type base_sparse_mat
+
+contains
+
+ function base_get_fmt(a) result(res)
+   implicit none
+   class(base_sparse_mat), intent(in) :: a
+   character(len=5) :: res
+   res = 'NULL'
+ end function base_get_fmt
+
+end module base_mat_mod
+
+
+module d_base_mat_mod
+
+ use base_mat_mod
+
+ type, extends(base_sparse_mat) :: d_base_sparse_mat
+ contains
+   procedure, pass(a) :: get_fmt => d_base_get_fmt
+ end type d_base_sparse_mat
+
+ type, extends(d_base_sparse_mat) :: x_base_sparse_mat
+ contains
+   procedure, pass(a) :: get_fmt => x_base_get_fmt
+ end type x_base_sparse_mat
+
+contains
+
+ function d_base_get_fmt(a) result(res)
+   implicit none
+   class(d_base_sparse_mat), intent(in) :: a
+   character(len=5) :: res
+   res = 'DBASE'
+ end function d_base_get_fmt
+
+ function x_base_get_fmt(a) result(res)
+   implicit none
+   class(x_base_sparse_mat), intent(in) :: a
+   character(len=5) :: res
+   res = 'XBASE'
+ end function x_base_get_fmt
+
+end module d_base_mat_mod
+
+
+program bug20
+  use d_base_mat_mod
+  class(d_base_sparse_mat), allocatable  :: a
+
+  allocate(x_base_sparse_mat :: a)
+  if (a%get_fmt()/="XBASE") call abort()
+
+  select type(a)
+  type is (d_base_sparse_mat)
+    call abort()
+  class default
+    if (a%get_fmt()/="XBASE") call abort()
+  end select
+
+end program bug20
+
+
+! { dg-final { cleanup-modules "base_mat_mod d_base_mat_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/select_type_16.f03 b/gcc/testsuite/gfortran.dg/select_type_16.f03
new file mode 100644
index 000000000..29d19300a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_16.f03
@@ -0,0 +1,41 @@
+! { dg-do compile }
+!
+! PR 45439: [OOP] SELECT TYPE bogus complaint about INTENT
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+
+module d_base_mat_mod
+
+  implicit none
+
+  type :: d_base_sparse_mat
+  contains
+    procedure, pass(a) :: mv_to_coo   => d_base_mv_to_coo   
+  end type d_base_sparse_mat
+
+  interface 
+    subroutine d_base_mv_to_coo(a)
+      import d_base_sparse_mat
+      class(d_base_sparse_mat), intent(inout) :: a
+    end subroutine d_base_mv_to_coo
+  end interface
+
+  type :: d_sparse_mat
+    class(d_base_sparse_mat), allocatable  :: a 
+  end type d_sparse_mat
+
+contains
+
+  subroutine bug21(ax)
+    type(d_sparse_mat), intent(inout) :: ax
+    select type(aa=> ax%a)
+    class default
+      call aa%mv_to_coo() 
+    end select
+  end subroutine bug21
+
+end module d_base_mat_mod
+
+
+! { dg-final { cleanup-modules "d_base_mat_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/select_type_17.f03 b/gcc/testsuite/gfortran.dg/select_type_17.f03
new file mode 100644
index 000000000..af2a489d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_17.f03
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! PR fortran/44044
+! Definability check for select type to expression.
+! This is "bonus feature #2" from comment #3 of the PR.
+
+! Contributed by Janus Weil, janus@gcc.gnu.org.
+
+implicit none
+
+type :: t1
+  integer :: i
+end type
+
+type, extends(t1) :: t2
+end type
+
+type(t1),target :: x1
+type(t2),target :: x2
+
+select type ( y => fun(1) )
+type is (t1)
+  y%i = 1 ! { dg-error "variable definition context" }
+type is (t2)
+  y%i = 2 ! { dg-error "variable definition context" }
+end select
+
+contains
+
+  function fun(i)
+    class(t1),pointer :: fun
+    integer :: i
+    if (i>0) then
+      fun => x1
+    else if (i<0) then
+      fun => x2
+    else
+      fun => NULL()
+    end if
+  end function
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/select_type_18.f03 b/gcc/testsuite/gfortran.dg/select_type_18.f03
new file mode 100644
index 000000000..e4bacd377
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_18.f03
@@ -0,0 +1,90 @@
+! { dg-do compile }
+
+! PR fortran/45783
+! PR fortran/45795
+! This used to fail because of incorrect compile-time typespec on the
+! SELECT TYPE selector.
+
+! This is the test-case from PR 45795.
+! Contributed by Salvatore Filippone, sfilippone@uniroma2.it.
+
+module base_mod
+  
+  type  :: base
+    integer     :: m, n
+  end type base
+
+end module base_mod
+
+module s_base_mod
+  
+  use base_mod
+
+  type, extends(base) :: s_base
+  contains
+    procedure, pass(a) :: cp_to_foo   => s_base_cp_to_foo   
+    
+  end type s_base
+  
+  
+  type, extends(s_base) :: s_foo
+    
+    integer              :: nnz
+    integer, allocatable :: ia(:), ja(:)
+    real, allocatable :: val(:)
+    
+  contains
+    
+    procedure, pass(a) :: cp_to_foo    => s_cp_foo_to_foo
+    
+  end type s_foo
+  
+  
+  interface 
+    subroutine s_base_cp_to_foo(a,b,info) 
+      import :: s_base, s_foo
+      class(s_base), intent(in) :: a
+      class(s_foo), intent(inout) :: b
+      integer, intent(out)            :: info
+    end subroutine s_base_cp_to_foo
+  end interface
+  
+  interface 
+    subroutine s_cp_foo_to_foo(a,b,info) 
+      import :: s_foo
+      class(s_foo), intent(in) :: a
+      class(s_foo), intent(inout) :: b
+      integer, intent(out)            :: info
+    end subroutine s_cp_foo_to_foo
+  end interface
+
+end module s_base_mod
+
+
+subroutine trans2(a,b)
+  use s_base_mod
+  implicit none 
+
+  class(s_base), intent(out) :: a
+  class(base), intent(in)   :: b
+
+  type(s_foo) :: tmp
+  integer err_act, info
+
+
+  info = 0
+  select type(b)
+  class is (s_base)
+    call b%cp_to_foo(tmp,info)
+  class default
+    info = -1
+    write(*,*) 'Invalid dynamic type'
+  end select
+  
+  if (info /= 0) write(*,*) 'Error code ',info
+
+  return
+
+end subroutine trans2
+
+! { dg-final { cleanup-modules "base_mod s_base_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/select_type_19.f03 b/gcc/testsuite/gfortran.dg/select_type_19.f03
new file mode 100644
index 000000000..0ae2e1ce2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_19.f03
@@ -0,0 +1,23 @@
+! { dg-do run }
+!
+! PR 46581: [4.6 Regression] [OOP] segfault in SELECT TYPE with associate-name
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+
+  implicit none
+
+  type :: t1
+    integer, allocatable :: ja(:)
+  end type
+
+  class(t1), allocatable  :: a 
+
+  allocate(a)
+
+  select type (aa=>a)
+  type is (t1)
+    if (allocated(aa%ja)) call abort()
+  end select
+
+end
diff --git a/gcc/testsuite/gfortran.dg/select_type_2.f03 b/gcc/testsuite/gfortran.dg/select_type_2.f03
new file mode 100644
index 000000000..d4a5343d7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_2.f03
@@ -0,0 +1,67 @@
+! { dg-do run }
+!
+! executing simple SELECT TYPE statements
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+  type :: t1
+    integer :: i
+  end type t1
+
+  type, extends(t1) :: t2
+    integer :: j
+  end type t2
+
+  type, extends(t1) :: t3
+    real :: r
+  end type
+
+  class(t1), pointer :: cp
+  type(t1), target :: a
+  type(t2), target :: b
+  type(t3), target :: c
+  integer :: i
+
+  cp => a
+  i = 0
+
+  select type (cp)
+  type is (t1)
+    i = 1
+  type is (t2)
+    i = 2
+  class is (t1)
+    i = 3
+  end select
+
+  if (i /= 1) call abort()
+
+  cp => b
+  i = 0
+
+  select type (cp)
+  type is (t1)
+    i = 1
+  type is (t2)
+    i = 2
+  class is (t2)
+    i = 3
+  end select
+
+  if (i /= 2) call abort()
+
+  cp => c
+  i = 0
+
+  select type (cp)
+  type is (t1)
+    i = 1
+  type is (t2)
+    i = 2
+  class default
+    i = 3
+  end select
+
+  if (i /= 3) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/select_type_20.f90 b/gcc/testsuite/gfortran.dg/select_type_20.f90
new file mode 100644
index 000000000..a247f7b0c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_20.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! PR fortran/45848
+! PR fortran/47204
+!
+! Contributed by Harald Anlauf and Zdenek Sojka
+!
+module gfcbug111
+  implicit none
+
+  type, abstract :: inner_product_class
+  end type inner_product_class
+
+  type, extends(inner_product_class) :: trivial_inner_product_type
+  end type trivial_inner_product_type
+
+contains
+
+  function my_dot_v_v (this,a,b) ! { dg-error "has no IMPLICIT type" }
+    class(trivial_inner_product_type), intent(in) :: this
+    class(vector_class),               intent(in) :: a,b ! { dg-error "Derived type" }
+    real :: my_dot_v_v
+
+    select type (a)
+    class is (trivial_vector_type) ! { dg-error "Syntax error in CLASS IS" }
+       select type (b) ! { dg-error "Expected TYPE IS" }
+       class is (trivial_vector_type) ! { dg-error "Syntax error in CLASS IS" }
+       class default
+       end select
+    class default ! { dg-error "Unclassifiable statement" }
+    end select ! { dg-error "Expecting END FUNCTION" }
+  end function my_dot_v_v
+end module gfcbug111
+
+select type (a)
+! { dg-excess-errors "Unexpected end of file" }
diff --git a/gcc/testsuite/gfortran.dg/select_type_21.f90 b/gcc/testsuite/gfortran.dg/select_type_21.f90
new file mode 100644
index 000000000..48d696813
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_21.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! PR fortran/45848
+! PR fortran/47204
+!
+select type (a) ! { dg-error "Selector shall be polymorphic" }
+end select
+end
diff --git a/gcc/testsuite/gfortran.dg/select_type_22.f03 b/gcc/testsuite/gfortran.dg/select_type_22.f03
new file mode 100644
index 000000000..68d2ff6a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_22.f03
@@ -0,0 +1,17 @@
+! { dg-do compile }
+!
+! PR 47330: [OOP] ICE on invalid source in connection with SELECT TYPE
+!
+! Contributed by Andrew Benson <abenson@its.caltech.edu>
+
+  type treeNode
+  end type
+contains
+  subroutine proc1 (thisNode)
+    class (treeNode), target :: thisNode
+    select type (thisNode)
+    type is (treeNode)
+       workNode => thisNode  ! { dg-error "Non-POINTER in pointer association context" }
+    end select
+  end subroutine
+end
diff --git a/gcc/testsuite/gfortran.dg/select_type_3.f03 b/gcc/testsuite/gfortran.dg/select_type_3.f03
new file mode 100644
index 000000000..13cd3c11a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_3.f03
@@ -0,0 +1,42 @@
+! { dg-do run }
+!
+! SELECT TYPE with temporaries
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+  type :: t1
+    integer :: i = -1
+  end type t1
+
+  type, extends(t1) :: t2
+    integer :: j = -1
+  end type t2
+
+  class(t1), pointer :: cp
+  type(t2), target :: b
+
+  cp => b
+
+  select type (cp)
+  type is (t1)
+    cp%i = 1
+  type is (t2)
+    cp%j = 2
+  end select
+
+  print *,b%i,b%j
+  if (b%i /= -1) call abort()
+  if (b%j /= 2) call abort()
+
+  select type (cp)
+  type is (t1)
+    cp%i = 4
+  type is (t2)
+    cp%i = 3*cp%j
+  end select
+
+  print *,b%i,b%j
+  if (b%i /= 6) call abort()
+  if (b%j /= 2) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/select_type_4.f90 b/gcc/testsuite/gfortran.dg/select_type_4.f90
new file mode 100644
index 000000000..95488e5f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_4.f90
@@ -0,0 +1,175 @@
+! { dg-do run }
+!
+! Contributed by by Richard Maine
+! http://coding.derkeiler.com/Archive/Fortran/comp.lang.fortran/2006-10/msg00104.html
+!
+module poly_list 
+
+  !--  Polymorphic lists using type extension. 
+
+  implicit none 
+
+  type, public :: node_type 
+    private 
+    class(node_type), pointer :: next => null() 
+  end type node_type 
+
+  type, public :: list_type 
+    private 
+    class(node_type), pointer :: head => null(), tail => null() 
+  end type list_type 
+
+contains 
+
+  subroutine append_node (list, new_node) 
+
+    !-- Append a node to a list. 
+    !-- Caller is responsible for allocating the node. 
+
+    !---------- interface. 
+
+    type(list_type), intent(inout) :: list 
+    class(node_type), target :: new_node 
+
+    !---------- executable code. 
+
+    if (.not.associated(list%head)) list%head => new_node 
+    if (associated(list%tail)) list%tail%next => new_node 
+    list%tail => new_node 
+    return 
+  end subroutine append_node 
+
+  function first_node (list) 
+
+    !-- Get the first node of a list. 
+
+    !---------- interface. 
+
+    type(list_type), intent(in) :: list 
+    class(node_type), pointer :: first_node 
+
+    !---------- executable code. 
+
+    first_node => list%head 
+    return 
+  end function first_node 
+
+  function next_node (node) 
+
+    !-- Step to the next node of a list. 
+
+    !---------- interface. 
+
+    class(node_type), target :: node 
+    class(node_type), pointer :: next_node 
+
+    !---------- executable code. 
+
+    next_node => node%next 
+    return 
+  end function next_node 
+
+  subroutine destroy_list (list) 
+
+    !-- Delete (and deallocate) all the nodes of a list. 
+
+    !---------- interface. 
+    type(list_type), intent(inout) :: list 
+
+    !---------- local. 
+    class(node_type), pointer :: node, next 
+
+    !---------- executable code. 
+
+    node => list%head 
+    do while (associated(node)) 
+      next => node%next 
+      deallocate(node) 
+      node => next 
+    end do 
+    nullify(list%head, list%tail) 
+    return 
+  end subroutine destroy_list 
+
+end module poly_list 
+
+program main 
+
+  use poly_list 
+
+  implicit none 
+  integer :: cnt
+
+  type, extends(node_type) :: real_node_type 
+    real :: x 
+  end type real_node_type 
+
+  type, extends(node_type) :: integer_node_type 
+    integer :: i 
+  end type integer_node_type 
+
+  type, extends(node_type) :: character_node_type 
+    character(1) :: c 
+  end type character_node_type 
+
+  type(list_type) :: list 
+  class(node_type), pointer :: node 
+  type(integer_node_type), pointer :: integer_node 
+  type(real_node_type), pointer :: real_node 
+  type(character_node_type), pointer :: character_node 
+
+  !---------- executable code. 
+
+  !----- Build the list. 
+
+  allocate(real_node) 
+  real_node%x = 1.23 
+  call append_node(list, real_node) 
+
+  allocate(integer_node) 
+  integer_node%i = 42 
+  call append_node(list, integer_node) 
+
+  allocate(node) 
+  call append_node(list, node) 
+
+  allocate(character_node) 
+  character_node%c = "z" 
+  call append_node(list, character_node) 
+
+  allocate(real_node) 
+  real_node%x = 4.56 
+  call append_node(list, real_node) 
+
+  !----- Retrieve from it. 
+
+  node => first_node(list) 
+
+  cnt = 0
+  do while (associated(node)) 
+    cnt = cnt + 1
+    select type (node) 
+      type is (real_node_type) 
+        write (*,*) node%x
+        if (.not.(     (cnt == 1 .and. node%x == 1.23)   &
+                  .or. (cnt == 5 .and. node%x == 4.56))) then
+          call abort()
+        end if
+      type is (integer_node_type) 
+        write (*,*) node%i
+        if (cnt /= 2 .or. node%i /= 42) call abort()
+      type is (node_type) 
+        write (*,*) "Node with no data."
+        if (cnt /= 3) call abort()
+      class default 
+        Write (*,*) "Some other node type."
+        if (cnt /= 4) call abort()
+    end select 
+
+    node => next_node(node) 
+  end do 
+  if (cnt /= 5) call abort()
+  call destroy_list(list) 
+  stop 
+end program main 
+! { dg-final { cleanup-modules "poly_list" } }
diff --git a/gcc/testsuite/gfortran.dg/select_type_5.f03 b/gcc/testsuite/gfortran.dg/select_type_5.f03
new file mode 100644
index 000000000..ec9d3cd8d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_5.f03
@@ -0,0 +1,47 @@
+! { dg-do run }
+!
+! SELECT TYPE with associate-name
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+  type :: t1
+    integer :: i = -1
+    class(t1), pointer :: c
+  end type t1
+
+  type, extends(t1) :: t2
+    integer :: j = -1
+  end type t2
+
+  type(t2), target :: b
+  integer :: aa
+
+  b%c => b
+  aa = 5
+
+  select type (aa => b%c)
+  type is (t1)
+    aa%i = 1
+  type is (t2)
+    aa%j = 2
+  end select
+
+  print *,b%i,b%j
+  if (b%i /= -1) call abort()
+  if (b%j /= 2) call abort()
+
+  select type (aa => b%c)
+  type is (t1)
+    aa%i = 4
+  type is (t2)
+    aa%i = 3*aa%j
+  end select
+
+  print *,b%i,b%j
+  if (b%i /= 6) call abort()
+  if (b%j /= 2) call abort()
+
+  print *,aa
+  if (aa/=5) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/select_type_6.f03 b/gcc/testsuite/gfortran.dg/select_type_6.f03
new file mode 100644
index 000000000..3b3c08e22
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_6.f03
@@ -0,0 +1,38 @@
+! { dg-do run }
+!
+! PR 41579: [OOP/Polymorphism] Nesting of SELECT TYPE
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+ type t1
+ end type t1
+
+ type, extends(t1) :: t2
+  integer :: i
+ end type t2
+
+ type, extends(t1) :: t3
+  integer :: j
+ end type t3
+
+ class(t1), allocatable :: mt2, mt3
+ allocate(t2 :: mt2)
+ allocate(t3 :: mt3)
+
+ select type (mt2)
+ type is(t2)
+   mt2%i = 5
+   print *,mt2%i
+   select type(mt3)
+   type is(t3)
+     mt3%j = 2*mt2%i
+     print *,mt3%j
+     if (mt3%j /= 10) call abort()
+   class default
+     call abort()
+   end select
+ class default
+   call abort()
+ end select
+
+end
diff --git a/gcc/testsuite/gfortran.dg/select_type_7.f03 b/gcc/testsuite/gfortran.dg/select_type_7.f03
new file mode 100644
index 000000000..554b6cd12
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_7.f03
@@ -0,0 +1,40 @@
+! { dg-do run }
+!
+! PR 41766: [OOP] SELECT TYPE selector as actual argument with INTENT(INOUT)
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+ implicit none
+
+ type t1
+   integer :: a
+ end type
+
+ type, extends(t1) :: t2
+   integer :: b
+ end type
+
+ class(t1),allocatable :: cp
+
+ allocate(t2 :: cp)
+
+ select type (cp)
+   type is (t2)
+     cp%a = 98
+     cp%b = 76
+     call s(cp)
+     print *,cp%a,cp%b
+     if (cp%a /= cp%b) call abort()
+   class default
+     call abort()
+ end select
+
+contains
+
+  subroutine s(f)
+    type(t2), intent(inout) :: f
+    f%a = 3
+    f%b = 3
+  end subroutine
+
+end
diff --git a/gcc/testsuite/gfortran.dg/select_type_8.f03 b/gcc/testsuite/gfortran.dg/select_type_8.f03
new file mode 100644
index 000000000..306f2d182
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_8.f03
@@ -0,0 +1,98 @@
+! { dg-do run }
+!
+! executing SELECT TYPE statements with CLASS IS blocks
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+  implicit none
+
+  type :: t1
+    integer :: i
+  end type t1
+
+  type, extends(t1) :: t2
+    integer :: j
+  end type t2
+
+  type, extends(t2) :: t3
+    real :: r
+  end type
+
+  class(t1), pointer :: cp
+  type(t1), target :: a
+  type(t2), target :: b
+  type(t3), target :: c
+  integer :: i
+
+  cp => c
+  i = 0
+  select type (cp)
+  type is (t1)
+    i = 1
+  type is (t2)
+    i = 2
+  class is (t1)
+    i = 3
+  class default
+    i = 4
+  end select
+  print *,i
+  if (i /= 3) call abort()
+
+  cp => a
+  select type (cp)
+  type is (t1)
+    i = 1
+  type is (t2)
+    i = 2
+  class is (t1)
+    i = 3
+  end select
+  print *,i
+  if (i /= 1) call abort()
+
+  cp => b
+  select type (cp)
+  type is (t1)
+    i = 1
+  class is (t3)
+    i = 3
+  class is (t2)
+    i = 4
+  class is (t1)
+    i = 5
+  end select
+  print *,i
+  if (i /= 4) call abort()
+
+  cp => b
+  select type (cp)
+  type is (t1)
+    i = 1
+  class is (t1)
+    i = 5
+  class is (t2)
+    i = 4
+  class is (t3)
+    i = 3
+  end select
+  print *,i
+  if (i /= 4) call abort()
+
+  cp => a
+  select type (cp)
+  type is (t2)
+    i = 1
+  class is (t2)
+    i = 2
+  class default
+    i = 3
+  class is (t3)
+    i = 4
+  type is (t3)
+    i = 5
+  end select
+  print *,i
+  if (i /= 3) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/select_type_9.f03 b/gcc/testsuite/gfortran.dg/select_type_9.f03
new file mode 100644
index 000000000..62df6700e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_9.f03
@@ -0,0 +1,20 @@
+! { dg-do compile }
+!
+! PR 42053: [OOP] SELECT TYPE: reject duplicate CLASS IS blocks
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+ type :: t
+  integer :: i
+ end type
+
+ CLASS(t),pointer :: x
+
+ select type (x)
+ class is (t)
+  print *,"a"
+ class is (t)  ! { dg-error "Double CLASS IS block" }
+  print *,"b"
+ end select
+
+end
diff --git a/gcc/testsuite/gfortran.dg/selected_char_kind_1.f90 b/gcc/testsuite/gfortran.dg/selected_char_kind_1.f90
new file mode 100644
index 000000000..f11fd0fb3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/selected_char_kind_1.f90
@@ -0,0 +1,65 @@
+! { dg-do run }
+! 
+! Checks for the SELECTED_CHAR_KIND intrinsic
+!
+  integer, parameter :: ascii = selected_char_kind ("ascii")
+  integer, parameter :: default = selected_char_kind ("default")
+
+  character(kind=ascii) :: s1
+  character(kind=default) :: s2
+  character(kind=selected_char_kind ("ascii")) :: s3
+  character(kind=selected_char_kind ("default")) :: s4
+
+  if (kind (s1) /= selected_char_kind ("ascii")) call abort
+  if (kind (s2) /= selected_char_kind ("default")) call abort
+  if (kind (s3) /= ascii) call abort
+  if (kind (s4) /= default) call abort
+
+  if (selected_char_kind("ascii") /= 1) call abort
+  if (selected_char_kind("default") /= 1) call abort
+  if (selected_char_kind("defauLt") /= 1) call abort
+  if (selected_char_kind("foo") /= -1) call abort
+  if (selected_char_kind("asciiiii") /= -1) call abort
+  if (selected_char_kind("default       ") /= 1) call abort
+
+  call test("ascii", 1)
+  call test("default", 1)
+  call test("defauLt", 1)
+  call test("asciiiiii", -1)
+  call test("foo", -1)
+  call test("default     ", 1)
+  call test("default     x", -1)
+
+  call test(ascii_"ascii", 1)
+  call test(ascii_"default", 1)
+  call test(ascii_"defauLt", 1)
+  call test(ascii_"asciiiiii", -1)
+  call test(ascii_"foo", -1)
+  call test(ascii_"default     ", 1)
+  call test(ascii_"default     x", -1)
+
+  call test(default_"ascii", 1)
+  call test(default_"default", 1)
+  call test(default_"defauLt", 1)
+  call test(default_"asciiiiii", -1)
+  call test(default_"foo", -1)
+  call test(default_"default     ", 1)
+  call test(default_"default     x", -1)
+
+  if (kind (selected_char_kind ("")) /= kind(0)) call abort
+end
+
+subroutine test(s,i)
+  character(len=*,kind=selected_char_kind("ascii")) s
+  integer i
+
+  call test2(s,i)
+  if (selected_char_kind (s) /= i) call abort
+end subroutine test
+
+subroutine test2(s,i)
+  character(len=*,kind=selected_char_kind("default")) s
+  integer i
+
+  if (selected_char_kind (s) /= i) call abort
+end subroutine test2
diff --git a/gcc/testsuite/gfortran.dg/selected_char_kind_2.f90 b/gcc/testsuite/gfortran.dg/selected_char_kind_2.f90
new file mode 100644
index 000000000..28ecd96ba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/selected_char_kind_2.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+!
+! Check that nonexisting character kinds are not rejected by the compiler
+!
+  character(kind=selected_char_kind("")) :: s1 ! { dg-error "is not supported for CHARACTER" }
+  character(kind=selected_char_kind("     ")) :: s2 ! { dg-error "is not supported for CHARACTER" }
+  character(kind=selected_char_kind("asciii")) :: s3 ! { dg-error "is not supported for CHARACTER" }
+  character(kind=selected_char_kind("I don't exist")) :: s4 ! { dg-error "is not supported for CHARACTER" }
+
+  print *, selected_char_kind() ! { dg-error "Missing actual argument" }
+  print *, selected_char_kind(12) ! { dg-error "must be CHARACTER" }
+  print *, selected_char_kind(["foo", "bar"]) ! { dg-error "must be a scalar" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/selected_char_kind_3.f90 b/gcc/testsuite/gfortran.dg/selected_char_kind_3.f90
new file mode 100644
index 000000000..fad5e46c2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/selected_char_kind_3.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=f95 -pedantic -Wall -Wno-intrinsics-std" }
+!
+! Check that SELECTED_CHAR_KIND is rejected with -std=f95
+!
+  implicit none
+  character(kind=selected_char_kind("ascii")) :: s ! { dg-error "has no IMPLICIT type" }
+  s = "" ! { dg-error "has no IMPLICIT type" }
+  print *, s
+end
diff --git a/gcc/testsuite/gfortran.dg/selected_char_kind_4.f90 b/gcc/testsuite/gfortran.dg/selected_char_kind_4.f90
new file mode 100644
index 000000000..046ddf0e7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/selected_char_kind_4.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+!
+! Check that runtime result values of SELECTED_CHAR_KIND agree with
+! front-end simplification results.
+!
+  implicit none
+  character(len=20) :: s
+
+  s = "ascii"
+  if (selected_char_kind(s) /= selected_char_kind("ascii")) call abort
+
+  s = "default"
+  if (selected_char_kind(s) /= selected_char_kind("default")) call abort
+
+  s = "iso_10646"
+  if (selected_char_kind(s) /= selected_char_kind("iso_10646")) call abort
+
+  s = ""
+  if (selected_char_kind(s) /= selected_char_kind("")) call abort
+
+  s = "invalid"
+  if (selected_char_kind(s) /= selected_char_kind("invalid")) call abort
+
+end
diff --git a/gcc/testsuite/gfortran.dg/selected_kind_1.f90 b/gcc/testsuite/gfortran.dg/selected_kind_1.f90
new file mode 100644
index 000000000..0c710546d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/selected_kind_1.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fdefault-integer-8" }
+! PR fortran/32968
+program selected
+
+  if (selected_int_kind (1)  /= 1) call abort
+  if (selected_int_kind (3)  /= 2) call abort
+  if (selected_int_kind (5)  /= 4) call abort
+  if (selected_int_kind (10) /= 8) call abort
+  if (selected_real_kind (1)  /= 4) call abort
+  if (selected_real_kind (2)  /= 4) call abort
+  if (selected_real_kind (9)  /= 8) call abort
+  if (selected_real_kind (10) /= 8) call abort
+
+end program selected
+
diff --git a/gcc/testsuite/gfortran.dg/selected_real_kind_1.f90 b/gcc/testsuite/gfortran.dg/selected_real_kind_1.f90
new file mode 100644
index 000000000..f771f9a2e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/selected_real_kind_1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+!
+! PR fortran/44347 - arguments of SELECTED_REAL_KIND shall be scalar
+! Testcase contributed by Vittorio Zecca <zeccav AT gmail DOT com>
+!
+
+  dimension ip(1), ir(1)
+  i = selected_real_kind(ip, i)      ! { dg-error "must be a scalar" }
+  j = selected_real_kind(i, ir)      ! { dg-error "must be a scalar" }
+end
diff --git a/gcc/testsuite/gfortran.dg/selected_real_kind_2.f90 b/gcc/testsuite/gfortran.dg/selected_real_kind_2.f90
new file mode 100644
index 000000000..cf73520f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/selected_real_kind_2.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+!
+
+integer :: p, r, rdx
+
+! Compile-time version
+
+if (selected_real_kind(radix=2) /= 4) call should_not_fail()
+if (selected_real_kind(radix=4) /= -5) call should_not_fail()
+if (selected_real_kind(precision(0.0),range(0.0),radix(0.0)) /= kind(0.0)) &
+  call should_not_fail()
+if (selected_real_kind(precision(0.0d0),range(0.0d0),radix(0.0d0)) /= kind(0.0d0)) &
+  call should_not_fail()
+
+! Run-time version
+
+rdx = 2
+if (selected_real_kind(radix=rdx) /= 4) call abort()
+rdx = 4
+if (selected_real_kind(radix=rdx) /= -5) call abort()
+
+rdx = radix(0.0)
+p = precision(0.0)
+r = range(0.0)
+if (selected_real_kind(p,r,rdx) /= kind(0.0)) call abort()
+
+rdx = radix(0.0d0)
+p = precision(0.0d0)
+r = range(0.0d0)
+if (selected_real_kind(p,r,rdx) /= kind(0.0d0)) call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/selected_real_kind_3.f90 b/gcc/testsuite/gfortran.dg/selected_real_kind_3.f90
new file mode 100644
index 000000000..d24d877ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/selected_real_kind_3.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+print *, selected_real_kind(p=precision(0.0),radix=2) ! { dg-error "Fortran 2008" }
+print *, selected_real_kind() ! { dg-error "neither 'P' nor 'R' argument" }
+end
diff --git a/gcc/testsuite/gfortran.dg/semicolon_fixed.f b/gcc/testsuite/gfortran.dg/semicolon_fixed.f
new file mode 100644
index 000000000..7bd0ada82
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/semicolon_fixed.f
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR 19259 Semicolon cannot start a line (in F2003)
+      x=1; y=1;
+      x=2;;
+      x=3;
+      ;                         ! { dg-error "Fortran 2008: Semicolon at" }
+      ;;                        ! { dg-error "Fortran 2008: Semicolon at" }
+ 900  ;                         ! { dg-error "Semicolon at" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/semicolon_fixed_2.f b/gcc/testsuite/gfortran.dg/semicolon_fixed_2.f
new file mode 100644
index 000000000..8ee444c3f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/semicolon_fixed_2.f
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+
+! PR 19259 Semicolon cannot start a line
+! but it F2008 it can!
+      x=1; y=1;
+      x=2;;
+      x=3;
+      ;                         ! OK
+      ;;                        ! OK
+ 900  ;                         ! { dg-error "Semicolon at" }
+      end
diff --git a/gcc/testsuite/gfortran.dg/semicolon_free.f90 b/gcc/testsuite/gfortran.dg/semicolon_free.f90
new file mode 100644
index 000000000..4d05d83f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/semicolon_free.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! PR 19259 Semicolon cannot start a line
+x=1; y=1;
+x=2;;
+x=3;
+ ; ! { dg-error "Semicolon at" }
+;; ! { dg-error "Semicolon at" }
+111 ; ! { dg-error "Semicolon at" }
+end
diff --git a/gcc/testsuite/gfortran.dg/semicolon_free_2.f90 b/gcc/testsuite/gfortran.dg/semicolon_free_2.f90
new file mode 100644
index 000000000..2fae26e16
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/semicolon_free_2.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+! PR 19259 Semicolon cannot start a line
+x=1; y=1;
+x=2;;
+x=3;
+ ; ! OK
+;; ! OK
+111 ; ! { dg-error "Semicolon at" }
+end
diff --git a/gcc/testsuite/gfortran.dg/sequence_types_1.f90 b/gcc/testsuite/gfortran.dg/sequence_types_1.f90
new file mode 100644
index 000000000..62cd8fd68
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/sequence_types_1.f90
@@ -0,0 +1,80 @@
+! { dg-do compile }
+! Tests the fix for PR28590, in which pointer components of sequence
+! types would give the error that the component is itself not a
+! sequence type (4.4.1) if the component was not already defined.
+!
+! Contributed by Chris Nelson <ccnelson@itacllc.com>
+! 
+module data_types
+  Integer, Parameter :: kindAry    = selected_int_kind(r=8)
+  Integer, Parameter :: kindInt    = selected_int_kind(r=8)
+
+  Integer, Parameter :: kindQ      = selected_real_kind(p=6,r=37)
+  Integer, Parameter :: kindXYZ    = selected_real_kind(p=13,r=200)
+  Integer, Parameter :: kindDouble = selected_real_kind(p=13,r=200)
+
+  type GroupLoadInfo
+    sequence
+    Integer(kindAry)          :: loadMode
+    Integer(kindAry)          :: normalDir
+    Real(kindQ)               :: refS, refL, refX, refY, refZ
+    Real(kindQ)               :: forcex,   forcey,   forcez 
+    Real(kindQ)               :: forcexv,  forceyv,  forcezv 
+    Real(kindQ)               :: momx,     momy,     momz 
+    Real(kindQ)               :: momxv,    momyv,    momzv 
+    Real(kindQ)               :: flmassx,  flmassy,  flmassz 
+    Real(kindQ)               :: flmomtmx, flmomtmy, flmomtmz 
+    Real(kindQ)               :: flheatN
+  end type GroupLoadInfo
+
+  type GroupRigidMotion
+    sequence
+    Integer(kindInt)                     :: motiontyp
+    Real(kindXYZ), dimension(3)          :: xref
+    Real(kindXYZ), dimension(3)          :: angCurrent
+    Real(kindXYZ), dimension(3)          :: xdot
+    Real(kindXYZ), dimension(3)          :: angNew
+    Real(kindXYZ), dimension(3)          :: angRate
+    Real(kindDouble)                     :: curTim
+    Real(kindXYZ)              , pointer :: properties
+    Type(PrescribedMotionData) , pointer :: PrescribeDat
+  end type GroupRigidMotion
+
+  type PrescribedMotionData
+    sequence
+    Integer(kindInt)            :: prescr_typ
+    Real(kindXYZ), dimension(3) :: xvel
+    Real(kindXYZ)               :: amplitude
+    Real(kindXYZ)               :: frequency
+    Real(kindXYZ)               :: phase
+    Real(kindXYZ), dimension(3) :: thetadot
+    Real(kindXYZ), dimension(3) :: thetaddot
+  end type PrescribedMotionData
+  
+  type GroupDeformingMotion
+    sequence
+    Integer(kindAry) :: nmodes
+  end type GroupDeformingMotion
+  
+  type GroupLL
+    sequence
+    type(GroupLL)             , pointer :: next
+    type(GroupLL)             , pointer :: parent
+    character(32)                       :: name
+    type(GroupDefLL)          , pointer :: entities
+    type(GroupLoadInfo)       , pointer :: loadInfo
+    type(GroupRigidMotion)    , pointer :: RigidMotion
+    type(GroupDeformingMotion), pointer :: DeformingMotion
+  end type GroupLL
+  
+  type GroupDefLL 
+    sequence
+    type ( GroupDefLL ), pointer            :: next
+    Integer(kindInt)                        :: zone
+    Integer(kindInt)                        :: surface
+    type ( GroupLL ), pointer               :: subGrp
+    Integer(kindInt)                        :: normalDir
+    Integer(kindInt), dimension(:), pointer :: subset
+  end type GroupDefLL
+end module data_types
+! { dg-final { cleanup-modules "data_types" } }
diff --git a/gcc/testsuite/gfortran.dg/shape_1.f90 b/gcc/testsuite/gfortran.dg/shape_1.f90
new file mode 100644
index 000000000..9292adb2e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/shape_1.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! PR 13201 we used to not give an error in those cases
+subroutine foo(n) 
+  integer, parameter :: a(n) = 1           ! { dg-error "cannot be automatic" "automatic shape" }
+  integer, parameter :: z(:) = (/ 1,2,3 /) ! { dg-error "cannot be automatic" "deferred shape" }
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/shape_2.f90 b/gcc/testsuite/gfortran.dg/shape_2.f90
new file mode 100644
index 000000000..057cb4c85
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/shape_2.f90
@@ -0,0 +1,30 @@
+! Check that lbound() and ubound() work correctly for assumed shapes.
+! { dg-do run }
+program main
+  integer, dimension (40, 80) :: a = 1
+  call test (a)
+contains
+  subroutine test (b)
+    integer, dimension (11:, -8:), target :: b
+    integer, dimension (:, :), pointer :: ptr
+
+    if (lbound (b, 1) .ne. 11) call abort
+    if (ubound (b, 1) .ne. 50) call abort
+    if (lbound (b, 2) .ne. -8) call abort
+    if (ubound (b, 2) .ne. 71) call abort
+
+    if (lbound (b (:, :), 1) .ne. 1) call abort
+    if (ubound (b (:, :), 1) .ne. 40) call abort
+    if (lbound (b (:, :), 2) .ne. 1) call abort
+    if (ubound (b (:, :), 2) .ne. 80) call abort
+
+    if (lbound (b (20:30:3, 40), 1) .ne. 1) call abort
+    if (ubound (b (20:30:3, 40), 1) .ne. 4) call abort
+
+    ptr => b
+    if (lbound (ptr, 1) .ne. 11) call abort
+    if (ubound (ptr, 1) .ne. 50) call abort
+    if (lbound (ptr, 2) .ne. -8) call abort
+    if (ubound (ptr, 2) .ne. 71) call abort
+  end subroutine test
+end program main
diff --git a/gcc/testsuite/gfortran.dg/shape_3.f90 b/gcc/testsuite/gfortran.dg/shape_3.f90
new file mode 100644
index 000000000..ea725a014
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/shape_3.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! PR 34980 - we got a segfault for calling shape
+!            with a scalar.
+program main
+ integer :: n
+ n = 5
+ open(10,status="scratch")
+ write (10,*) shape(n)
+ close(10,status="delete")
+end
+
diff --git a/gcc/testsuite/gfortran.dg/shape_4.f90 b/gcc/testsuite/gfortran.dg/shape_4.f90
new file mode 100644
index 000000000..9275b11b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/shape_4.f90
@@ -0,0 +1,12 @@
+! PR 35001 - we need to return 0 for the shapes of
+! negative extents.  Test case adapted from Tobias Burnus.
+program main
+  implicit none
+  integer :: i,j, a(10,10),res(2)
+  j = 1
+  i = 10
+  res = shape(a(1:1,i:j:1))
+  if (res(1) /=1 .or. res(2) /= 0) call abort
+  res = shape(a(1:1,j:i:-1))
+  if (res(1) /=1 .or. res(2) /= 0) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/shape_5.f90 b/gcc/testsuite/gfortran.dg/shape_5.f90
new file mode 100644
index 000000000..ed128bcd2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/shape_5.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+! PR 40067 - this used to segfault on an unallocated return array.
+    integer, dimension(10)             :: int1d
+    integer, dimension(:), pointer     :: int1d_retrieved
+
+    allocate(int1d_retrieved(10))
+    if (any(shape(int1d_retrieved) /= shape(INT1D))) call abort()
+    end
diff --git a/gcc/testsuite/gfortran.dg/shape_6.f90 b/gcc/testsuite/gfortran.dg/shape_6.f90
new file mode 100644
index 000000000..d68f7bef5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/shape_6.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+!
+! PR fortran/47531
+!
+! Contributed by James Van Buskirk
+!
+! Check for the presence of the optional kind= argument
+! of F2003.
+!
+
+program bug1
+   use ISO_C_BINDING
+   implicit none
+   real,allocatable :: weevil(:,:)
+
+   write(*,*) achar(64,C_CHAR)
+   write(*,*) char(64,C_CHAR)
+   write(*,*) iachar('A',C_INTPTR_T)
+   write(*,*) ichar('A',C_INTPTR_T)
+   write(*,*) len('A',C_INTPTR_T)
+   write(*,*) len_trim('A',C_INTPTR_T)
+   allocate(weevil(2,2))
+   weevil = 42
+   write(*,*) ceiling(weevil,C_INTPTR_T)
+   write(*,*) floor(weevil,C_INTPTR_T)
+   write(*,*) shape(weevil,C_INTPTR_T)
+   write(*,*) storage_size(weevil,C_INTPTR_T)
+end program bug1
+
diff --git a/gcc/testsuite/gfortran.dg/shape_7.f90 b/gcc/testsuite/gfortran.dg/shape_7.f90
new file mode 100644
index 000000000..3c471f4d4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/shape_7.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/52093
+!
+! Contributed by Mohammad Rahmani
+!
+
+Program Main
+ Implicit None
+ Integer:: X(2,2)
+ Integer:: X2(7:11,8:9)
+
+ if (size((X)) /= 4) call abort ()
+ if (any (Shape((X))  /= [2,2])) call abort ()
+ if (any (lbound((X)) /= [1,1])) call abort ()
+ if (any (ubound((X)) /= [2,2])) call abort ()
+
+ if (size(X2) /= 10) call abort ()
+ if (any (Shape(X2)  /= [5,2])) call abort ()
+ if (any (lbound(X2) /= [7,8]))  call abort ()
+ if (any (ubound(X2) /= [11,9])) call abort ()
+
+ if (size((X2)) /= 10) call abort ()
+ if (any (Shape((X2))  /= [5,2])) call abort ()
+ if (any (lbound((X2)) /= [1,1])) call abort ()
+ if (any (ubound((X2)) /= [5,2])) call abort ()
+End Program Main
+
+! { dg-final { scan-tree-dump-times "abort" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/shift-alloc.f90 b/gcc/testsuite/gfortran.dg/shift-alloc.f90
new file mode 100644
index 000000000..70f1cbb66
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/shift-alloc.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR 22144: eoshift1, eoshift3 and cshift1 used to lack memory
+! allocation, which caused the writes to segfault.
+program main
+  implicit none
+  integer, dimension (:,:),allocatable :: a
+  integer, dimension (3) :: sh, bo
+  character(len=80) line1, line2
+  integer :: i
+  
+  allocate (a(3,3))
+  a = reshape((/(i,i=1,9)/),shape(a))
+  sh = (/ 2, -1, -2 /)
+  bo = (/ -3, -2, -1 /)
+  write(unit=line1,fmt='(10I5)') cshift(a, shift=sh)
+  write(unit=line1,fmt='(10I5)') eoshift(a, shift=sh)
+  write(unit=line1,fmt='(10I5)') eoshift(a, shift=sh, boundary=bo)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/shift-kind.f90 b/gcc/testsuite/gfortran.dg/shift-kind.f90
new file mode 100644
index 000000000..70d874813
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/shift-kind.f90
@@ -0,0 +1,37 @@
+! { dg-do compile }
+! PR 22143:  We didn' have shift arguments to eoshift of kind=1
+!            and kind=2.
+program main
+  implicit none
+  integer, dimension (3,3) :: a, b, w
+  integer(kind=2), dimension (3) :: sh2
+  integer(kind=1), dimension (3) :: sh1
+  integer, dimension(3) :: bo
+  integer :: i,j
+
+  a = reshape((/(i,i=1,9)/),shape(a))
+  sh1 = (/ -3, -1, 3 /)
+  sh2 = (/ -3, -1, 3 /)
+  bo = (/-999, -99, -9 /)
+  b = cshift(a, shift=sh1)
+  call foo(b)
+  b = cshift(a, shift=sh2)
+  call foo(b)
+
+  b = eoshift(a, shift=sh1)
+  call foo(b)
+  b = eoshift(a, shift=sh1, boundary=bo)
+  call foo(b)
+  b = eoshift(a, shift=sh2)
+  call foo(b)
+  b = eoshift(a, shift=sh2, boundary=bo)
+  call foo(b)
+
+end program main
+
+subroutine foo(b)
+  ! Do nothing but confuse the optimizer into not removing the
+  ! function calls.
+  integer, dimension(3,3) :: b
+end subroutine foo
+
diff --git a/gcc/testsuite/gfortran.dg/shift-kind_2.f90 b/gcc/testsuite/gfortran.dg/shift-kind_2.f90
new file mode 100644
index 000000000..30e326398
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/shift-kind_2.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! PR34540 cshift, eoshift, kind=1 and kind=2 arguments...
+program main
+  integer(kind=1) :: d1
+  integer(kind=2) :: d2
+  integer(kind=4) :: d4
+  integer(kind=8) :: d8
+  integer(kind=1), dimension(2) :: s1
+  integer(kind=2), dimension(2) :: s2
+  integer(kind=4), dimension(2) :: s4
+  integer(kind=8), dimension(2) :: s8
+  real, dimension(2,2) :: r, r1, r2
+  data r /1.0, 2.0, 3.0, 4.0/
+  data r1 /2.0, 0.0, 4.0, 0.0/
+  data r2 /2.0, 1.0, 4.0, 3.0/
+  s1 = (/1, 1/)
+  s2 = (/1, 1/)
+  s4 = (/1, 1/)
+  s8 = (/1, 1/)
+  d1 = 1
+  d2 = 1
+  d4 = 1
+  d8 = 1
+  if (any(eoshift(r,shift=s1,dim=d1) /= r1)) call abort
+  if (any(eoshift(r,shift=s2,dim=d2) /= r1)) call abort
+  if (any(eoshift(r,shift=s4,dim=d4) /= r1)) call abort
+  if (any(eoshift(r,shift=s8,dim=d8) /= r1)) call abort
+  if (any(cshift(r,shift=s1,dim=d1) /= r2)) call abort
+  if (any(cshift(r,shift=s2,dim=d2) /= r2)) call abort
+  if (any(cshift(r,shift=s4,dim=d4) /= r2)) call abort
+  if (any(cshift(r,shift=s8,dim=d8) /= r2)) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/shiftalr_1.F90 b/gcc/testsuite/gfortran.dg/shiftalr_1.F90
new file mode 100644
index 000000000..9f2707bd9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/shiftalr_1.F90
@@ -0,0 +1,162 @@
+! Test the SHIFTA, SHIFTL and SHIFTR intrinsics.
+!
+! { dg-do run }
+! { dg-options "-ffree-line-length-none" }
+
+  interface run_shifta
+    procedure shifta_1
+    procedure shifta_2
+    procedure shifta_4
+    procedure shifta_8
+  end interface
+  interface run_shiftl
+    procedure shiftl_1
+    procedure shiftl_2
+    procedure shiftl_4
+    procedure shiftl_8
+  end interface
+  interface run_shiftr
+    procedure shiftr_1
+    procedure shiftr_2
+    procedure shiftr_4
+    procedure shiftr_8
+  end interface
+  interface run_ishft
+    procedure ishft_1
+    procedure ishft_2
+    procedure ishft_4
+    procedure ishft_8
+  end interface
+
+#define CHECK(I,SHIFT,RESA,RESL,RESR) \
+  if (shifta(I,SHIFT) /= RESA) call abort ; \
+  if (shiftr(I,SHIFT) /= RESR) call abort ; \
+  if (shiftl(I,SHIFT) /= RESL) call abort ; \
+  if (run_shifta(I,SHIFT) /= RESA) call abort ; \
+  if (run_shiftr(I,SHIFT) /= RESR) call abort ; \
+  if (run_shiftl(I,SHIFT) /= RESL) call abort ; \
+  if (ishft(I,SHIFT) /= RESL) call abort ; \
+  if (ishft(I,-SHIFT) /= RESR) call abort ; \
+  if (run_ishft(I,SHIFT) /= RESL) call abort ; \
+  if (run_ishft(I,-SHIFT) /= RESR) call abort
+
+  CHECK(0_1,0,0_1,0_1,0_1)
+  CHECK(11_1,0,11_1,11_1,11_1)
+  CHECK(-11_1,0,-11_1,-11_1,-11_1)
+  CHECK(0_1,1,0_1,0_1,0_1)
+  CHECK(11_1,1,5_1,22_1,5_1)
+  CHECK(11_1,2,2_1,44_1,2_1)
+  CHECK(-11_1,1,-6_1,-22_1,huge(0_1)-5_1)
+
+  CHECK(0_2,0,0_2,0_2,0_2)
+  CHECK(11_2,0,11_2,11_2,11_2)
+  CHECK(-11_2,0,-11_2,-11_2,-11_2)
+  CHECK(0_2,1,0_2,0_2,0_2)
+  CHECK(11_2,1,5_2,22_2,5_2)
+  CHECK(11_2,2,2_2,44_2,2_2)
+  CHECK(-11_2,1,-6_2,-22_2,huge(0_2)-5_2)
+
+  CHECK(0_4,0,0_4,0_4,0_4)
+  CHECK(11_4,0,11_4,11_4,11_4)
+  CHECK(-11_4,0,-11_4,-11_4,-11_4)
+  CHECK(0_4,1,0_4,0_4,0_4)
+  CHECK(11_4,1,5_4,22_4,5_4)
+  CHECK(11_4,2,2_4,44_4,2_4)
+  CHECK(-11_4,1,-6_4,-22_4,huge(0_4)-5_4)
+
+  CHECK(0_8,0,0_8,0_8,0_8)
+  CHECK(11_8,0,11_8,11_8,11_8)
+  CHECK(-11_8,0,-11_8,-11_8,-11_8)
+  CHECK(0_8,1,0_8,0_8,0_8)
+  CHECK(11_8,1,5_8,22_8,5_8)
+  CHECK(11_8,2,2_8,44_8,2_8)
+  CHECK(-11_8,1,-6_8,-22_8,huge(0_8)-5_8)
+
+contains
+
+  function shifta_1 (i, shift) result(res)
+    integer(kind=1) :: i, res
+    integer :: shift
+    res = shifta(i,shift)
+  end function
+  function shiftl_1 (i, shift) result(res)
+    integer(kind=1) :: i, res
+    integer :: shift
+    res = shiftl(i,shift)
+  end function
+  function shiftr_1 (i, shift) result(res)
+    integer(kind=1) :: i, res
+    integer :: shift
+    res = shiftr(i,shift)
+  end function
+
+  function shifta_2 (i, shift) result(res)
+    integer(kind=2) :: i, res
+    integer :: shift
+    res = shifta(i,shift)
+  end function
+  function shiftl_2 (i, shift) result(res)
+    integer(kind=2) :: i, res
+    integer :: shift
+    res = shiftl(i,shift)
+  end function
+  function shiftr_2 (i, shift) result(res)
+    integer(kind=2) :: i, res
+    integer :: shift
+    res = shiftr(i,shift)
+  end function
+
+  function shifta_4 (i, shift) result(res)
+    integer(kind=4) :: i, res
+    integer :: shift
+    res = shifta(i,shift)
+  end function
+  function shiftl_4 (i, shift) result(res)
+    integer(kind=4) :: i, res
+    integer :: shift
+    res = shiftl(i,shift)
+  end function
+  function shiftr_4 (i, shift) result(res)
+    integer(kind=4) :: i, res
+    integer :: shift
+    res = shiftr(i,shift)
+  end function
+
+  function shifta_8 (i, shift) result(res)
+    integer(kind=8) :: i, res
+    integer :: shift
+    res = shifta(i,shift)
+  end function
+  function shiftl_8 (i, shift) result(res)
+    integer(kind=8) :: i, res
+    integer :: shift
+    res = shiftl(i,shift)
+  end function
+  function shiftr_8 (i, shift) result(res)
+    integer(kind=8) :: i, res
+    integer :: shift
+    res = shiftr(i,shift)
+  end function
+
+  function ishft_1 (i, shift) result(res)
+    integer(kind=1) :: i, res
+    integer :: shift
+    res = ishft(i,shift)
+  end function
+  function ishft_2 (i, shift) result(res)
+    integer(kind=2) :: i, res
+    integer :: shift
+    res = ishft(i,shift)
+  end function
+  function ishft_4 (i, shift) result(res)
+    integer(kind=4) :: i, res
+    integer :: shift
+    res = ishft(i,shift)
+  end function
+  function ishft_8 (i, shift) result(res)
+    integer(kind=8) :: i, res
+    integer :: shift
+    res = ishft(i,shift)
+  end function
+
+end
diff --git a/gcc/testsuite/gfortran.dg/shiftalr_2.F90 b/gcc/testsuite/gfortran.dg/shiftalr_2.F90
new file mode 100644
index 000000000..0a34af5ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/shiftalr_2.F90
@@ -0,0 +1,52 @@
+! Test the SHIFTA, SHIFTL and SHIFTR intrinsics.
+!
+! { dg-do run }
+! { dg-options "-ffree-line-length-none" }
+! { dg-require-effective-target fortran_integer_16 }
+
+  implicit none
+
+#define CHECK(I,SHIFT,RESA,RESL,RESR) \
+  if (shifta(I,SHIFT) /= RESA) call abort ; \
+  if (shiftr(I,SHIFT) /= RESR) call abort ; \
+  if (shiftl(I,SHIFT) /= RESL) call abort ; \
+  if (run_shifta(I,SHIFT) /= RESA) call abort ; \
+  if (run_shiftr(I,SHIFT) /= RESR) call abort ; \
+  if (run_shiftl(I,SHIFT) /= RESL) call abort ; \
+  if (ishft(I,SHIFT) /= RESL) call abort ; \
+  if (ishft(I,-SHIFT) /= RESR) call abort ; \
+  if (run_ishft(I,SHIFT) /= RESL) call abort ; \
+  if (run_ishft(I,-SHIFT) /= RESR) call abort
+
+  CHECK(0_16,0,0_16,0_16,0_16)
+  CHECK(11_16,0,11_16,11_16,11_16)
+  CHECK(-11_16,0,-11_16,-11_16,-11_16)
+  CHECK(0_16,1,0_16,0_16,0_16)
+  CHECK(11_16,1,5_16,22_16,5_16)
+  CHECK(11_16,2,2_16,44_16,2_16)
+  CHECK(-11_16,1,-6_16,-22_16,huge(0_16)-5_16)
+
+contains
+
+  function run_shifta (i, shift) result(res)
+    integer(kind=16) :: i, res
+    integer :: shift
+    res = shifta(i,shift)
+  end function
+  function run_shiftl (i, shift) result(res)
+    integer(kind=16) :: i, res
+    integer :: shift
+    res = shiftl(i,shift)
+  end function
+  function run_shiftr (i, shift) result(res)
+    integer(kind=16) :: i, res
+    integer :: shift
+    res = shiftr(i,shift)
+  end function
+  function run_ishft (i, shift) result(res)
+    integer(kind=16) :: i, res
+    integer :: shift
+    res = ishft(i,shift)
+  end function
+
+end
diff --git a/gcc/testsuite/gfortran.dg/sibling_dummy_procedure_1.f90 b/gcc/testsuite/gfortran.dg/sibling_dummy_procedure_1.f90
new file mode 100644
index 000000000..c632c5b1b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/sibling_dummy_procedure_1.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! This checks the fix for PR 26041.
+!
+! Contributed by H.J. Lu  <hongjiu.lu@intel.com>
+module foo
+   public    bar_
+   interface bar_
+      module procedure bar
+   end interface
+   public    xxx_
+   interface xxx_
+      module procedure xxx
+   end interface
+contains
+   subroutine bar(self, z)
+      interface
+         function self(z) result(res)
+        real z
+            real(kind=kind(1.0d0)) :: res
+         end function
+      end interface
+   end subroutine
+   subroutine xxx(self,z)
+      interface
+         function self(z) result(res)
+        real z
+            real(kind=kind(1.0d0)) :: res
+         end function
+      end interface
+      call bar(self, z)
+   end subroutine
+end
+
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/sibling_dummy_procedure_2.f90 b/gcc/testsuite/gfortran.dg/sibling_dummy_procedure_2.f90
new file mode 100644
index 000000000..3bd316499
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/sibling_dummy_procedure_2.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! This checks the fix for PR 26041.
+!
+! Contributed by H.J. Lu  <hongjiu.lu@intel.com>
+module foo
+   public    bar_
+   interface bar_
+      module procedure bar
+   end interface
+   public    xxx_
+   interface xxx_
+      module procedure xxx
+   end interface
+contains
+   subroutine bar(self, z)
+      interface
+         function self(z) result(res)
+        real z
+            real(kind=kind(1.0d0)) :: res
+         end function
+      end interface
+   end subroutine
+   subroutine xxx(self,z)
+      interface
+         function self(z) result(res)
+        real z
+            real(kind=kind(1.0d0)) :: res
+         end function
+      end interface
+      call bar_(self, z)
+   end subroutine
+end
+
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/sibling_dummy_procedure_3.f90 b/gcc/testsuite/gfortran.dg/sibling_dummy_procedure_3.f90
new file mode 100644
index 000000000..21bdceead
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/sibling_dummy_procedure_3.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! This checks the fix for PR 26064
+!
+! Contributed by Sven Buijssen <sven.buijssen@math.uni-dortmund.de>
+module ice
+  implicit none
+  contains
+
+    subroutine foo()
+    contains
+
+      subroutine bar(baz)
+        integer, optional :: baz
+        if (present(baz)) then
+        endif
+      end subroutine bar
+    end subroutine foo
+end module
+
+! { dg-final { cleanup-modules "ice" } }
diff --git a/gcc/testsuite/gfortran.dg/simpleif_1.f90 b/gcc/testsuite/gfortran.dg/simpleif_1.f90
new file mode 100644
index 000000000..ee432ba90
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/simpleif_1.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! PR 17074
+! Verifies that FORALL and WHERE after a simple if work.
+DIMENSION ia(4,4)
+logical,dimension(4,4) :: index
+
+if (.true.) forall (i = 1:4, j = 1:4) ia(i,j) = 1
+if (any (ia.ne.1)) CALL abort()
+
+index(:,:)=.false.
+index(2,3) = .true.
+
+if (.true.) where (index) ia = 2
+if (ia(2,3).ne.2) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/simpleif_2.f90 b/gcc/testsuite/gfortran.dg/simpleif_2.f90
new file mode 100644
index 000000000..09c0d3804
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/simpleif_2.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! Test fix for regression caused by 
+! 2006-06-23  Steven G. Kargl  <kargls@comcast.net>
+!    PR fortran/27981
+!    * match.c (gfc_match_if):  Handle errors in assignment in simple if.
+!
+module read
+  integer i, j, k
+  contains
+    subroutine a
+      integer, parameter :: n = 2
+      if (i .eq. 0) read(j,*) k
+      if (i .eq. 0) n = j    ! { dg-error "Named constant 'n' in variable definition context" }
+    end subroutine a
+end module read
diff --git a/gcc/testsuite/gfortran.dg/simplify_argN_1.f90 b/gcc/testsuite/gfortran.dg/simplify_argN_1.f90
new file mode 100644
index 000000000..933b1f32a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/simplify_argN_1.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! Tests the fix for PR35780, in which the assignment for C was not
+! scalarized in expr.c.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+MODULE MODS
+  integer, parameter :: N = 10
+  INTEGER, PARAMETER, DIMENSION(N) ::  A = [(i, i = 1, N)]
+  INTEGER, PARAMETER, DIMENSION(N) ::  B = [(i - 5, i = 1, N)]
+  INTEGER, PARAMETER, DIMENSION(N)  :: C = ISHFTC(3, B, 5)   !ICE
+  INTEGER, PARAMETER, DIMENSION(N)  :: D = ISHFTC(A, 3, 5)   !  OK
+  INTEGER, PARAMETER, DIMENSION(N)  :: E = ISHFTC(A, B, 5)   !  OK
+
+END MODULE MODS
+
+  use mods
+  integer, dimension(N) :: X = A
+  integer, dimension(N) :: Y = B
+
+! Check the simplifed expressions against the library
+  if (any (ISHFTC(3, Y, 5) /= C)) call abort ()
+  if (any (ISHFTC(X, 3, 5) /= D)) call abort ()
+  if (any (ISHFTC(X, Y, 5) /= E)) call abort ()
+end
+! { dg-final { cleanup-modules "mods" } }
diff --git a/gcc/testsuite/gfortran.dg/simplify_modulo.f90 b/gcc/testsuite/gfortran.dg/simplify_modulo.f90
new file mode 100644
index 000000000..550a3adb9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/simplify_modulo.f90
@@ -0,0 +1,5 @@
+! { dg-do run }
+
+if (modulo (-8., -5.) .ne. -3.) call abort ()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/single_char_string.f90 b/gcc/testsuite/gfortran.dg/single_char_string.f90
new file mode 100644
index 000000000..479456cfe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/single_char_string.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+! PR12456 - Optimize string(k:k) as single character.
+
+Program pr12456
+character a
+character b
+character (len=5) :: c
+integer i
+
+b = 'a'
+a = b
+if (a .ne. 'a') call abort()
+if (a .ne. b) call abort()
+c (3:3) = 'a'
+if (c (3:3) .ne. b) call abort ()
+if (c (3:3) .ne. 'a') call abort ()
+if (LGT (a, c (3:3))) call abort ()
+if (LGT (a, 'a')) call abort ()
+
+i = 3
+c (i:i) = 'a'
+if (c (i:i) .ne. b) call abort ()
+if (c (i:i) .ne. 'a') call abort ()
+if (LGT (a, c (i:i))) call abort ()
+
+if (a .gt. char (255)) call abort ()
+end
+
+! There should not be _gfortran_compare_string and _gfortran_copy_string in
+! the dumped file.
+
+! { dg-final { scan-tree-dump-times "_gfortran_compare_string" 0 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_copy_string" 0 "original" } }
+
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/size_dim.f90 b/gcc/testsuite/gfortran.dg/size_dim.f90
new file mode 100644
index 000000000..9d3938ed0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/size_dim.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! Check size with initialization expression value for dim=
+! PR fortran/30882
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+program main
+  integer :: a(10)
+  call S1(a)
+contains
+  subroutine S1(a)
+    integer :: a(*)
+    if(size(a(1:10),1) /= 10) call abort()
+  end subroutine S1
+end program main
diff --git a/gcc/testsuite/gfortran.dg/size_kind.f90 b/gcc/testsuite/gfortran.dg/size_kind.f90
new file mode 100644
index 000000000..ee9cb8f24
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/size_kind.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+!
+! PR fortran/36153
+! Contributed by Jonathan Hogg
+! 
+program test_64
+   implicit none
+
+   integer, parameter :: long = selected_int_kind(18)
+   integer, parameter :: short = kind(0)
+
+   integer(long), parameter :: big_sz = huge(0_short)+1000_long
+   integer(long), parameter :: max_32 = huge(0_short)
+   integer, dimension(:), allocatable :: array
+
+   integer(long) :: i
+
+   print *, "2**31  = ", 2_long**31
+   print *, "max_32 = ", max_32
+   print *, "big_sz = ", big_sz
+
+! Disabled as it overflows on 32bit systems (at compile time)
+! (conversion of integer(8) to integer(4))
+!   allocate(array(big_sz))
+   print *, "sz = ", size(array)
+   print *, "sz = ", size(array, kind=long)
+end program
diff --git a/gcc/testsuite/gfortran.dg/size_optional_dim_1.f90 b/gcc/testsuite/gfortran.dg/size_optional_dim_1.f90
new file mode 100644
index 000000000..de5a739f5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/size_optional_dim_1.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! PR 30865 - passing a subroutine optional argument to size(dim=...)
+! used to segfault.
+program main
+  implicit none
+  integer :: a(2,3)
+  integer :: ires
+
+  call checkv (ires, a)
+  if (ires /= 6) call abort
+  call checkv (ires, a, 1)
+  if (ires /= 2) call abort
+contains
+  subroutine checkv(ires,a1,opt1)
+    integer, intent(out) :: ires
+    integer :: a1(:,:)
+    integer, optional :: opt1
+
+    ires = size (a1, dim=opt1)
+  end subroutine checkv
+end program main
diff --git a/gcc/testsuite/gfortran.dg/sizeof.f90 b/gcc/testsuite/gfortran.dg/sizeof.f90
new file mode 100644
index 000000000..fbe6b868f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/sizeof.f90
@@ -0,0 +1,88 @@
+! { dg-do run }
+! Verify that the sizeof intrinsic does as advertised
+subroutine check_int (j)
+  INTEGER(4) :: i, ia(5), ib(5,4), ip, ipa(:)
+  target :: ib
+  POINTER :: ip, ipa
+  logical :: l(6)
+  integer(8) :: jb(5,4)
+
+  if (sizeof (jb) /= 2*sizeof (ib)) call abort
+
+  if (sizeof(j) == 4) then
+     if (sizeof (j) /= sizeof (i)) call abort
+  else
+     if (sizeof (j) /= 2 * sizeof (i)) call abort
+  end if
+
+  ipa=>ib(2:3,1)
+
+  l = (/ sizeof(i) == 4, sizeof(ia) == 20, sizeof(ib) == 80, &
+       sizeof(ip) == 4, sizeof(ipa) == 8, sizeof(ib(1:5:2,3)) == 12 /)
+
+  if (any(.not.l)) call abort
+
+  if (sizeof(l) /= 6*sizeof(l(1))) call abort
+end subroutine check_int
+
+subroutine check_real (x, y)
+  dimension y(5)
+  real(4) :: r(20,20,20), rp(:,:)
+  target :: r
+  pointer :: rp
+  double precision :: d(5,5)
+  complex(kind=4) :: c(5)
+
+  if (sizeof (y) /= 5*sizeof (x)) call abort
+
+  if (sizeof (r) /= 8000*4) call abort
+  rp => r(5,2:10,1:5)
+  if (sizeof (rp) /= 45*4) call abort
+  rp => r(1:5,1:5,1)
+  if (sizeof (d) /= 2*sizeof (rp)) call abort
+  if (sizeof (c(1)) /= 2*sizeof(r(1,1,1))) call abort
+end subroutine check_real
+
+subroutine check_derived ()
+  type dt
+     integer i
+  end type dt
+  type (dt) :: a
+  integer :: i
+  type foo
+     integer :: i(5000)
+     real :: j(5)
+     type(dt) :: d
+  end type foo
+  type bar
+     integer :: j(5000)
+     real :: k(5)
+     type(dt) :: d
+  end type bar
+  type (foo) :: oof
+  type (bar) :: rab
+  integer(8) :: size_500, size_200, sizev500, sizev200
+  type all
+     real, allocatable :: r(:)
+  end type all
+  real :: r(200), s(500)
+  type(all) :: v
+
+  if (sizeof(a) /= sizeof(i)) call abort
+  if (sizeof(oof) /= sizeof(rab)) call abort
+  allocate (v%r(500))
+  sizev500 = sizeof (v)
+  size_500 = sizeof (v%r)
+  deallocate (v%r)
+  allocate (v%r(200))
+  sizev200 = sizeof (v)
+  size_200 = sizeof (v%r)
+  deallocate (v%r)
+  if (size_500 - size_200 /= sizeof(s) - sizeof(r) .or. sizev500 /= sizev200) &
+       call abort
+end subroutine check_derived
+
+call check_int (1)
+call check_real (1.0, (/1.0, 2.0, 3.0, 4.0, 5.0/))
+call check_derived ()
+end
diff --git a/gcc/testsuite/gfortran.dg/slash_1.f90 b/gcc/testsuite/gfortran.dg/slash_1.f90
new file mode 100644
index 000000000..d4a59a31a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/slash_1.f90
@@ -0,0 +1,13 @@
+! PR libfortran/22170
+! { dg-do run }
+  integer i
+  open (10,status='scratch')
+  write (10,'(A,2/,A)') '12', '17'
+  rewind (10)
+  read (10,'(I2)') i
+  if (i /= 12) call abort
+  read (10,'(I2)') i
+  if (i /= 0) call abort
+  read (10,'(I2)') i
+  if (i /= 17) call abort
+  end
diff --git a/gcc/testsuite/gfortran.dg/sms-1.f90 b/gcc/testsuite/gfortran.dg/sms-1.f90
new file mode 100644
index 000000000..754cb8cae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/sms-1.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+! { dg-options "-O2 -fmodulo-sched" }
+! This testcase related to INC instruction which is
+! currently not supported in SMS. 
+program main
+  integer (kind = 8) :: i, l8, u8, step8
+  integer (kind = 4) :: l4, step4
+  integer (kind = 8), parameter :: big = 10000000000_8
+
+  u8 = big * 40 + 200
+  l4 = 200
+  step8 = -big
+  call test ((/ (i, i = u8, l4, step8) /), u8, l4 + 0_8, step8)
+contains
+  subroutine test (a, l, u, step)
+    integer (kind = 8), dimension (:), intent (in) :: a
+    integer (kind = 8), intent (in) :: l, u, step
+    integer (kind = 8) :: i
+    integer :: j
+
+    j = 1
+    do i = l, u, step
+      if (a (j) .ne. i) call abort
+      j = j + 1
+    end do
+    if (size (a, 1) .ne. j - 1) call abort
+  end subroutine test
+end program main
+
+
diff --git a/gcc/testsuite/gfortran.dg/sms-2.f90 b/gcc/testsuite/gfortran.dg/sms-2.f90
new file mode 100644
index 000000000..80ab9bf49
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/sms-2.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-options "-O2 -fmodulo-sched" }
+! This testcase related to wrong order within a cycle fix.
+!
+program foo 
+  real, dimension (5, 5, 5, 5) :: a
+
+  a (:, :, :,  :)  = 4
+  a (:, 2, :, 4) = 10
+  a (:, 2, :, 1) = 0
+
+  forall (i = 1:5, i == 3) 
+     a(i, i, i, i) = -5
+   end forall
+
+  if (sum (a) .ne. 2541.0) call abort ()
+end
+
+
diff --git a/gcc/testsuite/gfortran.dg/spec_expr_1.f90 b/gcc/testsuite/gfortran.dg/spec_expr_1.f90
new file mode 100644
index 000000000..61591c311
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spec_expr_1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! PR 20323
+! We didn't verify that character length expressions are specification
+! expressions.
+function testpresent(arg) 
+   integer, intent(in), optional :: arg 
+   character(len=arg) :: s ! { dg-error "OPTIONAL" }
+   logical :: testpresent 
+ 
+   testpresent=.true. 
+ 
+end function testpresent 
diff --git a/gcc/testsuite/gfortran.dg/spec_expr_2.f90 b/gcc/testsuite/gfortran.dg/spec_expr_2.f90
new file mode 100644
index 000000000..5b0500d73
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spec_expr_2.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! PR 22273: Allow INTENT(OUT) dummy:s as arguments to LEN() in specification
+! expr:s
+subroutine lecligne (ligne)
+    character(len=*), intent(out) :: ligne
+    character(len=len(ligne)) :: comment
+end subroutine lecligne
diff --git a/gcc/testsuite/gfortran.dg/spec_expr_3.f90 b/gcc/testsuite/gfortran.dg/spec_expr_3.f90
new file mode 100644
index 000000000..27687e5d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spec_expr_3.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! PR fortran/18271
+subroutine sub(imax)
+  implicit none
+  integer, intent(in) :: imax
+  real :: aux1(25000+int(0.82*imax))
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/spec_expr_4.f90 b/gcc/testsuite/gfortran.dg/spec_expr_4.f90
new file mode 100644
index 000000000..cf655b920
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spec_expr_4.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! Tests the fix for PR27709 in which the specification expression on
+! line 22 was not resolved because of the multiple component references.
+!
+! Contributed by David Ham  <David@ham.dropbear.id.au>
+!
+module elements
+  implicit none
+  type element_type
+     type(ele_numbering_type), pointer :: numbering
+  end type element_type
+  type ele_numbering_type
+     integer, dimension(:,:), pointer :: number2count
+  end type ele_numbering_type
+end module elements
+module global_numbering
+  use elements
+  implicit none
+contains
+  function element_local_coords(element) result (coords)
+    type(element_type), intent(in) :: element    
+    real, dimension(size(element%numbering%number2count, 1)) :: coords
+    coords=0.0 
+  end function element_local_coords
+end module global_numbering
+
+  use global_numbering
+  type (element_type) :: e
+  type (ele_numbering_type), target :: ent
+  allocate (ent%number2count (2,2))
+  e%numbering => ent
+  print *, element_local_coords (e)
+end
+! { dg-final { cleanup-modules "elements global_numbering" } }
diff --git a/gcc/testsuite/gfortran.dg/spec_expr_5.f90 b/gcc/testsuite/gfortran.dg/spec_expr_5.f90
new file mode 100644
index 000000000..819038348
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spec_expr_5.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! PR 33689
+! Wrongly rejected valid code due to non-trivial expression for array bound
+ subroutine grylmr()
+    integer, parameter :: lmaxd = 20
+    REAL, save :: c(0:(lmaxd+1)*(lmaxd+1))
+  end subroutine grylmr
+end
diff --git a/gcc/testsuite/gfortran.dg/spec_expr_6.f90 b/gcc/testsuite/gfortran.dg/spec_expr_6.f90
new file mode 100644
index 000000000..3b5b973ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spec_expr_6.f90
@@ -0,0 +1,52 @@
+! { dg-do compile }
+!
+! PR fortran/43591
+!
+! Pureness check for TPB/PPC in specification expressions
+!
+! Based on a test case of Thorsten Ohl
+!
+!
+
+module m
+  implicit none
+  type t
+     procedure(p1_type), nopass, pointer :: p1 => NULL()
+  contains
+     procedure, nopass :: tbp => p1_type
+  end type t
+contains
+  subroutine proc (t1, t2)
+    type(t), intent(in) :: t1, t2
+    integer, dimension(t1%p1(), t2%tbp()) :: table
+  end subroutine proc
+  pure function p1_type()
+   integer :: p1_type
+   p1_type = 42
+  end function p1_type
+  pure subroutine p(t1)
+    type(t), intent(inout) :: t1
+    integer :: a(t1%p1())
+  end subroutine p
+end module m
+
+module m2
+  implicit none
+  type t
+     procedure(p1_type), nopass, pointer :: p1 => NULL()
+  contains
+     procedure, nopass :: tbp => p1_type
+  end type t
+contains
+  subroutine proc (t1, t2)
+    type(t), intent(in) :: t1, t2
+    integer, dimension(t1%p1()) :: table1 ! { dg-error "must be PURE" }
+    integer, dimension(t2%tbp()) :: table2 ! { dg-error "must be PURE" }
+  end subroutine proc
+  function p1_type()
+    integer :: p1_type
+    p1_type = 42
+  end function p1_type
+end module m2
+
+! { dg-final { cleanup-modules "m m2" } }
diff --git a/gcc/testsuite/gfortran.dg/specification_type_resolution_1.f90 b/gcc/testsuite/gfortran.dg/specification_type_resolution_1.f90
new file mode 100644
index 000000000..b830b5dfc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/specification_type_resolution_1.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! Test of the fix of PR27089, where gfortran was unable to resolve the
+! type of n_elements_uncommon_with_ in the specification expression on
+! line 21.
+!
+! Test extracted from vec{int}.F90 of tonto.
+!
+module test
+   public    n_elements_uncommon_with_
+   interface n_elements_uncommon_with_
+      module procedure n_elements_uncommon_with
+   end interface
+contains
+   pure function n_elements_uncommon_with(x) result(res)
+      integer(4), dimension(:), intent(in) :: x
+      integer(4) :: res
+      res = size (x, 1)
+   end function
+   pure function elements_uncommon_with(x) result(res)
+      integer(4), dimension(:), intent(in) :: x
+      integer(4), dimension(n_elements_uncommon_with_(x)) :: res
+      res = x
+   end function
+end module test
+   use test
+   integer(4) :: z(4)
+   z = 1
+   print *, elements_uncommon_with (z)
+   print *, n_elements_uncommon_with_ (z)
+end
+! { dg-final { cleanup-modules "test" } }
diff --git a/gcc/testsuite/gfortran.dg/specification_type_resolution_2.f90 b/gcc/testsuite/gfortran.dg/specification_type_resolution_2.f90
new file mode 100644
index 000000000..0fcb7bd87
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/specification_type_resolution_2.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! Tests the fix for PR30283 in which the type of the result
+! of bar was getting lost
+
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+
+module gfcbug50
+  implicit none
+contains
+
+  subroutine foo (n, y)
+    integer, intent(in)         :: n
+    integer, dimension(bar (n)) :: y
+    ! Array bound is specification expression, which is allowed (F2003, sect.7.1.6)
+  end subroutine foo
+
+  pure function bar (n) result (l)
+    integer, intent(in) :: n
+    integer             :: l
+    l = n
+  end function bar
+
+end module gfcbug50
+
+! { dg-final { cleanup-modules "gfcbug50" } }
diff --git a/gcc/testsuite/gfortran.dg/specifics_1.f90 b/gcc/testsuite/gfortran.dg/specifics_1.f90
new file mode 100644
index 000000000..8970607db
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/specifics_1.f90
@@ -0,0 +1,318 @@
+! Program to test intrinsic functions as actual arguments
+!
+! Copied from gfortran.fortran-torture/execute/specifics.f90
+! Please keep them in sync
+!
+! It is run here with -ff2c option
+!
+! { dg-do run }
+! { dg-options "-ff2c" }
+! Program to test intrinsic functions as actual arguments
+subroutine test_c(fn, val, res)
+  complex fn
+  complex val, res
+
+  if (diff(fn(val),res)) call abort
+contains
+function diff(a,b)
+  complex a,b
+  logical diff
+  diff = (abs(a - b) .gt. 0.00001)
+end function
+end subroutine 
+
+subroutine test_z(fn, val, res)
+  double complex fn
+  double complex val, res
+
+  if (diff(fn(val),res)) call abort
+contains
+function diff(a,b)
+  double complex a,b
+  logical diff
+  diff = (abs(a - b) .gt. 0.00001)
+end function
+end subroutine 
+
+subroutine test_cabs(fn, val, res)
+  real fn, res
+  complex val
+
+  if (diff(fn(val),res)) call abort
+contains
+function diff(a,b)
+  real a,b
+  logical diff
+  diff = (abs(a - b) .gt. 0.00001)
+end function
+end subroutine 
+
+subroutine test_cdabs(fn, val, res)
+  double precision fn, res
+  double complex val
+
+  if (diff(fn(val),res)) call abort
+contains
+function diff(a,b)
+  double precision a,b
+  logical diff
+  diff = (abs(a - b) .gt. 0.00001)
+end function
+end subroutine 
+
+subroutine test_r(fn, val, res)
+  real fn
+  real val, res
+
+  if (diff(fn(val), res)) call abort
+contains
+function diff(a, b)
+  real a, b
+  logical diff
+  diff = (abs(a - b) .gt. 0.00001)
+end function
+end subroutine
+
+subroutine test_d(fn, val, res)
+  double precision fn
+  double precision val, res
+
+  if (diff(fn(val), res)) call abort
+contains
+function diff(a, b)
+  double precision a, b
+  logical diff
+  diff = (abs(a - b) .gt. 0.00001d0)
+end function
+end subroutine
+
+subroutine test_r2(fn, val1, val2, res)
+  real fn
+  real val1, val2, res
+
+  if (diff(fn(val1, val2), res)) call abort
+contains
+function diff(a, b)
+  real a, b
+  logical diff
+  diff = (abs(a - b) .gt. 0.00001)
+end function
+end subroutine
+
+subroutine test_d2(fn, val1, val2, res)
+  double precision fn
+  double precision val1, val2, res
+
+  if (diff(fn(val1, val2), res)) call abort
+contains
+function diff(a, b)
+  double precision a, b
+  logical diff
+  diff = (abs(a - b) .gt. 0.00001d0)
+end function
+end subroutine
+
+subroutine test_dprod(fn)
+  double precision fn
+  if (abs (fn (2.0, 3.0) - 6d0) .gt. 0.00001) call abort
+end subroutine
+
+subroutine test_nint(fn,val,res)
+  integer fn, res
+  real val
+  if (res .ne. fn(val)) call abort
+end subroutine
+
+subroutine test_idnint(fn,val,res)
+  integer fn, res
+  double precision val
+  if (res .ne. fn(val)) call abort
+end subroutine
+
+subroutine test_idim(fn,val1,val2,res)
+  integer fn, res, val1, val2
+  if (res .ne. fn(val1,val2)) call abort
+end subroutine
+
+subroutine test_iabs(fn,val,res)
+  integer fn, res, val
+  if (res .ne. fn(val)) call abort
+end subroutine
+
+subroutine test_len(fn,val,res)
+  integer fn, res
+  character(len=*) val
+  if (res .ne. fn(val)) call abort
+end subroutine
+
+subroutine test_index(fn,val1,val2,res)
+  integer fn, res
+  character(len=*) val1, val2
+  if (fn(val1,val2) .ne. res) call abort
+end subroutine
+
+program specifics
+  intrinsic abs
+  intrinsic aint
+  intrinsic anint
+  intrinsic acos
+  intrinsic acosh
+  intrinsic asin
+  intrinsic asinh
+  intrinsic atan
+  intrinsic atanh
+  intrinsic cos
+  intrinsic sin
+  intrinsic tan
+  intrinsic cosh
+  intrinsic sinh
+  intrinsic tanh
+  intrinsic alog
+  intrinsic alog10
+  intrinsic exp
+  intrinsic sign
+  intrinsic isign
+  intrinsic amod
+
+  intrinsic dabs
+  intrinsic dint
+  intrinsic dnint
+  intrinsic dacos
+  intrinsic dacosh
+  intrinsic dasin
+  intrinsic dasinh
+  intrinsic datan
+  intrinsic datanh
+  intrinsic dcos
+  intrinsic dsin
+  intrinsic dtan
+  intrinsic dcosh
+  intrinsic dsinh
+  intrinsic dtanh
+  intrinsic dlog
+  intrinsic dlog10
+  intrinsic dexp
+  intrinsic dsign
+  intrinsic dmod
+
+  intrinsic conjg
+  intrinsic ccos
+  intrinsic cexp
+  intrinsic clog
+  intrinsic csin
+  intrinsic csqrt
+
+  intrinsic dconjg
+  intrinsic cdcos
+  intrinsic cdexp
+  intrinsic cdlog
+  intrinsic cdsin
+  intrinsic cdsqrt
+  intrinsic zcos
+  intrinsic zexp
+  intrinsic zlog
+  intrinsic zsin
+  intrinsic zsqrt
+
+  intrinsic cabs
+  intrinsic cdabs
+  intrinsic zabs
+
+  intrinsic dprod
+
+  intrinsic nint
+  intrinsic idnint
+  intrinsic dim
+  intrinsic ddim
+  intrinsic idim
+  intrinsic iabs
+  intrinsic mod
+  intrinsic len
+  intrinsic index
+
+  intrinsic aimag
+  intrinsic dimag
+
+  call test_r (abs, -1.0, abs(-1.0))
+  call test_r (aint, 1.7, aint(1.7))
+  call test_r (anint, 1.7, anint(1.7))
+  call test_r (acos, 0.5, acos(0.5))
+  call test_r (acosh, 1.5, acosh(1.5))
+  call test_r (asin, 0.5, asin(0.5))
+  call test_r (asinh, 0.5, asinh(0.5))
+  call test_r (atan, 0.5, atan(0.5))
+  call test_r (atanh, 0.5, atanh(0.5))
+  call test_r (cos, 1.0, cos(1.0))
+  call test_r (sin, 1.0, sin(1.0))
+  call test_r (tan, 1.0, tan(1.0))
+  call test_r (cosh, 1.0, cosh(1.0))
+  call test_r (sinh, 1.0, sinh(1.0))
+  call test_r (tanh, 1.0, tanh(1.0))
+  call test_r (alog, 2.0, alog(2.0))
+  call test_r (alog10, 2.0, alog10(2.0))
+  call test_r (exp, 1.0, exp(1.0))
+  call test_r2 (sign, 1.0, -2.0, sign(1.0, -2.0))
+  call test_r2 (amod, 3.5, 2.0, amod(3.5, 2.0))
+  
+  call test_d (dabs, -1d0, abs(-1d0))
+  call test_d (dint, 1.7d0, 1d0)
+  call test_d (dnint, 1.7d0, 2d0)
+  call test_d (dacos, 0.5d0, dacos(0.5d0))
+  call test_d (dacosh, 1.5d0, dacosh(1.5d0))
+  call test_d (dasin, 0.5d0, dasin(0.5d0))
+  call test_d (dasinh, 0.5d0, dasinh(0.5d0))
+  call test_d (datan, 0.5d0, datan(0.5d0))
+  call test_d (datanh, 0.5d0, datanh(0.5d0))
+  call test_d (dcos, 1d0, dcos(1d0))
+  call test_d (dsin, 1d0, dsin(1d0))
+  call test_d (dtan, 1d0, dtan(1d0))
+  call test_d (dcosh, 1d0, dcosh(1d0))
+  call test_d (dsinh, 1d0, dsinh(1d0))
+  call test_d (dtanh, 1d0, dtanh(1d0))
+  call test_d (dlog, 2d0, dlog(2d0))
+  call test_d (dlog10, 2d0, dlog10(2d0))
+  call test_d (dexp, 1d0, dexp(1d0))
+  call test_d2 (dsign, 1d0, -2d0, sign(1d0, -2d0))
+  call test_d2 (dmod, 3.5d0, 2d0, dmod(3.5d0, 2d0))
+
+  call test_dprod (dprod)
+
+  call test_c (conjg, (1.2,-4.), conjg((1.2,-4.)))
+  call test_c (ccos, (1.2,-4.), ccos((1.2,-4.)))
+  call test_c (cexp, (1.2,-4.), cexp((1.2,-4.)))
+  call test_c (clog, (1.2,-4.), clog((1.2,-4.)))
+  call test_c (csin, (1.2,-4.), csin((1.2,-4.)))
+  call test_c (csqrt, (1.2,-4.), csqrt((1.2,-4.)))
+
+  call test_z (dconjg, (1.2d0,-4.d0), dconjg((1.2d0,-4.d0)))
+  call test_z (cdcos, (1.2d0,-4.d0), cdcos((1.2d0,-4.d0)))
+  call test_z (zcos, (1.2d0,-4.d0), zcos((1.2d0,-4.d0)))
+  call test_z (cdexp, (1.2d0,-4.d0), cdexp((1.2d0,-4.d0)))
+  call test_z (zexp, (1.2d0,-4.d0), zexp((1.2d0,-4.d0)))
+  call test_z (cdlog, (1.2d0,-4.d0), cdlog((1.2d0,-4.d0)))
+  call test_z (zlog, (1.2d0,-4.d0), zlog((1.2d0,-4.d0)))
+  call test_z (cdsin, (1.2d0,-4.d0), cdsin((1.2d0,-4.d0)))
+  call test_z (zsin, (1.2d0,-4.d0), zsin((1.2d0,-4.d0)))
+  call test_z (cdsqrt, (1.2d0,-4.d0), cdsqrt((1.2d0,-4.d0)))
+  call test_z (zsqrt, (1.2d0,-4.d0), zsqrt((1.2d0,-4.d0)))
+
+  call test_cabs (cabs, (1.2,-4.), cabs((1.2,-4.)))
+  call test_cdabs (cdabs, (1.2d0,-4.d0), cdabs((1.2d0,-4.d0)))
+  call test_cdabs (zabs, (1.2d0,-4.d0), zabs((1.2d0,-4.d0)))
+  call test_cabs (aimag, (1.2,-4.), aimag((1.2,-4.)))
+  call test_cdabs (dimag, (1.2d0,-4.d0), dimag((1.2d0,-4.d0)))
+
+  call test_nint (nint, -1.2, nint(-1.2))
+  call test_idnint (idnint, -1.2d0, idnint(-1.2d0))
+  call test_idim (isign, -42, 17, isign(-42, 17))
+  call test_idim (idim, -42, 17, idim(-42,17))
+  call test_idim (idim, 42, 17, idim(42,17))
+  call test_r2 (dim, 1.2, -4., dim(1.2, -4.))
+  call test_d2 (ddim, 1.2d0, -4.d0, ddim(1.2d0, -4.d0))
+  call test_iabs (iabs, -7, iabs(-7))
+  call test_idim (mod, 5, 2, mod(5,2))
+  call test_len (len, "foobar", len("foobar"))
+  call test_index (index, "foobarfoobar", "bar", index("foobarfoobar","bar"))
+
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/specifics_2.f90 b/gcc/testsuite/gfortran.dg/specifics_2.f90
new file mode 100644
index 000000000..4de092564
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/specifics_2.f90
@@ -0,0 +1,81 @@
+! { dg-do compile }
+! This is the list of intrinsics allowed as actual arguments
+ intrinsic abs,acos,acosh,aimag,aint,alog,alog10,amod,anint,asin,asinh,atan,&
+ atan2,atanh,cabs,ccos,cexp,clog,conjg,cos,cosh,csin,csqrt,dabs,dacos,&
+ dacosh,dasin,dasinh,datan,datan2,datanh,dconjg,dcos,dcosh,ddim,dexp,dim,&
+ dimag,dint,dlog,dlog10,dmod,dnint,dprod,dsign,dsin,dsinh,dsqrt,dtan,dtanh,&
+ exp,iabs,idim,idnint,index,isign,len,mod,nint,sign,sin,sinh,sqrt,tan,&
+ tanh,zabs,zcos,zexp,zlog,zsin,zsqrt
+ 
+  call foo(abs)
+  call foo(acos)
+  call foo(acosh)
+  call foo(aimag)
+  call foo(aint)
+  call foo(alog)
+  call foo(alog10)
+  call foo(amod)
+  call foo(anint)
+  call foo(asin)
+  call foo(asinh)
+  call foo(atan)
+  call foo(atan2)
+  call foo(atanh)
+  call foo(cabs)
+  call foo(ccos)
+  call foo(cexp)
+  call foo(clog)
+  call foo(conjg)
+  call foo(cos)
+  call foo(cosh)
+  call foo(csin)
+  call foo(csqrt)
+  call foo(dabs)
+  call foo(dacos)
+  call foo(dacosh)
+  call foo(dasin)
+  call foo(dasinh)
+  call foo(datan)
+  call foo(datan2)
+  call foo(datanh)
+  call foo(dconjg)
+  call foo(dcos)
+  call foo(dcosh)
+  call foo(ddim)
+  call foo(dexp)
+  call foo(dim)
+  call foo(dimag)
+  call foo(dint)
+  call foo(dlog)
+  call foo(dlog10)
+  call foo(dmod)
+  call foo(dnint)
+  call foo(dprod)
+  call foo(dsign)
+  call foo(dsin)
+  call foo(dsinh)
+  call foo(dsqrt)
+  call foo(dtan)
+  call foo(dtanh)
+  call foo(exp)
+  call foo(iabs)
+  call foo(idim)
+  call foo(idnint)
+  call foo(index)
+  call foo(isign)
+  call foo(len)
+  call foo(mod)
+  call foo(nint)
+  call foo(sign)
+  call foo(sin)
+  call foo(sinh)
+  call foo(sqrt)
+  call foo(tan)
+  call foo(tanh)
+  call foo(zabs)
+  call foo(zcos)
+  call foo(zexp)
+  call foo(zlog)
+  call foo(zsin)
+  call foo(zsqrt)
+  end
diff --git a/gcc/testsuite/gfortran.dg/spread_bounds_1.f90 b/gcc/testsuite/gfortran.dg/spread_bounds_1.f90
new file mode 100644
index 000000000..7e5bc651f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spread_bounds_1.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect extent in return value of SPREAD intrinsic in dimension 2: is 3, should be 2" }
+program main
+  integer :: source(2), target(2,3)
+  data source /1,2/
+  integer :: times
+  times = 2
+  target = spread(source,2,times)
+end program main
+! { dg-output "Fortran runtime error:  Incorrect extent in return value of SPREAD intrinsic in dimension 2: is 3, should be 2"
+
diff --git a/gcc/testsuite/gfortran.dg/spread_init_expr.f03 b/gcc/testsuite/gfortran.dg/spread_init_expr.f03
new file mode 100644
index 000000000..05714f623
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spread_init_expr.f03
@@ -0,0 +1,17 @@
+! { dg-do run }
+
+  INTEGER, PARAMETER :: n = 5
+  INTEGER, PARAMETER :: a1(n) = SPREAD(1, 1, n)
+  INTEGER, PARAMETER :: a2(n, 3) = SPREAD([1,2,3], DIM=1, NCOPIES=n)
+  INTEGER, PARAMETER :: a3(3, n) = SPREAD([1,2,3], DIM=2, NCOPIES=n)
+
+  IF (ANY(a1 /= [ 1, 1, 1, 1, 1 ])) CALL abort()
+
+  IF (ANY(a2(:, 1) /= 1)) CALL abort()
+  IF (ANY(a2(:, 2) /= 2)) CALL abort()
+  IF (ANY(a2(:, 3) /= 3)) CALL abort()
+
+  IF (ANY(a3(1, :) /= 1)) CALL abort()
+  IF (ANY(a3(2, :) /= 2)) CALL abort()
+  IF (ANY(a3(3, :) /= 3)) CALL abort()
+END
diff --git a/gcc/testsuite/gfortran.dg/spread_scalar_source.f90 b/gcc/testsuite/gfortran.dg/spread_scalar_source.f90
new file mode 100644
index 000000000..118a2de6e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spread_scalar_source.f90
@@ -0,0 +1,52 @@
+! { dg-do run }
+! { dg-options "-O0" }
+
+  character*1 :: i, j(10)
+  character*8 :: buffer
+  integer(kind=1) :: ii, jj(10)
+  type :: mytype
+    real(kind=8) :: x
+    integer(kind=1) :: i
+    character*15 :: ch
+  end type mytype
+  type(mytype) :: iii, jjj(10)
+
+  i = "w"
+  ii = 42
+  iii = mytype (41.9999_8, 77, "test_of_spread_")
+
+! Test constant sources.
+
+  j = spread ("z", 1 , 10)
+  if (any (j /= "z")) call abort ()
+  jj = spread (19, 1 , 10)
+  if (any (jj /= 19)) call abort ()
+
+! Test variable sources.
+
+  j = spread (i, 1 , 10)
+  if (any (j /= "w")) call abort ()
+  jj = spread (ii, 1 , 10)
+  if (any (jj /= 42)) call abort ()
+  jjj = spread (iii, 1 , 10)
+  if (any (jjj%x /= 41.9999_8)) call abort ()
+  if (any (jjj%i /= 77)) call abort ()
+  if (any (jjj%ch /= "test_of_spread_")) call abort ()
+
+! Check that spread != 1 is OK.
+
+  jj(2:10:2) = spread (1, 1, 5)
+  if (any (jj(1:9:2) /= 42) .or. any (jj(2:10:2) /= 1)) call abort ()
+
+! Finally, check that temporaries and trans-io.c work correctly.
+
+  write (buffer, '(4a1)') spread (i, 1 , 4)
+  if (trim(buffer) /= "wwww") call abort ()
+  write (buffer, '(4a1)') spread ("r", 1 , 4)
+  if (trim(buffer) /= "rrrr") call abort ()
+  write (buffer, '(4i2)') spread (ii, 1 , 4)
+  if (trim(buffer) /= "42424242") call abort ()
+  write (buffer, '(4i2)') spread (31, 1 , 4)
+  if (trim(buffer) /= "31313131") call abort ()
+
+  end
diff --git a/gcc/testsuite/gfortran.dg/spread_shape_1.f90 b/gcc/testsuite/gfortran.dg/spread_shape_1.f90
new file mode 100644
index 000000000..650584ecf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spread_shape_1.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! Tests the fix for PR29060 in which the shape of the result
+! of SPREAD was not available to the scalarizer.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+  real,dimension(:, :),pointer :: ptr
+  real,dimension(2, 2) :: u
+
+  u = reshape((/0.25, 0.5, 0.75, 1.00/),(/2,2/))
+  
+  allocate (ptr(2,2))
+
+! Original PR
+  ptr(:, :) = u + spread ((/1.0, 2.0/), 2, size(u, 2))
+  if (any (ptr .ne. &
+        reshape ((/1.25, 2.50, 1.75, 3.00/), (/2, 2/)))) call abort ()
+
+! Check that the fix works correctly with the source shape after ncopies
+  ptr(:, :) = u + spread ((/2.0, 3.0/), 1, size (u, 1))
+  if (any (ptr .ne. &
+        reshape ((/2.25, 2.50, 3.75, 4.00/), (/2,2/)))) call abort ()
+end
diff --git a/gcc/testsuite/gfortran.dg/spread_size_limit.f90 b/gcc/testsuite/gfortran.dg/spread_size_limit.f90
new file mode 100644
index 000000000..62bc7a4a3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spread_size_limit.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for PR40472 in which simplify_spread had mo limit on the
+! siz that it would try to expand to.
+!
+! Contributed by Philippe Marguinaud <philippe.marguinaud@meteo.fr>
+!
+REAL, DIMENSION(720,360)          :: ZLON_MASK
+ZLON_MASK(:,:)= SPREAD( (/ (JLON , JLON=1,720) /) , DIM=2, NCOPIES=360 )
+print *, zlon_mask(100,100)
+END
+! { dg-final { scan-tree-dump-times "_gfortran_spread" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/spread_zerosize_1.f90 b/gcc/testsuite/gfortran.dg/spread_zerosize_1.f90
new file mode 100644
index 000000000..98a28484c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spread_zerosize_1.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+! PR 33298 - zero-sized arrays for spread were handled
+!            incorrectly.
+
+program main
+  real :: x(0,3), y(0)
+  x = spread(y,2,3)
+end
diff --git a/gcc/testsuite/gfortran.dg/stat_1.f90 b/gcc/testsuite/gfortran.dg/stat_1.f90
new file mode 100644
index 000000000..95ad66a39
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/stat_1.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! { dg-skip-if "" { *-*-mingw* spu-*-* } { "*" } { "" } }
+! { dg-options "-std=gnu" }
+  character(len=*), parameter :: f = "testfile"
+  integer :: s1(13), r1, s2(13), r2, s3(13), r3, d(13), rd
+  
+  open (10,file=f)
+  write (10,"(A)") "foo"
+  close (10,status="keep")
+
+  open (10,file=f)
+  call lstat (f, s1, r1)
+  call stat (f, s2, r2)
+  call fstat (10, s3, r3)
+  call stat (".", d, rd)
+
+  if (r1 /= 0 .or. r2 /= 0 .or. r3 /= 0 .or. rd /= 0) call abort
+  if (any (s1 /= s2) .or. any (s1 /= s3)) call abort
+  if (s1(5) /= getuid()) call abort
+! If the test is run in a directory with the sgid bit set or on a filesystem
+! mounted with the grpid option, new files are created with the directory's
+! gid instead of the user's primary gid, so allow for that.
+  if (s1(6) /= getgid() .and. s1(6) /= d(6) .and. getgid() /= 0) call abort
+  if (s1(8) < 3 .or. s1(8) > 5) call abort
+
+  close (10,status="delete")
+  end
diff --git a/gcc/testsuite/gfortran.dg/stat_2.f90 b/gcc/testsuite/gfortran.dg/stat_2.f90
new file mode 100644
index 000000000..a530ec347
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/stat_2.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! { dg-skip-if "" { *-*-mingw* spu-*-* } { "*" } { "" } }
+! { dg-options "-std=gnu" }
+  character(len=*), parameter :: f = "testfile"
+  integer :: s1(13), r1, s2(13), r2, s3(13), r3, d(13), rd
+  
+  open (10,file=f)
+  write (10,"(A)") "foo"
+  close (10,status="keep")
+
+  open (10,file=f)
+  r1 = lstat (f, s1)
+  r2 = stat (f, s2)
+  r3 = fstat (10, s3)
+  rd = stat (".", d)
+
+  if (r1 /= 0 .or. r2 /= 0 .or. r3 /= 0 .or. rd /= 0) call abort
+  if (any (s1 /= s2) .or. any (s1 /= s3)) call abort
+  if (s1(5) /= getuid()) call abort
+! If the test is run in a directory with the sgid bit set or on a filesystem
+! mounted with the grpid option, new files are created with the directory's
+! gid instead of the user's primary gid, so allow for that.
+  if (s1(6) /= getgid() .and. s1(6) /= d(6) .and. getgid() /= 0) call abort
+  if (s1(8) < 3 .or. s1(8) > 5) call abort
+
+  close (10,status="delete")
+  end
diff --git a/gcc/testsuite/gfortran.dg/static_linking_1.c b/gcc/testsuite/gfortran.dg/static_linking_1.c
new file mode 100644
index 000000000..e7d266d68
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/static_linking_1.c
@@ -0,0 +1,6 @@
+extern void f_(void);
+int main (void)
+{
+  f_();
+  return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/static_linking_1.f b/gcc/testsuite/gfortran.dg/static_linking_1.f
new file mode 100644
index 000000000..099f4d485
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/static_linking_1.f
@@ -0,0 +1,11 @@
+! { dg-do run }
+! { dg-require-effective-target static_libgfortran }
+! { dg-additional-sources static_linking_1.c }
+! { dg-options "-static" }
+!
+! This testcase checks that statically linking libgfortran with C main()
+! really calls the constructor function
+! PR libfortran/22298
+      subroutine f
+        print *, "subroutine output"
+      end
diff --git a/gcc/testsuite/gfortran.dg/stfunc_1.f90 b/gcc/testsuite/gfortran.dg/stfunc_1.f90
new file mode 100644
index 000000000..46dde6286
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/stfunc_1.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! this is a problem which disappeared between 2005-01-02 and 2005-03-13
+! PR 18600
+      logical a, b
+      a(b) = .true.
+      b = .false.
+      if (a(.false.)) b = .true.
+      if (.not.b) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/stfunc_2.f90 b/gcc/testsuite/gfortran.dg/stfunc_2.f90
new file mode 100644
index 000000000..75ecb057b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/stfunc_2.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! PR 20467 : we didn't check if a statement function had the dummy attribute.
+SUBROUTINE a(b)
+        b(c) = 0  ! { dg-error "Unclassifiable statement" }
+END SUBROUTINE a
+
diff --git a/gcc/testsuite/gfortran.dg/stfunc_3.f90 b/gcc/testsuite/gfortran.dg/stfunc_3.f90
new file mode 100644
index 000000000..90980a924
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/stfunc_3.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! Tests the fix for PR20867 in which implicit typing was not done within
+! statement functions and so was not confirmed or not by subsequent
+! type delarations.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+  REAL :: st1
+  st1(I)=I**2
+  REAL :: I ! { dg-error " already has basic type of INTEGER" }
+  END
+
+
diff --git a/gcc/testsuite/gfortran.dg/stfunc_4.f90 b/gcc/testsuite/gfortran.dg/stfunc_4.f90
new file mode 100644
index 000000000..2f0efccf3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/stfunc_4.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! Tests the fix for PR29389, in which the  statement function would not be
+! recognised as PURE within a PURE procedure.
+
+! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+  INTEGER :: st1, i = 99, a(4), q = 6
+  st1 (i) = i * i * i 
+  FORALL(i=1:4) a(i) = st1 (i) 
+  FORALL(i=1:4) a(i) = u (a(i)) - a(i)** 2 
+  if (any (a .ne. 0)) call abort ()
+  if (i .ne. 99) call abort ()
+contains
+  pure integer function u (x)
+    integer,intent(in) :: x
+    st2 (i) = i * i
+    u = st2(x)
+  end function
+end
diff --git a/gcc/testsuite/gfortran.dg/stfunc_5.f90 b/gcc/testsuite/gfortran.dg/stfunc_5.f90
new file mode 100644
index 000000000..09b6da338
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/stfunc_5.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! PR fortran/32724
+! ICE on statement function in specification part of module
+
+MODULE stmt
+f(x) = x**2      ! { dg-error "Unexpected STATEMENT FUNCTION" }
+END MODULE
+
+! { dg-final { cleanup-modules "stmt" } }
+
diff --git a/gcc/testsuite/gfortran.dg/stfunc_6.f90 b/gcc/testsuite/gfortran.dg/stfunc_6.f90
new file mode 100644
index 000000000..482d12592
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/stfunc_6.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+!
+! Tests the fix for the second bit of PR29389, in which the
+! statement function would not be recognised as not PURE
+! when it referenced a procedure that is not PURE.
+!
+! This is based on stfunc_4.f90 with the statement function made
+! impure by a reference to 'v'.
+!
+! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+  INTEGER :: st1, i = 99, a(4), q = 6
+  st1 (i) = i * i * i 
+  st3 (i) = i * v(i)
+  FORALL(i=1:4) a(i) = st1 (i) 
+  FORALL(i=1:4) a(i) = u (a(i)) - a(i)** 2 
+  if (any (a .ne. 0)) call abort ()
+  if (i .ne. 99) call abort ()
+  FORALL (i=1:4) a(i) = st3 (i) ! { dg-error "non-PURE function" "non-PURE reference in FORALL" { xfail *-*-*} }
+  FORALL (i=1:4) a(i) = v(i) ! { dg-error "non-PURE function" }
+contains
+  pure integer function u (x)
+    integer,intent(in) :: x
+    st2 (i) = i * v(i) ! { dg-error "non-PURE procedure" }
+    u = st2(x)
+  end function
+  integer function v (x)
+    integer,intent(in) :: x
+    v = i
+  end function
+end
diff --git a/gcc/testsuite/gfortran.dg/stmt_func_1.f90 b/gcc/testsuite/gfortran.dg/stmt_func_1.f90
new file mode 100644
index 000000000..472d7d78c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/stmt_func_1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "" }
+!
+! PR fortran/47542
+!
+integer, target, save :: tgt = 77
+integer, pointer ::ptr_stmt  ! { dg-error "Statement function .ptr_stmt. at .1. may not have pointer or allocatable attribute" }
+integer, allocatable :: alloc_stmt ! { dg-error "Statement function .alloc_stmt. at .1. may not have pointer or allocatable attribute" }
+
+ptr_stmt() = tgt
+alloc_stmt() = 78
+end
diff --git a/gcc/testsuite/gfortran.dg/storage_size_1.f08 b/gcc/testsuite/gfortran.dg/storage_size_1.f08
new file mode 100644
index 000000000..ade9dfc30
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/storage_size_1.f08
@@ -0,0 +1,31 @@
+! { dg-do run }
+!
+! PR 44649: [OOP] F2008: storage_size intrinsic
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+type :: t
+  integer(4) :: i
+  real(4) :: r
+end type
+
+type,extends(t) :: t2
+  integer(4) :: j
+end type
+
+type(t) :: a
+type(t), dimension(1:3) :: b
+class(t), allocatable :: cp
+
+allocate(t2::cp)
+
+if (sizeof(a)        /=  8) call abort()
+if (storage_size(a)  /= 64) call abort()
+
+if (sizeof(b)        /= 24) call abort()
+if (storage_size(b)  /= 64) call abort()
+
+if (sizeof(cp)       /=  8) call abort()
+if (storage_size(cp) /= 96) call abort()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/storage_size_2.f08 b/gcc/testsuite/gfortran.dg/storage_size_2.f08
new file mode 100644
index 000000000..c18155e72
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/storage_size_2.f08
@@ -0,0 +1,27 @@
+! { dg-do compile }
+!
+! PR 44649: [OOP] F2008: storage_size intrinsic
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+use iso_c_binding, only: c_int, c_sizeof
+
+type, bind(c) :: t 
+  integer(c_int) :: j
+end type
+
+integer(4) :: i1
+integer(c_int) :: i2
+type(t) :: x
+
+print *,c_sizeof(i1)                ! { dg-error "must be be an interoperable data entity" }
+print *,c_sizeof(i2)
+print *,c_sizeof(x)
+print *, c_sizeof(ran())            ! { dg-error "must be be an interoperable data entity" }
+
+print *,storage_size(1.0,4)
+print *,storage_size(1.0,3.2)       ! { dg-error "must be INTEGER" }
+print *,storage_size(1.0,(/1,2/))   ! { dg-error "must be a scalar" }
+print *,storage_size(1.0,irand())   ! { dg-error "must be a constant" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/storage_size_3.f08 b/gcc/testsuite/gfortran.dg/storage_size_3.f08
new file mode 100644
index 000000000..57b50af56
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/storage_size_3.f08
@@ -0,0 +1,27 @@
+! { dg-do run }
+!
+! PR 47024: [OOP] STORAGE_SIZE (for polymorphic types): Segfault at run time
+! PR 47189: [OOP] calling STORAGE_SIZE on a NULL-initialized class pointer
+! PR 47194: [OOP] EXTENDS_TYPE_OF still returns the wrong result if the polymorphic variable is unallocated
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+type t
+  integer(kind=4) :: a
+end type
+
+class(t), pointer :: x => null()
+class(t), allocatable :: y
+
+if (storage_size(x)/=32) call abort()
+if (storage_size(y)/=32) call abort()
+
+allocate(y)
+
+if (storage_size(y)/=32) call abort()
+
+deallocate(y)
+
+if (storage_size(y)/=32) call abort()
+
+end 
diff --git a/gcc/testsuite/gfortran.dg/streamio_1.f90 b/gcc/testsuite/gfortran.dg/streamio_1.f90
new file mode 100644
index 000000000..5a853fc8e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR25828 Stream IO test 1
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+PROGRAM stream_io_1
+  IMPLICIT NONE
+  integer(kind=4) i
+  real(kind=8) r
+  OPEN(UNIT=11, ACCESS="stream")
+  WRITE(11) "first"
+  WRITE(11) "second"
+  WRITE(11) 1234567
+  write(11) 3.14159_8
+  read(11, pos=12)i
+  if (i.ne.1234567) call abort()
+  read(11) r
+  if (r-3.14159 .gt. 0.00001) call abort()
+  CLOSE(UNIT=11, status="delete")
+END PROGRAM stream_io_1
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/streamio_10.f90 b/gcc/testsuite/gfortran.dg/streamio_10.f90
new file mode 100644
index 000000000..b0c573e6f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_10.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+! PR25093 Stream IO test 10
+! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>.
+! Test case derived from that given in PR by Steve Kargl.
+program stream_io_10
+  implicit none
+  integer(kind=4) :: a(4), b(4)
+  integer(kind=8) :: thepos
+  a = (/ 1, 2, 3, 4 /)
+  b = a
+  open(10, file="teststream", access="stream")
+  write(10) a
+  inquire(10, pos=thepos)
+  if (thepos.ne.17) call abort()
+
+  read(10, pos=1)
+  inquire(10, pos=thepos)
+  if (thepos.ne.1) call abort()
+
+  write(10, pos=15)
+  inquire(10, pos=thepos)
+  if (thepos.ne.15) call abort()
+
+  read(10, pos=3)
+  inquire(10, pos=thepos)
+  if (thepos.ne.3) call abort()
+
+  write(10, pos=1)
+  inquire(10, pos=thepos)
+  if (thepos.ne.1) call abort()
+
+  a = 0
+  read(10) a
+  if (any(a /= b)) call abort()
+
+  close(10, status="delete")
+end program stream_io_10
diff --git a/gcc/testsuite/gfortran.dg/streamio_11.f90 b/gcc/testsuite/gfortran.dg/streamio_11.f90
new file mode 100644
index 000000000..2084a2315
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_11.f90
@@ -0,0 +1,43 @@
+! { dg-do run }
+! PR29277 Stream IO test 11, tests formatted form.
+! Contributed by Tobias Burnas.
+program stream_test
+    implicit none
+    character(len=*), parameter :: rec1 = 'record1'
+    character(len=*), parameter :: rec2 = 'record2'
+    character(len=50) :: str1,str2
+    integer           :: len, i
+    real              :: r
+
+    open(10,form='formatted',access='stream',&
+         status='scratch',position='rewind')
+    write(10,'(a)') rec1//new_line('a')//rec2
+    rewind(10)
+    read(10,*) str1
+    read(10,*) str2
+    if(str1 /= rec1 .or. str2 /= rec2) call abort()
+    rewind(10)
+    read(10,'(a)') str1
+    read(10,'(a)') str2
+    if(str1 /= rec1 .or. str2 /= rec2) call abort()
+    close(10)
+
+    open(10,form='formatted',access='stream',&
+         status='scratch',position='rewind')
+    write(10,*) '123 '//trim(rec1)//'  1e-12'
+    write(10,*) '12345.6789'
+    rewind(10)
+    read(10,*) i,str1
+    read(10,*) r
+    if(i /= 123 .or. str1 /= rec1 .or. r /= 12345.6789) &
+      call abort()
+    close(10)
+
+    open(unit=10,form='unformatted',access='stream', &
+         status='scratch',position='rewind')
+    write(10) rec1//new_line('a')//rec2
+    len = len_trim(rec1//new_line('a')//rec2)
+    rewind(10)
+    read(10) str1(1:len)
+    if(str1 /= rec1//new_line('a')//rec2) call abort()
+end program stream_test
diff --git a/gcc/testsuite/gfortran.dg/streamio_12.f90 b/gcc/testsuite/gfortran.dg/streamio_12.f90
new file mode 100644
index 000000000..0b0d678a6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_12.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR33985 Stream IO test with empty write, array writes, and reads.
+program streamtest
+  implicit none
+  character(1)   :: lf = char(10)
+  character(1)   :: tchar
+  integer        :: i,j,k
+  real(kind=4), dimension(100,100) :: anarray
+  open(10, file="teststream", access="stream", form="unformatted")
+  anarray = 3.14159
+  write(10) anarray
+  write(10, pos=1) ! This is a way to position an unformatted file
+  anarray = 0.0
+  read(10) anarray
+  anarray = abs(anarray - 3.14159)
+  if (any(anarray.gt.0.00001)) call abort()
+  close(10,status="delete")
+end program streamtest
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/streamio_13.f90 b/gcc/testsuite/gfortran.dg/streamio_13.f90
new file mode 100644
index 000000000..e37535b7b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_13.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! PR 34405 - BACKSPACE for unformatted stream files is prohibited.
+program main
+  implicit none
+  integer :: ios
+  character(len=80) :: msg
+  open(2003,form="unformatted",access="stream",status="scratch")
+  write (2003) 1
+  write (2003) 2
+  ios = 0
+  msg = ' '
+  backspace (2003,iostat=ios,iomsg=msg)
+  if (ios == 0 .or. msg /="Cannot BACKSPACE an unformatted stream file") &
+       call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/streamio_14.f90 b/gcc/testsuite/gfortran.dg/streamio_14.f90
new file mode 100644
index 000000000..54522fe6b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_14.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! Test that we can write an unformatted stream file without
+! truncating.
+program main
+  character (len=10) c
+  open(10, form="unformatted", access="stream", position="rewind")
+  write (10) '1234567890abcde'
+  c = ''
+  read (10,pos=1) c
+  if (c /= '1234567890') call abort
+  c = ''
+  read (10,pos=6) c
+  if (c /= '67890abcde') call abort
+  write (10,pos=3) 'AB'
+  c = ''
+  read (10,pos=1) c
+  if (c /= '12AB567890') call abort
+  c = ''
+  read (10,pos=6) c
+  if (c /= '67890abcde') call abort
+  close (10,status="delete")
+end program main
diff --git a/gcc/testsuite/gfortran.dg/streamio_15.f90 b/gcc/testsuite/gfortran.dg/streamio_15.f90
new file mode 100644
index 000000000..bbe91f110
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_15.f90
@@ -0,0 +1,45 @@
+! { dg-do run { target fd_truncate } }
+! PR35132 Formatted stream I/O write should truncate.
+! Test case adapted from PR by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program main
+  implicit none
+  character(len=6) :: c
+  integer :: i, newline_length
+
+  open(20,status="scratch",access="stream",form="formatted")
+  write(20,"()")
+  inquire(20,pos=newline_length)
+  newline_length = newline_length - 1
+  if (newline_length < 1 .or. newline_length > 2) call abort
+  close(20)
+
+  open(20,file="foo.txt",form="formatted",access="stream")
+  write(20,'(A)') '123456'
+  write(20,'(A)') 'abcdef'
+  write(20,'(A)') 'qwerty'
+  rewind 20
+  ! Skip over the first line
+  read(20,'(A)') c
+  if (c.ne.'123456') call abort
+  ! Save the position
+  inquire(20,pos=i)
+  if (i.ne.7+newline_length) call abort
+  ! Read in the complete line...
+  read(20,'(A)') c
+  if (c.ne.'abcdef') call abort
+  ! Write out the first four characters
+  write(20,'(A)',pos=i,advance="no") 'ASDF'
+  ! Fill up the rest of the line.  Here, we know the length.  If we
+  ! don't, things will be a bit more complicated.
+  write(20,'(A)') c(5:6)
+  ! Copy the file to standard output
+  rewind 20
+  c = ""
+  read(20,'(A)') c
+  if (c.ne.'123456') call abort
+  read(20,'(A)') c
+  if (c.ne.'ASDFef') call abort
+  read(20,'(A)', iostat=i) c
+  if (i /= -1) call abort
+  close (20, status="delete")
+end program main
diff --git a/gcc/testsuite/gfortran.dg/streamio_16.f90 b/gcc/testsuite/gfortran.dg/streamio_16.f90
new file mode 100644
index 000000000..7a1ab115d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_16.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! PR38291 Rejects I/O with POS= if FMT=*
+character(15) :: sAccess
+character(1) :: instr
+integer :: mypos, i
+mypos = 0
+open(50, access="stream", form="formatted")
+write(50, *, pos=1) "Just something "
+do i=1,17
+  read( 50, *,pos=i)
+  inquire(50, access=sAccess, pos=mypos)
+  if (sAccess.ne."STREAM") call abort
+  if ((mypos.ne.18).and.(mypos.ne.19)) call abort
+end do
+read (50,*, end=10)
+call abort
+ 10 continue
+close(50,status="delete")
+end
diff --git a/gcc/testsuite/gfortran.dg/streamio_2.f90 b/gcc/testsuite/gfortran.dg/streamio_2.f90
new file mode 100644
index 000000000..8260a7481
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_2.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR25828 Stream IO test 2
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+PROGRAM readUstream
+  IMPLICIT NONE
+  CHARACTER*3 :: string
+  INTEGER :: n
+  string = "123"
+  n = 13579
+  OPEN(UNIT=11, FILE="streamio2", ACCESS="STREAM")
+  WRITE(11) "first"
+  WRITE(11) "second"
+  WRITE(11) 7
+  READ(11, POS=3) string
+  READ(11, POS=12) n
+  if (string.ne."rst") call abort()
+  if (n.ne.7) call abort()
+  close(unit=11, status="delete")
+END PROGRAM readUstream
+
diff --git a/gcc/testsuite/gfortran.dg/streamio_3.f90 b/gcc/testsuite/gfortran.dg/streamio_3.f90
new file mode 100644
index 000000000..d73e431a0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_3.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR25828 Stream IO test 3, tests read_x and inquire.
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+program streamio_3
+  implicit none
+  integer         :: i(6),j
+  character(10)   :: myaccess
+  open(10, access="stream", form="formatted")
+  i = (/(j,j=1,6)/)
+  write(10,'(3(2x,i4/)/3(3x,i6/))') i
+  i = 0
+  rewind(10)
+  read(10,'(3(2x,i4/)/3(3x,i6/))') i
+  if (any(i.ne.(/(j,j=1,6)/))) call abort()
+  inquire(unit=10, access=myaccess)
+  if (myaccess.ne."STREAM") call abort()
+  close(10,status="delete")
+end program streamio_3
diff --git a/gcc/testsuite/gfortran.dg/streamio_4.f90 b/gcc/testsuite/gfortran.dg/streamio_4.f90
new file mode 100644
index 000000000..ce638a415
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_4.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! PR25828 Stream IO test 4, Tests string read and writes, single byte.
+! Verifies buffering is working correctly and position="append"
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+program streamtest
+  implicit none
+  character(1)   :: lf = char(10)
+  character(1)   :: tchar
+  integer        :: i,j,k
+  integer, parameter :: lines = 5231
+   
+  open(10, file="teststream", access="stream", form="formatted")
+  
+  do i=1,lines
+    do j=0,9
+      write(10,"(i5)") j
+    end do
+  end do
+  
+  close(10)
+  
+  open(10, file="teststream", access="stream",&
+  &form="formatted", position="append")
+  do i=1,lines
+    do j=0,9
+      write(10,"(i5)") j
+    end do
+  end do
+  rewind(10)
+  do i=1,lines
+    do j=0,9
+      read(10,"(i5)") k
+      if (k.ne.j) call abort()
+    end do
+  end do
+
+  close(10,status="delete")
+end program streamtest
diff --git a/gcc/testsuite/gfortran.dg/streamio_5.f90 b/gcc/testsuite/gfortran.dg/streamio_5.f90
new file mode 100644
index 000000000..6fdf70779
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_5.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! PR25828 Stream IO test 5, unformatted single byte
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+program streamtest5
+  implicit none
+  character(1)   :: lf = char(10)
+  character(1)   :: tchar
+  integer        :: i,j,k
+   
+  open(10, file="teststream", access="stream", form="unformatted")
+  
+  do i=1,1229
+    do j=0,9
+      write(10) j
+    end do
+    write(10) lf
+  end do
+  
+  close(10)
+  
+  open(10, file="teststream", access="stream", form="unformatted")
+  
+  do i=1,1229
+    do j=0,9
+      read(10) k
+      if (k.ne.j) call abort()
+    end do
+    read(10) tchar
+    if (tchar.ne.lf) call abort()
+  end do
+  close(10,status="delete")
+end program streamtest5
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/streamio_6.f90 b/gcc/testsuite/gfortran.dg/streamio_6.f90
new file mode 100644
index 000000000..3857667b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_6.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! PR25828 Stream IO test 6, random writes and reads.
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+program streamio_6
+  implicit none
+  integer, dimension(100) :: a
+  character(1) :: c
+  integer :: i,j,k,ier
+  real    :: x
+  data a / 13, 9, 34, 41, 25, 98, 6, 12, 11, 44, 79, 3,&
+  &    64, 61, 77, 57, 59, 2, 92, 38, 71, 64, 31, 60, 28, 90, 26,&
+  &    97, 47, 26, 48, 96, 95, 82, 100, 90, 45, 71, 71, 67, 72,&
+  &    76, 94, 49, 85, 45, 100, 22, 96, 48, 13, 23, 40, 14, 76, 99,&
+  &    96, 90, 65,  2, 8, 60, 96, 19, 45, 1, 100, 48, 91, 20, 92,&
+  &    72, 81, 59, 24, 37, 43, 21, 54, 68, 31, 19, 79, 63, 41,&
+  &    42, 12, 10, 62, 43, 9, 30, 9, 54, 35, 4, 5, 55, 3, 94 /
+
+  open(unit=15,file="teststream",access="stream",form="unformatted")
+  do i=1,100
+    k = a(i)
+    write(unit=15, pos=k) achar(k)
+  enddo
+  do j=1,100
+    read(unit=15, pos=a(j), iostat=ier) c
+    if (ier.ne.0) then
+      call abort
+    else
+      if (achar(a(j)) /= c) call abort
+    endif
+  enddo
+  close(unit=15, status="delete")
+end program streamio_6
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/streamio_7.f90 b/gcc/testsuite/gfortran.dg/streamio_7.f90
new file mode 100644
index 000000000..7a7b27712
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_7.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR25828 Stream IO test 7, Array writes and reads.
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+program streamtest
+  implicit none
+  character(1)   :: lf = char(10)
+  character(1)   :: tchar
+  integer        :: i,j,k
+  real(kind=4), dimension(100,100) :: anarray
+  open(10, file="teststream", access="stream", form="unformatted")
+  anarray = 3.14159
+  write(10) anarray
+  anarray = 0.0
+  read(10, pos=1) anarray
+  anarray = abs(anarray - 3.14159)
+  if (any(anarray.gt.0.00001)) call abort()
+  close(10,status="delete")
+end program streamtest
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/streamio_8.f90 b/gcc/testsuite/gfortran.dg/streamio_8.f90
new file mode 100644
index 000000000..420f5b91a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_8.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! PR25828 Stream IO test 8
+! Contributed by Jerry DeLisle <jvdelisle@verizon.net>.
+PROGRAM stream_io_8
+  IMPLICIT NONE
+  integer(kind=8) mypos
+  character(10) mystring
+  real(kind=8) r
+  mypos = 0
+  mystring = "not yet"
+  r = 12.25d0
+  OPEN(UNIT=11, ACCESS="stream")
+  inquire(unit=11, pos=mypos)
+  if (mypos.ne.1) call abort()
+  WRITE(11) "first"
+  inquire(unit=11, pos=mypos)
+  if (mypos.ne.6) call abort()
+  WRITE(11) "second"
+  inquire(unit=11, pos=mypos)
+  if (mypos.ne.12) call abort()
+  WRITE(11) 1234567_4
+  inquire(unit=11, pos=mypos)
+  if (mypos.ne.16) call abort()
+  write(11) r
+  r = 0.0
+  inquire (11, pos=mypos)
+  read(11,pos=16)r
+  if (abs(r-12.25d0)>1e-10) call abort()
+  inquire(unit=11, pos=mypos)
+  inquire(unit=11, access=mystring)
+  if (mypos.ne.24) call abort()
+  if (mystring.ne."STREAM") call abort()
+  CLOSE(UNIT=11, status="delete")
+END PROGRAM stream_io_8
diff --git a/gcc/testsuite/gfortran.dg/streamio_9.f90 b/gcc/testsuite/gfortran.dg/streamio_9.f90
new file mode 100644
index 000000000..150c1c6c3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/streamio_9.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! PR29053 Stream IO test 9.
+! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>.
+! Test case derived from that given in PR by Steve Kargl.
+program pr29053
+   implicit none
+   real dt, t, u, a(10), b(10)
+   integer i, place
+   dt = 1.e-6
+   a = real( (/ (i, i=1, 10) /) )
+   b = a
+   open(unit=11, file='a.dat', access='stream')
+   open(unit=12, file='b.dat', access='stream')
+   do i = 1, 10
+      t = i * dt
+      write(11) t
+      write(12) a
+   end do
+   rewind(11)
+   rewind(12)
+   do i = 1, 10
+      t = i * dt
+      read(12) a
+      if (any(a.ne.b)) call abort()
+      read(11) u
+      if (u.ne.t) call abort()
+   end do
+   close(11, status="delete")
+   close(12, status="delete")
+end program pr29053
+
diff --git a/gcc/testsuite/gfortran.dg/string_0xfe_0xff_1.f90 b/gcc/testsuite/gfortran.dg/string_0xfe_0xff_1.f90
new file mode 100644
index 000000000..16867f05c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_0xfe_0xff_1.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! PR 30452 - this used to cause syntax errors due to the presence,
+!            as characters, of bytes 0xfe and 0xff.
+program main
+  if (char (254) /= "þ") call abort
+  if (char (255) /= "ÿ") call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/string_1.f90 b/gcc/testsuite/gfortran.dg/string_1.f90
new file mode 100644
index 000000000..11dc5b7a3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_1.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+!
+program main
+  implicit none
+  integer(kind=8), parameter :: l1 = 2_8**32_8
+  character (len=2_8**32_8+4_8), parameter :: s = "" ! { dg-error "too large" }
+  character (len=2_8**32_8+4_8) :: ch ! { dg-error "too large" }
+  character (len=l1 + 1_8) :: v ! { dg-error "too large" }
+  character (len=int(huge(0_4),kind=8) + 1_8) :: z ! { dg-error "too large" }
+  character (len=int(huge(0_4),kind=8) + 0_8) :: w
+
+  print *, len(s)
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/string_2.f90 b/gcc/testsuite/gfortran.dg/string_2.f90
new file mode 100644
index 000000000..c94c4141b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_2.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+!
+program main
+  implicit none
+  character(len=10) :: s
+
+  s = ''
+  print *, s(1:2_8**32_8+3_8) ! { dg-error "exceeds the string length" }
+  print *, s(2_8**32_8+3_8:2_8**32_8+4_8) ! { dg-error "exceeds the string length" }
+  print *, len(s(1:2_8**32_8+3_8)) ! { dg-error "exceeds the string length" }
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/string_3.f90 b/gcc/testsuite/gfortran.dg/string_3.f90
new file mode 100644
index 000000000..7daf8d31a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_3.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+subroutine foo(i)
+  implicit none
+  integer, intent(in) :: i
+  character(len=i) :: s
+
+  s = ''
+  print *, s(1:2_8**32_8+3_8) ! { dg-error "too large" }
+  print *, s(2_8**32_8+3_8:2_8**32_8+4_8) ! { dg-error "too large" }
+  print *, len(s(1:2_8**32_8+3_8)) ! { dg-error "too large" }
+  print *, len(s(2_8**32_8+3_8:2_8**32_8+4_8)) ! { dg-error "too large" }
+
+  print *, s(2_8**32_8+3_8:1)
+  print *, s(2_8**32_8+4_8:2_8**32_8+3_8)
+  print *, len(s(2_8**32_8+3_8:1))
+  print *, len(s(2_8**32_8+4_8:2_8**32_8+3_8))
+
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/string_4.f90 b/gcc/testsuite/gfortran.dg/string_4.f90
new file mode 100644
index 000000000..12f501bb9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_4.f90
@@ -0,0 +1,51 @@
+! { dg-do compile }
+! { dg-options "" }
+! (options to disable warnings about statement functions etc.)
+!
+! PR fortran/44352
+!
+! Contributed by Vittorio Zecca
+!
+
+      SUBROUTINE TEST1()
+      implicit real*8 (a-h,o-z)
+      character*32 ddname,stmtfnt1
+      stmtfnt1(x)=   'h810 e=0.01         '
+      ddname=stmtfnt1(0.d0)
+      if (ddname /= "h810 e=0.01") call abort()
+      END
+
+      SUBROUTINE TEST2()
+      implicit none
+      character(2)  :: ddname,stmtfnt2
+      real :: x
+      stmtfnt2(x)=   'x'
+      ddname=stmtfnt2(0.0)
+      if(ddname /= 'x') call abort()
+      END
+
+      SUBROUTINE TEST3()
+      implicit real*8 (a-h,o-z)
+      character*32 ddname,dname
+      character*2 :: c
+      dname(c) = 'h810 e=0.01         '
+      ddname=dname("w ")
+      if (ddname /= "h810 e=0.01") call abort()
+      END
+
+      SUBROUTINE TEST4()
+      implicit real*8 (a-h,o-z)
+      character*32 ddname,dname
+      character*2 :: c
+      dname(c) = 'h810 e=0.01         '
+      c = 'aa'
+      ddname=dname("w ")
+      if (ddname /= "h810 e=0.01") call abort()
+      if (c /= "aa") call abort()
+      END
+
+      call test1()
+      call test2()
+      call test3()
+      call test4()
+      end
diff --git a/gcc/testsuite/gfortran.dg/string_5.f90 b/gcc/testsuite/gfortran.dg/string_5.f90
new file mode 100644
index 000000000..87ec70942
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_5.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! PR fortran/48876 - this used to segfault.
+! Test case contributed by mhp77 (a) gmx.at.
+program test
+  character ::  string =  "string"( : -1 )
+end program test
+
diff --git a/gcc/testsuite/gfortran.dg/string_compare_1.f90 b/gcc/testsuite/gfortran.dg/string_compare_1.f90
new file mode 100644
index 000000000..30cf35717
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_compare_1.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+
+! PR fortran/37099
+! Check for correct results when comparing array-section-substrings.
+
+PROGRAM main
+  IMPLICIT NONE
+
+  CHARACTER(*), PARAMETER :: exprs(1) = (/ 'aa' /)
+
+  CHARACTER(*), PARAMETER :: al1 = 'a';
+  CHARACTER(len=LEN (al1)) :: al2 = al1;
+
+  LOGICAL :: tmp(1), tmp2(1)
+
+  tmp = (exprs(1:1)(1:1) == al1)
+  tmp2 = (exprs(1:1)(1:1) == al2)
+
+  PRINT '(L1)', tmp
+  PRINT '(L1)', tmp2
+
+  IF (.NOT. tmp(1) .OR. .NOT. tmp2(1)) THEN
+    CALL abort ()
+  END IF
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/string_compare_2.f90 b/gcc/testsuite/gfortran.dg/string_compare_2.f90
new file mode 100644
index 000000000..966ed554a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_compare_2.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+
+! PR fortran/37099
+! Check for correct results when comparing array-section-substrings.
+
+! This is the original test from the PR.
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+
+module xparams
+  integer,parameter :: exprbeg=100,exprend=154
+  character(*),dimension(exprbeg:exprend),parameter :: &
+      exprs=(/'nint()  ','log10() ','sqrt()  ','acos()  ','asin()  ',   &
+      'atan()  ','cosh()  ','sinh()  ','tanh()  ','int()   ',           &
+      'cos()   ','sin()   ','tan()   ','exp()   ','log()   ','abs()   ',&
+      'delta() ','step()  ','rect()  ','max(,)  ','min(,)  ','bj0()   ',&
+      'bj1()   ','bjn(,)  ','by0()   ','by1()   ','byn(,)  ','logb(,) ',&
+      'erf()   ','erfc()  ','lgamma()','gamma() ','csch()  ','sech()  ',&
+      'coth()  ','lif(,,) ','gaus()  ','sinc()  ','atan2(,)','mod(,)  ',&
+      'nthrt(,)','ramp()  ','fbi()   ','fbiq()  ','uran(,) ','aif(,,,)',&
+      'sgn()   ','cbrt()  ','fact()  ','somb()  ','bk0()   ','bk1()   ',&
+      'bkn(,)  ','bbi(,,) ','bbiq(,,)'/)
+  logical :: tmp(55,26)
+  character(26) :: al = 'abcdefghijklmnopqrstuvwxyz'
+end
+
+program pack_bug
+  use xparams
+    do i = 1, 1
+      tmp(:,i) = (exprs(:)(1:1)==al(i:i))
+      print '(55L1)', exprs(:)(1:1)=='a'
+      print '(55L1)', tmp(:,i)
+
+      if (any ((exprs(:)(1:1)=='a') .neqv. tmp(:,i))) then
+        call abort ()
+      end if
+    end do
+end
+
+! { dg-final { cleanup-modules "xparams" } }
diff --git a/gcc/testsuite/gfortran.dg/string_compare_3.f90 b/gcc/testsuite/gfortran.dg/string_compare_3.f90
new file mode 100644
index 000000000..46a11d3f5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_compare_3.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+
+! PR fortran/37099
+! Check for correct results when comparing array-section-substrings.
+
+! This is the test from comment #1 of the PR.
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+
+integer, parameter :: n = 10
+integer, parameter :: ilst(n) = (/(i,i=1,n)/)
+character(*), parameter :: c0lst(n) = (/(char(96+i),i=1,n)/)
+character(*), parameter :: c1lst(n) = (/(char(96+i)//'b',i=1,n)/)
+logical :: tmp(n)
+i = 5
+print *, ilst(:) == i
+print *, c0lst(:)(1:1) == char(96+i)
+tmp = c1lst(:)(1:1) == char(96+i)
+print *, tmp
+print *, c1lst(:)(1:1) == 'e'
+if (any(tmp .neqv. (c0lst(:)(1:1) == char(96+i)))) call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/string_ctor_1.f90 b/gcc/testsuite/gfortran.dg/string_ctor_1.f90
new file mode 100644
index 000000000..7e5c2f9f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_ctor_1.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! Program to test character array constructors.
+! PR17144
+subroutine test1 (n, t, u)
+  integer n
+  character(len=n) :: s(2)
+  character(len=*) :: t
+  character(len=*) :: u
+
+  ! A variable array constructor.
+  s = (/t, u/)
+  ! An array constructor as part of an expression.
+  if (any (s .ne. (/"Hell", "Worl"/))) call abort
+end subroutine
+
+subroutine test2
+  character*5 :: s(2)
+
+  ! A constant array constructor
+  s = (/"Hello", "World"/)
+  if ((s(1) .ne. "Hello") .or. (s(2) .ne. "World")) call abort
+end subroutine
+
+subroutine test3
+  character*1 s(26)
+  character*26 t
+  integer i
+
+  ! A large array constructor
+  s = (/'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', &
+        'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z'/)
+  do i=1, 26
+    t(i:i) = s(i)
+  end do
+
+  ! Assignment with dependency
+  s = (/(s(27-i), i=1, 26)/)
+  do i=1, 26
+    t(i:i) = s(i)
+  end do
+  if (t .ne. "zyxwvutsrqponmlkjihgfedcba") call abort
+end subroutine
+
+program string_ctor_1
+  call test1 (4, "Hello", "World")
+  call test2
+  call test3
+end program
+
diff --git a/gcc/testsuite/gfortran.dg/string_length_1.f90 b/gcc/testsuite/gfortran.dg/string_length_1.f90
new file mode 100644
index 000000000..50883f010
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_length_1.f90
@@ -0,0 +1,74 @@
+! { dg-do run }
+! Testcase for PR 31203
+! We used to create strings with negative length
+subroutine foo(i)
+  integer :: i
+  character(len=i) :: s(2)
+  if (len(s) < 0) call abort
+  if (len(s) /= max(i,0)) call abort
+end
+
+function gee(i)
+  integer, intent(in) :: i
+  character(len=i) :: gee
+
+  gee = ""
+end function gee
+
+subroutine s1(i,j)
+  character(len=i-j) :: a
+  if (len(a) < 0) call abort()
+end subroutine
+
+program test
+  interface
+    function gee(i)
+      integer, intent(in) :: i
+      character(len=i) :: gee
+    end function gee
+  end interface
+
+  call foo(2)
+  call foo(-1)
+  call s1(1,2)
+  call s1(-1,-8)
+  call s1(-8,-1)
+
+  if (len(gee(2)) /= 2) call abort
+  if (len(gee(-5)) /= 0) call abort
+  if (len(gee(intfunc(3))) /= max(intfunc(3),0)) call abort
+  if (len(gee(intfunc(2))) /= max(intfunc(2),0)) call abort
+
+  if (len(bar(2)) /= 2) call abort
+  if (len(bar(-5)) /= 0) call abort
+  if (len(bar(intfunc(3))) /= max(intfunc(3),0)) call abort
+  if (len(bar(intfunc(2))) /= max(intfunc(2),0)) call abort
+
+  if (cow(bar(2)) /= 2) call abort
+  if (cow(bar(-5)) /= 0) call abort
+  if (cow(bar(intfunc(3))) /= max(intfunc(3),0)) call abort
+  if (cow(bar(intfunc(2))) /= max(intfunc(2),0)) call abort
+
+contains
+
+  function bar(i)
+    integer, intent(in) :: i
+    character(len=i) :: bar
+  
+    bar = ""
+  end function bar
+
+  function cow(c)
+    character(len=*), intent(in) :: c
+    integer :: cow
+    cow = len(c)
+  end function cow
+
+  pure function intfunc(i)
+    integer, intent(in) :: i
+    integer :: intfunc
+
+    intfunc = 2*i-5
+  end function intfunc
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/string_null_compare_1.f b/gcc/testsuite/gfortran.dg/string_null_compare_1.f
new file mode 100644
index 000000000..659b3eb37
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_null_compare_1.f
@@ -0,0 +1,17 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! PR 27784 - Different strings should compare unequal even if they
+!            have CHAR(0) in them.
+
+      program main
+      character*3 str1, str2
+      call setval(str1, str2)
+      if (str1 == str2) call abort
+      end
+
+      subroutine setval(str1, str2)
+      character*3 str1, str2
+      str1 = 'a' // CHAR(0) // 'a'
+      str2 = 'a' // CHAR(0) // 'c'
+      end
diff --git a/gcc/testsuite/gfortran.dg/string_pad_trunc.f90 b/gcc/testsuite/gfortran.dg/string_pad_trunc.f90
new file mode 100644
index 000000000..738a181b9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/string_pad_trunc.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! PR20713. Pad and truncate string.
+
+character(len = 6),parameter:: a = 'hello'
+character(len = 6),parameter:: b = 'hello *'
+character(len = 6),parameter:: c (1:1) = 'hello'
+character(len = 11) line
+
+write (line, '(6A)') a, 'world'
+if (line .ne. 'hello world') call abort
+
+write (line, '(6A)') b, 'world'
+if (line .ne. 'hello world') call abort
+
+write (line, '(6A)') c, 'world'
+if (line .ne. 'hello world') call abort
+
+write (line, '(6A)') c(1), 'world'
+if (line .ne. 'hello world') call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_1.f03 b/gcc/testsuite/gfortran.dg/structure_constructor_1.f03
new file mode 100644
index 000000000..8f8f58ef9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/structure_constructor_1.f03
@@ -0,0 +1,74 @@
+! { dg-do run }
+! Simple structure constructors, without naming arguments, default values
+! or inheritance and the like.
+
+PROGRAM test
+  IMPLICIT NONE
+
+  ! Empty structuer
+  TYPE :: empty_t
+  END TYPE empty_t
+
+  ! Structure of basic data types
+  TYPE :: basics_t
+    INTEGER :: i
+    REAL :: r
+    COMPLEX :: c
+    LOGICAL :: l
+  END TYPE basics_t
+
+  ! Structure with strings
+  TYPE :: strings_t
+    CHARACTER(len=5) :: str1, str2
+    CHARACTER(len=10) :: long
+  END TYPE strings_t
+
+  ! Structure with arrays
+  TYPE :: array_t
+    INTEGER :: ints(2:5)
+    REAL :: matrix(2, 2)
+  END TYPE array_t
+
+  ! Structure containing structures
+  TYPE :: nestedStruct_t
+    TYPE(basics_t) :: basics
+    TYPE(array_t) :: arrays
+  END TYPE nestedStruct_t
+
+  TYPE(empty_t) :: empty
+  TYPE(basics_t) :: basics
+  TYPE(strings_t) :: strings
+  TYPE(array_t) :: arrays
+  TYPE(nestedStruct_t) :: nestedStruct
+
+  empty = empty_t ()
+
+  basics = basics_t (42, -1.5, (.5, .5), .FALSE.)
+  IF (basics%i /= 42 .OR. basics%r /= -1.5 &
+      .OR. basics%c /= (.5, .5) .OR. basics%l) THEN
+    CALL abort()
+  END IF
+
+  strings = strings_t ("hello", "abc", "this one is long")
+  IF (strings%str1 /= "hello" .OR. strings%str2 /= "abc" &
+      .OR. strings%long /= "this one i") THEN
+    CALL abort()
+  END IF
+
+  arrays = array_t ( (/ 1, 2, 3, 4 /), RESHAPE((/ 5, 6, 7, 8 /), (/ 2, 2 /)) )
+  IF (arrays%ints(2) /= 1 .OR. arrays%ints(3) /= 2 &
+      .OR. arrays%ints(4) /= 3 .OR. arrays%ints(5) /= 4 &
+      .OR. arrays%matrix(1, 1) /= 5. .OR. arrays%matrix(2, 1) /= 6. &
+      .OR. arrays%matrix(1, 2) /= 7. .OR. arrays%matrix(2, 2) /= 8.) THEN
+    CALL abort()
+  END IF
+
+  nestedStruct = nestedStruct_t (basics_t (42, -1.5, (.5, .5), .FALSE.), arrays)
+  IF (nestedStruct%basics%i /= 42 .OR. nestedStruct%basics%r /= -1.5 &
+      .OR. nestedStruct%basics%c /= (.5, .5) .OR. nestedStruct%basics%l &
+      .OR. ANY(nestedStruct%arrays%ints /= arrays%ints) &
+      .OR. ANY(nestedStruct%arrays%matrix /= arrays%matrix)) THEN
+    CALL abort()
+  END IF
+
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_10.f90 b/gcc/testsuite/gfortran.dg/structure_constructor_10.f90
new file mode 100644
index 000000000..eed7fa3a9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/structure_constructor_10.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR 41070: [4.5 Regression] Error: Components of structure constructor '' at (1) are PRIVATE
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+
+MODULE cdf_aux_mod
+IMPLICIT NONE
+
+TYPE :: one_parameter
+  CHARACTER (8) :: name
+END TYPE one_parameter
+
+TYPE :: the_distribution
+  CHARACTER (8) :: name
+END TYPE the_distribution
+
+TYPE (the_distribution), PARAMETER :: the_beta = the_distribution('cdf_beta')
+END MODULE cdf_aux_mod
+
+SUBROUTINE cdf_beta()
+  USE cdf_aux_mod
+  IMPLICIT NONE
+  CALL check_complements(the_beta%name)
+END SUBROUTINE cdf_beta
+
+! { dg-final { cleanup-modules "cdf_aux_mod" } }
+
diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_2.f03 b/gcc/testsuite/gfortran.dg/structure_constructor_2.f03
new file mode 100644
index 000000000..c551ebfde
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/structure_constructor_2.f03
@@ -0,0 +1,29 @@
+! { dg-do run }
+! Structure constructor with component naming.
+
+PROGRAM test
+  IMPLICIT NONE
+
+  ! Structure of basic data types
+  TYPE :: basics_t
+    INTEGER :: i
+    REAL :: r
+    COMPLEX :: c
+    LOGICAL :: l
+  END TYPE basics_t
+
+  TYPE(basics_t) :: basics
+
+  basics = basics_t (42, -1.5, c=(.5, .5), l=.FALSE.)
+  IF (basics%i /= 42 .OR. basics%r /= -1.5 &
+      .OR. basics%c /= (.5, .5) .OR. basics%l) THEN
+    CALL abort()
+  END IF
+
+  basics = basics_t (r=-1.5, i=42, l=.FALSE., c=(.5, .5))
+  IF (basics%i /= 42 .OR. basics%r /= -1.5 &
+      .OR. basics%c /= (.5, .5) .OR. basics%l) THEN
+    CALL abort()
+  END IF
+
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_3.f03 b/gcc/testsuite/gfortran.dg/structure_constructor_3.f03
new file mode 100644
index 000000000..aa5934951
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/structure_constructor_3.f03
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! Structure constructor with component naming, test that an error is emitted
+! if there are arguments without name after ones with name.
+
+PROGRAM test
+  IMPLICIT NONE
+
+  ! Structure of basic data types
+  TYPE :: basics_t
+    INTEGER :: i
+    REAL :: r
+  END TYPE basics_t
+
+  TYPE(basics_t) :: basics
+
+  basics = basics_t (i=42, 1.5) ! { dg-error "without name after" }
+
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_4.f03 b/gcc/testsuite/gfortran.dg/structure_constructor_4.f03
new file mode 100644
index 000000000..647be5fbb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/structure_constructor_4.f03
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! Structure constructor with component naming, test that an error is emitted if
+! a component is given two initializers.
+
+PROGRAM test
+  IMPLICIT NONE
+
+  ! Structure of basic data types
+  TYPE :: basics_t
+    INTEGER :: i
+    REAL :: r
+  END TYPE basics_t
+
+  TYPE(basics_t) :: basics
+
+  basics = basics_t (42, r=1.5, i=15) ! { dg-error "'i' is initialized twice" }
+  basics = basics_t (42, r=1., r=-2.) ! { dg-error "'r' is initialized twice" }
+
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_5.f03 b/gcc/testsuite/gfortran.dg/structure_constructor_5.f03
new file mode 100644
index 000000000..064db66a2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/structure_constructor_5.f03
@@ -0,0 +1,38 @@
+! { dg-do run }
+! Structure constructor with default initialization.
+
+PROGRAM test
+  IMPLICIT NONE
+
+  ! Type with all default values
+  TYPE :: quasiempty_t
+    CHARACTER(len=5) :: greeting = "hello"
+  END TYPE quasiempty_t
+
+  ! Structure of basic data types
+  TYPE :: basics_t
+    INTEGER :: i = 42
+    REAL :: r
+    COMPLEX :: c = (0., 1.)
+  END TYPE basics_t
+
+  TYPE(quasiempty_t) :: empty
+  TYPE(basics_t) :: basics
+
+  empty = quasiempty_t ()
+  IF (empty%greeting /= "hello") THEN
+    CALL abort()
+  END IF
+
+  basics = basics_t (r = 1.5)
+  IF (basics%i /= 42 .OR. basics%r /= 1.5 .OR. basics%c /= (0., 1.)) THEN
+    CALL abort()
+  END IF
+
+  basics%c = (0., 0.) ! So we see it's surely gotten re-initialized
+  basics = basics_t (1, 5.1)
+  IF (basics%i /= 1 .OR. basics%r /= 5.1 .OR. basics%c /= (0., 1.)) THEN
+    CALL abort()
+  END IF
+
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_6.f03 b/gcc/testsuite/gfortran.dg/structure_constructor_6.f03
new file mode 100644
index 000000000..9952e2e7c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/structure_constructor_6.f03
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! Structure constructor with default initialization, test that an error is
+! emitted for components without default initializer missing value.
+
+PROGRAM test
+  IMPLICIT NONE
+
+  ! Structure of basic data types
+  TYPE :: basics_t
+    INTEGER :: i = 42
+    REAL :: r
+    COMPLEX :: c = (0., 1.)
+  END TYPE basics_t
+
+  TYPE(basics_t) :: basics
+
+  basics = basics_t (i = 42) ! { dg-error "No initializer for component 'r'" }
+  basics = basics_t (42) ! { dg-error "No initializer for component 'r'" }
+
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_7.f03 b/gcc/testsuite/gfortran.dg/structure_constructor_7.f03
new file mode 100644
index 000000000..5388e8805
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/structure_constructor_7.f03
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! Test for errors when excess components are given for a structure-constructor.
+
+PROGRAM test
+  IMPLICIT NONE
+
+  ! Structure of basic data types
+  TYPE :: basics_t
+    INTEGER :: i
+    REAL :: r = 1.5
+  END TYPE basics_t
+
+  TYPE(basics_t) :: basics
+
+  basics = basics_t (42, 1.5, 1000) ! { dg-error "Too many components" }
+  basics = basics_t (42, xxx = 1000) ! { dg-error "is not a member" }
+
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_8.f03 b/gcc/testsuite/gfortran.dg/structure_constructor_8.f03
new file mode 100644
index 000000000..b86d0eccc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/structure_constructor_8.f03
@@ -0,0 +1,61 @@
+! { dg-do compile }
+! Test for errors when setting private components inside a structure constructor
+! or when constructing a private structure.
+
+MODULE privmod
+  IMPLICIT NONE
+
+  TYPE :: haspriv_t
+    INTEGER :: a
+    INTEGER, PRIVATE :: b = 42
+  END TYPE haspriv_t
+
+  TYPE :: allpriv_t
+    PRIVATE
+    INTEGER :: a = 25
+  END TYPE allpriv_t
+
+  TYPE, PRIVATE :: ispriv_t
+    INTEGER :: x
+  END TYPE ispriv_t
+
+CONTAINS
+  
+  SUBROUTINE testfunc ()
+    IMPLICIT NONE
+    TYPE(haspriv_t) :: struct1
+    TYPE(allpriv_t) :: struct2
+    TYPE(ispriv_t) :: struct3
+
+    ! This should succeed from within the module, no error.
+    struct1 = haspriv_t (1, 2)
+    struct2 = allpriv_t (42)
+    struct3 = ispriv_t (42)
+  END SUBROUTINE testfunc
+
+END MODULE privmod
+
+PROGRAM test
+  USE privmod
+  IMPLICIT NONE
+
+  TYPE(haspriv_t) :: struct1
+  TYPE(allpriv_t) :: struct2
+
+  ! This should succeed, not giving value to private component
+  struct1 = haspriv_t (5)
+  struct2 = allpriv_t ()
+
+  ! These should fail
+  struct1 = haspriv_t (1, 2) ! { dg-error "is a PRIVATE component" }
+  struct1 = haspriv_t (b = 2, a = 1) ! { dg-error "is a PRIVATE component" }
+
+  ! This should fail as all components are private
+  struct2 = allpriv_t (5) ! { dg-error "is a PRIVATE component" }
+
+  ! This should fail as the type itself is private, and the expression should
+  ! be deduced as call to an undefined function.
+  WRITE (*,*) ispriv_t (5) ! { dg-error "has no IMPLICIT type" }
+
+END PROGRAM test
+! { dg-final { cleanup-modules "privmod" } }
diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_9.f90 b/gcc/testsuite/gfortran.dg/structure_constructor_9.f90
new file mode 100644
index 000000000..75120856e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/structure_constructor_9.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! Check for notify-std-messages when F2003 structure constructors are compiled
+! with -std=f95.
+
+PROGRAM test
+  IMPLICIT NONE
+
+  ! Basic type with default initializers
+  TYPE :: basics_t
+    INTEGER :: i = 42
+    REAL :: r = 1.5
+  END TYPE basics_t
+
+  TYPE(basics_t) :: basics
+
+  ! This is ok in F95
+  basics = basics_t (1, 2.)
+
+  ! No argument naming in F95
+  basics = basics_t (1, r = 4.2) ! { dg-error "Fortran 2003" }
+
+  ! No optional arguments in F95
+  basics = basics_t () ! { dg-error "Fortran 2003" }
+  basics = basics_t (5) ! { dg-error "Fortran 2003" }
+
+END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/subnormal_1.f90 b/gcc/testsuite/gfortran.dg/subnormal_1.f90
new file mode 100644
index 000000000..4fbde5807
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/subnormal_1.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! { dg-options "-Wno-underflow" }
+! Check that the chopping of bits of subnormal numbers works.
+!
+program chop
+  real x
+  x = 1.
+  if (tiny(x)/2. /= tiny(x)/2. - (nearest(tiny(x),1.) - tiny(x))/2.) then
+    call abort
+  end if
+end program chop
diff --git a/gcc/testsuite/gfortran.dg/subref_array_pointer_1.f90 b/gcc/testsuite/gfortran.dg/subref_array_pointer_1.f90
new file mode 100644
index 000000000..7bb0ff5e6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/subref_array_pointer_1.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+! Test the fix for PRs29396, 29606, 30625 and 30871, in which pointers
+! to arrays with subreferences did not work.
+!
+  call pr29396
+  call pr29606
+  call pr30625
+  call pr30871
+contains
+  subroutine pr29396
+! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+    CHARACTER(LEN=2), DIMENSION(:), POINTER :: a 
+    CHARACTER(LEN=4), DIMENSION(3), TARGET :: b 
+    b=(/"bbbb","bbbb","bbbb"/) 
+    a=>b(:)(2:3) 
+    a="aa" 
+    IF (ANY(b.NE.(/"baab","baab","baab"/))) CALL ABORT() 
+  END subroutine
+
+  subroutine pr29606
+! Contributed by Daniel Franke <franke.daniel@gmail.com> 
+    TYPE foo
+      INTEGER :: value
+    END TYPE
+    TYPE foo_array
+      TYPE(foo), DIMENSION(:), POINTER :: array
+    END TYPE
+    TYPE(foo_array)                :: array_holder
+    INTEGER, DIMENSION(:), POINTER :: array_ptr
+    ALLOCATE( array_holder%array(3) )
+    array_holder%array = (/ foo(1), foo(2), foo(3) /)
+    array_ptr => array_holder%array%value
+    if (any (array_ptr .ne. (/1,2,3/))) call abort ()
+  END subroutine
+
+  subroutine pr30625
+! Contributed by Paul Thomas <pault@gcc.gnu.org> 
+    type :: a
+      real :: r = 3.14159
+      integer :: i = 42
+    end type a
+    type(a), target :: dt(2)
+    integer, pointer :: ip(:)
+    ip => dt%i
+    if (any (ip .ne. 42)) call abort ()
+  end subroutine
+
+  subroutine pr30871
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk> 
+    TYPE data
+      CHARACTER(LEN=3) :: A
+    END TYPE
+    TYPE(data), DIMENSION(10), TARGET :: Z
+    CHARACTER(LEN=1), DIMENSION(:), POINTER :: ptr
+    Z(:)%A="123"
+    ptr=>Z(:)%A(2:2)
+    if (any (ptr .ne. "2")) call abort ()
+  END subroutine
+end
diff --git a/gcc/testsuite/gfortran.dg/subref_array_pointer_2.f90 b/gcc/testsuite/gfortran.dg/subref_array_pointer_2.f90
new file mode 100644
index 000000000..e96d75507
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/subref_array_pointer_2.f90
@@ -0,0 +1,103 @@
+! { dg-do run }
+! Test the fix for PRs29396, 29606, 30625 and 30871, in which pointers
+! to arrays with subreferences did not work.
+!
+  type :: t
+    real :: r
+    integer :: i
+    character(3) :: chr
+  end type t
+
+  type :: t2
+    real :: r(2, 2)
+    integer :: i
+    character(3) :: chr
+  end type t2
+
+  type :: s
+    type(t), pointer :: t(:)
+  end type s
+
+  integer, parameter :: sh(2) = (/2,2/)
+  real, parameter :: a1(2,2) = reshape ((/1.0,2.0,3.0,4.0/),sh)
+  real, parameter :: a2(2,2) = reshape ((/5.0,6.0,7.0,8.0/),sh)
+
+  type(t), target :: tar1(2) = (/t(1.0, 2, "abc"), t(3.0, 4, "efg")/)
+  character(4), target :: tar2(2) = (/"abcd","efgh"/)
+  type(s), target :: tar3
+  character(2), target :: tar4(2) = (/"ab","cd"/)
+  type(t2), target :: tar5(2) = (/t2(a1, 2, "abc"), t2(a2, 4, "efg")/)
+
+  integer, pointer :: ptr(:)
+  character(2), pointer :: ptr2(:)
+  real, pointer :: ptr3(:)
+
+!_______________component subreference___________
+  ptr => tar1%i
+  ptr = ptr + 1              ! check the scalarizer is OK
+
+  if (any (ptr .ne. (/3, 5/))) call abort ()
+  if (any ((/ptr(1), ptr(2)/) .ne. (/3, 5/))) call abort ()
+  if (any (tar1%i .ne. (/3, 5/))) call abort ()
+
+! Make sure that the other components are not touched.
+  if (any (tar1%r .ne. (/1.0, 3.0/))) call abort ()
+  if (any (tar1%chr .ne. (/"abc", "efg"/))) call abort ()
+
+! Check that the pointer is passed correctly as an actual argument.
+  call foo (ptr)
+  if (any (tar1%i .ne. (/2, 4/))) call abort ()
+
+! And that dummy pointers are OK too.
+  call bar (ptr)
+  if (any (tar1%i .ne. (/101, 103/))) call abort ()
+
+!_______________substring subreference___________
+  ptr2 => tar2(:)(2:3)
+  ptr2 = ptr2(:)(2:2)//"z"   ! again, check the scalarizer
+
+  if (any (ptr2 .ne. (/"cz", "gz"/))) call abort ()
+  if (any ((/ptr2(1), ptr2(2)/) .ne. (/"cz", "gz"/))) call abort ()
+  if (any (tar2 .ne. (/"aczd", "egzh"/))) call abort ()
+
+!_______________substring component subreference___________
+  ptr2 => tar1(:)%chr(1:2)
+  ptr2 = ptr2(:)(2:2)//"q"   ! yet again, check the scalarizer
+  if (any (ptr2 .ne. (/"bq","fq"/))) call abort ()
+  if (any (tar1%chr .ne. (/"bqc","fqg"/))) call abort ()
+
+!_______________trailing array element subreference___________
+  ptr3 => tar5%r(1,2)
+  ptr3 = (/99.0, 999.0/)
+  if (any (tar5(1)%r .ne. reshape ((/1.0,2.0,99.0,4.0/), sh))) call abort ()
+  if (any (tar5(2)%r .ne. reshape ((/5.0,6.0,999.0,8.0/), sh))) call abort ()
+
+!_______________forall assignment___________
+  ptr2 => tar2(:)(1:2)
+  forall (i = 1:2) ptr2(i)(1:1) = "z"
+  if (any (tar2 .ne. (/"zczd", "zgzh"/))) call abort ()
+
+!_______________something more complicated___________
+  tar3%t => tar1
+  ptr3 => tar3%t%r
+  ptr3 = cos (ptr3)
+  if (any (abs(ptr3 - (/cos(1.0_4), cos(3.0_4)/)) >= epsilon(1.0_4))) call abort ()
+
+  ptr2 => tar3%t(:)%chr(2:3)
+  ptr2 = " x"
+  if (any (tar1%chr .ne. (/"b x", "f x"/))) call abort ()
+
+!_______________check non-subref works still___________
+  ptr2 => tar4
+  if (any (ptr2 .ne. (/"ab","cd"/))) call abort ()
+
+contains
+  subroutine foo (arg)
+    integer :: arg(:)
+    arg = arg - 1
+  end subroutine
+  subroutine bar (arg)
+    integer, pointer :: arg(:)
+    arg = arg + 99
+  end subroutine
+end
diff --git a/gcc/testsuite/gfortran.dg/subref_array_pointer_3.f90 b/gcc/testsuite/gfortran.dg/subref_array_pointer_3.f90
new file mode 100644
index 000000000..b345c9d6b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/subref_array_pointer_3.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! Tests the fix for PR35470, in which the pointer assignment would fail
+! because the assumed size 'arr' would get mixed up with the component
+! 'p' in the check for the upper bound of an assumed size array.
+!
+! Contributed by Antony Lewis <antony@cosmologist.info>
+!
+subroutine sub(arr)
+  type real_pointer
+    real, pointer :: p(:)
+  end type real_pointer
+  type(real_pointer), dimension(*) :: arr
+  real, pointer :: p(:)
+  p => arr(1)%p
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/subref_array_pointer_4.f90 b/gcc/testsuite/gfortran.dg/subref_array_pointer_4.f90
new file mode 100644
index 000000000..19edfdca9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/subref_array_pointer_4.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! Tests the fix for PR42309, in which the indexing of 'Q'
+! was off by one.
+!
+! Contributed by Gilbert Scott <gilbert.scott@easynet.co.uk>
+!
+PROGRAM X
+  TYPE T
+    INTEGER :: I
+    REAL :: X
+  END TYPE T
+  TYPE(T), TARGET :: T1(0:3)
+  INTEGER, POINTER :: P(:)
+  REAL :: SOURCE(4) = [10., 20., 30., 40.]
+
+  T1%I = [1, 2, 3, 4]
+  T1%X = SOURCE
+  P => T1%I
+  CALL Z(P)
+  IF (ANY (T1%I .NE. [999, 2, 999, 4])) CALL ABORT
+  IF (ANY (T1%X .NE. SOURCE)) CALL ABORT
+CONTAINS
+  SUBROUTINE Z(Q)
+    INTEGER, POINTER :: Q(:)
+    Q(1:3:2) = 999
+  END SUBROUTINE Z
+END PROGRAM X
+
diff --git a/gcc/testsuite/gfortran.dg/substr_1.f90 b/gcc/testsuite/gfortran.dg/substr_1.f90
new file mode 100644
index 000000000..a811d9688
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/substr_1.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! we used to save the wrong components of a gfc_expr describing a
+! substring of a constant string.  This yielded a segfault on
+! translating the expressions read from the module.
+module m
+  character (*), parameter :: a = "AABBCC"(1:4)
+end module m
+
+use m
+character(4) :: b
+b = a
+end
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/substr_2.f b/gcc/testsuite/gfortran.dg/substr_2.f
new file mode 100644
index 000000000..a7e43b635
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/substr_2.f
@@ -0,0 +1,24 @@
+! { dg-do run }
+! Check that substrings behave correctly even when zero-sized
+      implicit none
+      character(len=10) :: s, t
+      integer :: i, j
+
+      s = "abcdefghij"
+      t(:10) = s(1:)
+      s(6:5) = "foo"
+      if (s /= t) call abort
+      i = 2
+      j = -1
+      s(i:i+j) = "foo"
+      if (s /= t) call abort
+      i = 20
+      s(i+1:i) = "foo"
+      if (s /= t) call abort
+      s(6:5) = s(7:5)
+      if (s /= t) call abort
+      s = t(7:6)
+      if (len(trim(s)) /= 0) call abort
+      if (len(t(8:4)) /= 0) call abort
+      if (len(trim(t(8:4))) /= 0) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/substr_3.f b/gcc/testsuite/gfortran.dg/substr_3.f
new file mode 100644
index 000000000..3bb71972f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/substr_3.f
@@ -0,0 +1,12 @@
+! { dg-do run }
+! Check that substrings behave correctly even when zero-sized
+      implicit none
+      character(len=10) :: s, t
+      integer :: i, j
+
+      s = "abcdefghij"
+      t(:10) = s(1:)
+      s(16:15) = "foo"
+      s(0:-1) = "foo"
+      if (s /= t) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/substr_4.f b/gcc/testsuite/gfortran.dg/substr_4.f
new file mode 100644
index 000000000..fadd5b32d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/substr_4.f
@@ -0,0 +1,69 @@
+! { dg-do run }
+      subroutine test_lower
+      implicit none
+      character(3), dimension(3) :: zsymel,zsymelr
+      common /xx/ zsymel, zsymelr
+      integer :: znsymelr
+      zsymel = (/ 'X', 'Y', ' ' /)
+      zsymelr= (/ 'X', 'Y', ' ' /)
+      znsymelr=2
+      call check_zsymel(zsymel,zsymelr,znsymelr)
+
+      contains
+
+      subroutine check_zsymel(zsymel,zsymelr,znsymelr)
+        implicit none
+        integer znsymelr, isym
+        character(*) zsymel(*),zsymelr(*)
+        character(len=80) buf
+        zsymel(3)(lenstr(zsymel(3))+1:)='X'
+        write (buf,10) (trim(zsymelr(isym)),isym=1,znsymelr)
+10      format(3(a,:,','))
+        if (trim(buf) /= 'X,Y') call abort
+      end subroutine check_zsymel
+
+      function lenstr(s)
+        character(len=*),intent(in) :: s
+        integer :: lenstr
+        if (len_trim(s) /= 0) call abort
+        lenstr = len_trim(s)
+      end function lenstr
+
+      end subroutine test_lower
+
+      subroutine test_upper
+      implicit none
+      character(3), dimension(3) :: zsymel,zsymelr
+      common /xx/ zsymel, zsymelr
+      integer :: znsymelr
+      zsymel = (/ 'X', 'Y', ' ' /)
+      zsymelr= (/ 'X', 'Y', ' ' /)
+      znsymelr=2
+      call check_zsymel(zsymel,zsymelr,znsymelr)
+
+      contains
+
+      subroutine check_zsymel(zsymel,zsymelr,znsymelr)
+        implicit none
+        integer znsymelr, isym
+        character(*) zsymel(*),zsymelr(*)
+        character(len=80) buf
+        zsymel(3)(:lenstr(zsymel(3))+1)='X'
+        write (buf,20) (trim(zsymelr(isym)),isym=1,znsymelr)
+20      format(3(a,:,','))
+        if (trim(buf) /= 'X,Y') call abort
+      end subroutine check_zsymel
+
+      function lenstr(s)
+        character(len=*),intent(in) :: s
+        integer :: lenstr
+        if (len_trim(s) /= 0) call abort
+        lenstr = len_trim(s)
+      end function lenstr
+
+      end subroutine test_upper
+
+      program test
+        call test_lower
+        call test_upper
+      end program test
diff --git a/gcc/testsuite/gfortran.dg/substr_5.f90 b/gcc/testsuite/gfortran.dg/substr_5.f90
new file mode 100644
index 000000000..fb409ead9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/substr_5.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+!
+  character(*), parameter  :: chrs = '-+.0123456789eEdD'
+  character(*), parameter  :: expr = '-+.0123456789eEdD'
+  integer :: i
+
+  if (index(chrs(:), expr) /= 1) call abort
+  if (index(chrs(14:), expr) /= 0) call abort
+  if (index(chrs(:12), expr) /= 0) call abort
+  if (index(chrs, expr(:)) /= 1) call abort
+  if (index(chrs, expr(1:)) /= 1) call abort
+  if (index(chrs, expr(:1)) /= 1) call abort
+
+  if (foo(expr) /= 1) call abort
+  if (foo(expr) /= 1) call abort
+  if (foo(expr) /= 1) call abort
+  if (foo(expr(:)) /= 1) call abort
+  if (foo(expr(1:)) /= 1) call abort
+  if (foo(expr(:1)) /= 1) call abort
+
+  call bar(expr)
+
+contains
+  subroutine bar(expr)
+    character(*), intent(in) :: expr
+    character(*), parameter  :: chrs = '-+.0123456789eEdD'
+    integer :: foo
+
+    if (index(chrs(:), expr) /= 1) call abort
+    if (index(chrs(14:), expr) /= 0) call abort
+    if (index(chrs(:12), expr) /= 0) call abort
+    if (index(chrs, expr(:)) /= 1) call abort
+    if (index(chrs, expr(1:)) /= 1) call abort
+    if (index(chrs, expr(:1)) /= 1) call abort
+  end subroutine bar
+
+  integer function foo(expr)
+    character(*), intent(in) :: expr
+    character(*), parameter  :: chrs = '-+.0123456789eEdD'
+
+    foo = index(chrs, expr)
+  end function foo
+
+end
diff --git a/gcc/testsuite/gfortran.dg/substr_6.f90 b/gcc/testsuite/gfortran.dg/substr_6.f90
new file mode 100644
index 000000000..813a02521
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/substr_6.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-std=legacy" }
+!
+! Check that NULs don't mess up constant substring simplification
+CHARACTER(5), parameter :: c0(1) = (/ "123" // ACHAR(0) // "5" /)
+CHARACTER*5 c(1)
+CHARACTER(1), parameter :: c1(5) = (/ "1", "2", "3", ACHAR(0), "5" /)
+
+c = c0(1)(-5:-8)
+if (c(1) /= "     ") call abort()
+c = (/ c0(1)(1:5) /)
+do i=1,5
+   if (c(1)(i:i) /= c1(i)) call abort()
+end do
+print *, c(1)
+end
diff --git a/gcc/testsuite/gfortran.dg/substring_equivalence.f90 b/gcc/testsuite/gfortran.dg/substring_equivalence.f90
new file mode 100644
index 000000000..9a94bcddf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/substring_equivalence.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! Tests fix for PR24223 - ICE on equivalence statement.
+!
+module FLAGS
+  character(len=5) :: Encodings
+  character :: at, dev
+  equivalence ( encodings(1:1),at ), ( encodings(2:2),dev)
+end module FLAGS
+
+! { dg-final { cleanup-modules "FLAGS" } }
diff --git a/gcc/testsuite/gfortran.dg/sum_init_expr.f03 b/gcc/testsuite/gfortran.dg/sum_init_expr.f03
new file mode 100644
index 000000000..f0cfe958b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/sum_init_expr.f03
@@ -0,0 +1,66 @@
+! { dg-do run }
+! { dg-options "-fno-inline" }
+!
+! SUM as initialization expression.
+!
+! This test compares results of simplifier of SUM 
+! with the corresponding inlined or library routine(s).
+!
+
+  IMPLICIT NONE
+
+  INTEGER, PARAMETER :: imatrix(2,4) = RESHAPE ([ 1, 2, 3, 4, 5, 6, 7, 8 ], [2, 4] )
+  INTEGER, PARAMETER :: imatrix_sum = SUM (imatrix)
+  INTEGER, PARAMETER :: imatrix_sum_d1(4) = SUM (imatrix, dim=1)
+  INTEGER, PARAMETER :: imatrix_sum_d2(2) = SUM (imatrix, dim=2)
+  LOGICAL, PARAMETER :: i_equal_sum = ALL ([SUM( imatrix_sum_d1 ) ==  SUM ( imatrix_sum_d2 ), &
+                                            SUM( imatrix_sum_d1 ) == imatrix_sum])
+  LOGICAL, PARAMETER :: i_empty_sum = SUM(imatrix, mask=.FALSE.) == 0
+
+  REAL, PARAMETER :: rmatrix(2,4) = RESHAPE ([ 1.1, 2.2, 3.3, 4.4, 5.5, 6.6, 7.7, 8.8 ], [2, 4] )
+  REAL, PARAMETER :: rmatrix_sum = SUM (rmatrix)
+  REAL, PARAMETER :: rmatrix_sum_d1(4) = SUM (rmatrix, dim=1)
+  REAL, PARAMETER :: rmatrix_sum_d2(2) = SUM (rmatrix, dim=2)
+  LOGICAL, PARAMETER :: r_equal_sum = ALL ([SUM( rmatrix_sum_d1 ) ==  SUM ( rmatrix_sum_d2 ), &
+                                            SUM( rmatrix_sum_d1 ) == rmatrix_sum])
+  LOGICAL, PARAMETER :: r_empty_sum = SUM(rmatrix, mask=.FALSE.) == 0.0
+
+  IF (.NOT. ALL ([i_equal_sum, i_empty_sum])) CALL abort()
+  IF (.NOT. ALL ([r_equal_sum, r_empty_sum])) CALL abort()
+
+  CALL ilib (imatrix, imatrix_sum)
+  CALL ilib_with_dim (imatrix, 1, imatrix_sum_d1)
+  CALL ilib_with_dim (imatrix, 2, imatrix_sum_d2)
+  CALL rlib (rmatrix, rmatrix_sum)
+  CALL rlib_with_dim (rmatrix, 1, rmatrix_sum_d1)
+  CALL rlib_with_dim (rmatrix, 2, rmatrix_sum_d2)
+
+CONTAINS
+  SUBROUTINE ilib (array, result)
+    INTEGER, DIMENSION(:,:), INTENT(in) :: array
+    INTEGER, INTENT(in) :: result
+    IF (SUM(array) /= result) CALL abort()
+  END SUBROUTINE
+
+  SUBROUTINE ilib_with_dim (array, dim, result)
+    INTEGER, DIMENSION(:,:), INTENT(in) :: array
+    INTEGER, INTENT(iN)                 :: dim
+    INTEGER, DIMENSION(:), INTENT(in)   :: result
+    IF (ANY (SUM (array, dim=dim) /= result)) CALL abort()
+  END SUBROUTINE
+
+  SUBROUTINE rlib (array, result)
+    REAL, DIMENSION(:,:), INTENT(in) :: array
+    REAL, INTENT(in) :: result
+    IF (ABS(SUM(array) - result) > 4e-6) CALL abort()
+  END SUBROUTINE
+
+  SUBROUTINE rlib_with_dim (array, dim, result)
+    REAL, DIMENSION(:,:), INTENT(in) :: array
+    INTEGER, INTENT(iN)              :: dim
+    REAL, DIMENSION(:), INTENT(in)   :: result
+    IF (ANY (ABS(SUM (array, dim=dim) - result) > 4e-6)) CALL abort()
+  END SUBROUTINE
+END
+
+
diff --git a/gcc/testsuite/gfortran.dg/sum_zero_array_1.f90 b/gcc/testsuite/gfortran.dg/sum_zero_array_1.f90
new file mode 100644
index 000000000..b864bbf71
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/sum_zero_array_1.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! PR 30321:  This used to segfault.
+program xzero
+  implicit none
+  integer :: ii(1,0)
+  logical :: ll(1,0)
+  character (len=80) line
+  ll = .true.
+  write (unit=line, fmt="(I6)") sum(ii,dim=1)
+  if (line /= " ") call abort
+  write (unit=line, fmt="(I6)") sum(ii,dim=1,mask=ll)
+  if (line /= " ") call abort
+end program xzero
diff --git a/gcc/testsuite/gfortran.dg/t_editing.f b/gcc/testsuite/gfortran.dg/t_editing.f
new file mode 100644
index 000000000..6121e8584
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/t_editing.f
@@ -0,0 +1,8 @@
+! { dg-do run }     
+! PR25349 Check T editing. Test case from PR submitted by Thomas Koenig
+! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+      program main
+      character(len=10) line
+      write (line,'(1X,A,T1,A)') 'A','B'
+      if (line.ne.'BA') call abort()
+      end
diff --git a/gcc/testsuite/gfortran.dg/tab_continuation.f b/gcc/testsuite/gfortran.dg/tab_continuation.f
new file mode 100644
index 000000000..448cd2086
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/tab_continuation.f
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+! PR fortran/34899
+!
+! Allow <tab>1 to <tab>9 as continuation marker, which is a very common
+! vendor extension.
+!
+	PARAMETER (LUMIN=11,LUMAX=20,MAPMAX=256,NPLANEMAX=999)
+	INTEGER NAXIS(0:MAPMAX,LUMIN:LUMAX),NAXIS1(0:MAPMAX,LUMIN:LUMAX),
+	1NAXIS2(0:MAPMAX,LUMIN:LUMAX),NAXIS3(0:MAPMAX,LUMIN:LUMAX)
+	end
+! { dg-warning "Nonconforming tab character in column 1 of line 8" "Nonconforming tab" {target "*-*-*"} 0 }
+! { dg-warning "Nonconforming tab character in column 1 of line 9" "Nonconforming tab" {target "*-*-*"} 0 }
+! { dg-warning "Nonconforming tab character in column 1 of line 10" "Nonconforming tab" {target "*-*-*"} 0 }
+! { dg-warning "Nonconforming tab character in column 1 of line 11" "Nonconforming tab" {target "*-*-*"} 0 }
diff --git a/gcc/testsuite/gfortran.dg/temporary_1.f90 b/gcc/testsuite/gfortran.dg/temporary_1.f90
new file mode 100644
index 000000000..7bdf08d29
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/temporary_1.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! PR 27662. Don't zero the first stride to indicate a temporary. It
+! may be used later.
+program pr27662
+ implicit none
+ real(kind=kind(1.0d0)), dimension (2, 2):: x, y, z;
+ integer i, j
+ x(1,1) = 1.d0 
+ x(2,1) = 0.d0
+ x(1,2) = 0.d0
+ x(2,2) = 1.d0 
+ z = matmul (x, transpose (test ()))
+ do i = 1, size (x, 1)
+   do j = 1, size (x, 2)
+     if (x (i, j) .ne. z (i, j)) call abort ()
+   end do
+ end do
+
+contains
+ function test () result (res)
+   real(kind=kind(1.0d0)), dimension(2,2) :: res
+   res(1,1) = 1.d0 
+   res(2,1) = 0.d0
+   res(1,2) = 0.d0
+   res(2,2) = 1.d0 
+ end function
+end
diff --git a/gcc/testsuite/gfortran.dg/test_bind_c_parens.f03 b/gcc/testsuite/gfortran.dg/test_bind_c_parens.f03
new file mode 100644
index 000000000..ee7b6a8ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/test_bind_c_parens.f03
@@ -0,0 +1,7 @@
+! { dg-do compile }
+module test_bind_c_parens
+  interface
+     subroutine sub bind(c) ! { dg-error "Missing required parentheses" }
+     end subroutine sub ! { dg-error "Expecting END INTERFACE" }
+  end interface
+end module test_bind_c_parens 
diff --git a/gcc/testsuite/gfortran.dg/test_c_assoc.c b/gcc/testsuite/gfortran.dg/test_c_assoc.c
new file mode 100644
index 000000000..aa6571874
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/test_c_assoc.c
@@ -0,0 +1,55 @@
+/* use 0 for NULL so no need for system header */
+
+int test_c_assoc_0(void *my_c_ptr);
+int test_c_assoc_1(void *my_c_ptr_1, void *my_c_ptr_2);
+int test_c_assoc_2(void *my_c_ptr_1, void *my_c_ptr_2, int num_ptrs);
+void verify_assoc(void *my_c_ptr_1, void *my_c_ptr_2);
+
+extern void abort(void);
+
+int main(int argc, char **argv)
+{
+   int i;
+   int j;
+   
+   if(test_c_assoc_0(0) != 0)
+      abort();
+
+   if(test_c_assoc_0(&i) != 1)
+      abort();
+
+   if(test_c_assoc_1(0, 0) != 0)
+      abort();
+
+   if(test_c_assoc_1(0, &i) != 0)
+      abort();
+   
+   if(test_c_assoc_1(&i, &i) != 1)
+      abort();
+
+   if(test_c_assoc_1(&i, 0) != 0)
+      abort();
+
+   if(test_c_assoc_1(&i, &j) != 0)
+      abort();
+
+   /* this should be associated, cause only testing 1 ptr (i) */
+   if(test_c_assoc_2(&i, 0, 1) != 1)
+      abort();
+
+   /* this should be associated */
+   if(test_c_assoc_2(&i, &i, 2) != 1)
+      abort();
+
+   /* this should not be associated (i) */
+   if(test_c_assoc_2(&i, &j, 2) != 0)
+      abort();
+
+   /* this should be associated, cause only testing 1 ptr (i) */
+   if(test_c_assoc_2(&i, &j, 1) != 1)
+      abort();
+
+   verify_assoc(&i, &i);
+   
+   return 0;
+}/* end main() */
diff --git a/gcc/testsuite/gfortran.dg/test_com_block.f90 b/gcc/testsuite/gfortran.dg/test_com_block.f90
new file mode 100644
index 000000000..37175d265
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/test_com_block.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+module nonF03ComBlock
+  common /NONF03COM/ r, s
+  real :: r
+  real :: s
+  
+  contains
+    
+    subroutine hello(myArray)
+      integer, dimension(:) :: myArray
+
+      r = 1.0
+      s = 2.0
+    end subroutine hello
+end module nonF03ComBlock
+
+program testComBlock
+  use nonF03ComBlock
+  integer, dimension(1:10) :: myArray
+
+  call hello(myArray)
+
+  ! these are set in the call to hello() above
+  ! r and s are reals (default size) in com block, set to 
+  ! 1.0 and 2.0, respectively, in hello()
+  if(r .ne. 1.0) then 
+     call abort()
+  endif
+  if(s .ne. 2.0) then
+     call abort()
+  endif
+end program testComBlock
+
+! { dg-final { cleanup-modules "nonf03comblock" } }
diff --git a/gcc/testsuite/gfortran.dg/test_common_binding_labels.f03 b/gcc/testsuite/gfortran.dg/test_common_binding_labels.f03
new file mode 100644
index 000000000..ea9a59a35
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/test_common_binding_labels.f03
@@ -0,0 +1,42 @@
+! { dg-do compile }
+module x
+  use, intrinsic :: iso_c_binding, only: c_double
+  implicit none
+
+  common /mycom/ r, s ! { dg-error "does not match" }
+  real(c_double) :: r
+  real(c_double) :: s
+  bind(c, name="my_common_block") :: /mycom/
+end module x
+
+module y
+  use, intrinsic :: iso_c_binding, only: c_double, c_int
+  implicit none
+  
+  common /mycom/ r, s
+  real(c_double) :: r
+  real(c_double) :: s
+  bind(c, name="my_common_block") :: /mycom/
+
+  common /com2/ i ! { dg-error "does not match" }
+  integer(c_int) :: i
+  bind(c, name="") /com2/
+end module y
+
+module z
+  use, intrinsic :: iso_c_binding, only: c_double, c_int
+  implicit none
+  
+  common /mycom/ r, s ! { dg-error "does not match" }
+  real(c_double) :: r
+  real(c_double) :: s
+  ! this next line is an error; if a common block is bind(c), the binding label
+  ! for it must match across all scoping units that declare it.
+  bind(c, name="my_common_block_2") :: /mycom/ 
+
+  common /com2/ i ! { dg-error "does not match" }
+  integer(c_int) :: i
+  bind(c, name="mycom2") /com2/
+end module z
+
+! { dg-final { cleanup-modules "x y" } }
diff --git a/gcc/testsuite/gfortran.dg/test_common_binding_labels_2.f03 b/gcc/testsuite/gfortran.dg/test_common_binding_labels_2.f03
new file mode 100644
index 000000000..d14c9b116
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/test_common_binding_labels_2.f03
@@ -0,0 +1,15 @@
+! { dg-do compile }
+module test_common_binding_labels_2
+  use, intrinsic :: iso_c_binding, only: c_double, c_int
+  implicit none
+  
+  common /mycom/ r, s
+  real(c_double) :: r
+  real(c_double) :: s
+  bind(c, name="my_common_block") :: /mycom/
+
+  common /com2/ i 
+  integer(c_int) :: i
+  bind(c, name="") /com2/
+end module test_common_binding_labels_2
+
diff --git a/gcc/testsuite/gfortran.dg/test_common_binding_labels_2_main.f03 b/gcc/testsuite/gfortran.dg/test_common_binding_labels_2_main.f03
new file mode 100644
index 000000000..1b4103ef4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/test_common_binding_labels_2_main.f03
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! This file depends on the module test_common_binding_labels_2.  That module
+! must be compiled first and not be removed until after this test.
+module test_common_binding_labels_2_main
+  use, intrinsic :: iso_c_binding, only: c_double, c_int
+  implicit none
+  
+  common /mycom/ r, s ! { dg-error "does not match" }
+  real(c_double) :: r
+  real(c_double) :: s
+  ! this next line is an error; if a common block is bind(c), the binding label
+  ! for it must match across all scoping units that declare it.
+  bind(c, name="my_common_block_2") :: /mycom/ 
+
+  common /com2/ i ! { dg-error "does not match" }
+  integer(c_int) :: i
+  bind(c, name="mycom2") /com2/
+end module test_common_binding_labels_2_main
+
+program main
+  use test_common_binding_labels_2 ! { dg-error "does not match" }
+  use test_common_binding_labels_2_main
+end program main
+
+! { dg-final { cleanup-modules "test_common_binding_labels_2_main test_common_binding_labels_2" } }
diff --git a/gcc/testsuite/gfortran.dg/test_common_binding_labels_3.f03 b/gcc/testsuite/gfortran.dg/test_common_binding_labels_3.f03
new file mode 100644
index 000000000..87d6c6b78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/test_common_binding_labels_3.f03
@@ -0,0 +1,10 @@
+! { dg-do compile }
+module test_common_binding_labels_3
+  use, intrinsic :: iso_c_binding, only: c_double
+  implicit none
+  
+  common /mycom/ r, s
+  real(c_double) :: r
+  real(c_double) :: s
+  bind(c, name="my_common_block") :: /mycom/
+end module test_common_binding_labels_3
diff --git a/gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03 b/gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03
new file mode 100644
index 000000000..d2c67f651
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! This file depends on the module test_common_binding_labels_3.  That module
+! must be compiled first and not be removed until after this test.
+module test_common_binding_labels_3_main
+  use, intrinsic :: iso_c_binding, only: c_int
+  integer(c_int), bind(c, name="my_common_block") :: my_int ! { dg-error "collides" }
+end module test_common_binding_labels_3_main
+
+program main
+  use test_common_binding_labels_3_main
+  use test_common_binding_labels_3 ! { dg-error "collides" }
+end program main
+
+! { dg-final { cleanup-modules "test_common_binding_labels_3_main test_common_binding_labels_3" } }
diff --git a/gcc/testsuite/gfortran.dg/test_only_clause.f90 b/gcc/testsuite/gfortran.dg/test_only_clause.f90
new file mode 100644
index 000000000..a02a75922
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/test_only_clause.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-additional-sources only_clause_main.c }
+module testOnlyClause
+
+  contains
+    subroutine testOnly(cIntPtr) bind(c, name="testOnly")
+      use, intrinsic :: iso_c_binding, only: c_ptr, c_int, c_f_pointer
+      implicit none
+      type(c_ptr), value :: cIntPtr
+      integer(c_int), pointer :: f90IntPtr
+      
+      call c_f_pointer(cIntPtr, f90IntPtr)
+
+      ! f90IntPtr coming in has value of -11; this will make it -12
+      f90IntPtr = f90IntPtr - 1
+      if(f90IntPtr .ne. -12) then
+         call abort()
+      endif
+    end subroutine testOnly
+end module testOnlyClause
+
+! { dg-final { cleanup-modules "testonlyclause" } }
diff --git a/gcc/testsuite/gfortran.dg/tiny_1.f90 b/gcc/testsuite/gfortran.dg/tiny_1.f90
new file mode 100644
index 000000000..e8bfb2d89
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/tiny_1.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! Test program inspired by bug report from Walt Brainerd.
+! http://gcc.gnu.org/ml/fortran/2005-04/msg00132.html
+program tiny1
+  real(4) x4
+  real(8) x8
+  if (minexponent(x4) /= exponent(tiny(x4))) call abort
+  if (minexponent(x8) /= exponent(tiny(x8))) call abort
+end program tiny1
diff --git a/gcc/testsuite/gfortran.dg/tiny_2.f90 b/gcc/testsuite/gfortran.dg/tiny_2.f90
new file mode 100644
index 000000000..194e6cd31
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/tiny_2.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+program tiny2
+  real(4) x4
+  real(8) x8
+  x4 = tiny(x4)
+  x8 = tiny(x8)
+  if (minexponent(x4) /= exponent(x4)) call abort
+  if (minexponent(x8) /= exponent(x8)) call abort
+end program tiny2
diff --git a/gcc/testsuite/gfortran.dg/tl_editing.f90 b/gcc/testsuite/gfortran.dg/tl_editing.f90
new file mode 100644
index 000000000..830c7eb71
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/tl_editing.f90
@@ -0,0 +1,35 @@
+! { dg-do run }     
+! { dg-options "-std=legacy" }
+!
+! Test of fix to bug triggered by NIST fm908.for.
+! Left tabbing, followed by X or T-tabbing to the right would
+! cause spaces to be overwritten on output data.
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+! PR25349 Revised by Jerry DeLisle <jvdelisle@gcc.gnu.org> 
+program tl_editting
+  character*10           ::  line, many(5), s
+  character*10           ::  aline = "abcdefxyij"
+  character*2            ::  bline = "gh"
+  character*10           ::  cline = "abcdefghij"
+
+! Character unit test
+  write (line, '(a10,tl6,2x,a2)') aline, bline
+  if (line.ne.cline) call abort ()
+
+! Character array unit test
+  many = "0123456789"
+  write(many(1:5:2), '(a10,tl6,2x,a2)') aline, bline, aline, bline, aline,&
+  &bline
+  if (many(1).ne.cline) call abort ()
+  if (many(3).ne.cline) call abort ()
+  if (many(5).ne.cline) call abort ()
+
+! File unit test
+  write (10, '(a10,tl6,2x,a2)') aline, bline
+  rewind(10)
+  read(10, '(a)') s
+  if (s.ne.cline) call abort
+  close(10, status='delete')
+  
+end program tl_editting
+
diff --git a/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_1.f90 b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_1.f90
new file mode 100644
index 000000000..0d828efa6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_1.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! Tests the patch to implement the array version of the TRANSFER
+! intrinsic (PR17298).
+
+! test the PR is fixed.
+
+   call test1 ()
+
+contains
+
+   subroutine test1 ()
+     complex(4) :: z = (1.0, 2.0)
+     real(4) :: cmp(2), a(4, 4)
+     integer(2) :: it(4, 2, 4), jt(32)
+
+! The PR testcase.
+
+     cmp = transfer (z, cmp) * 2.0
+     if (any (cmp .ne. (/2.0, 4.0/))) call abort ()
+
+   end subroutine test1
+
+end
diff --git a/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_2.f90 b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_2.f90
new file mode 100644
index 000000000..aaa10f8a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_2.f90
@@ -0,0 +1,119 @@
+! { dg-do run }
+! Tests the patch to implement the array version of the TRANSFER
+! intrinsic (PR17298).
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+
+! Bigendian test posted by Perseus in comp.lang.fortran on 4 July 2005.
+! Original had parameter but this fails, at present, if is_gimple_var with -Ox, x>0
+
+   LOGICAL :: bigend
+   integer :: icheck = 1
+
+   character(8) :: ch(2) = (/"lmnoPQRS","LMNOpqrs"/)
+
+   bigend = IACHAR(TRANSFER(icheck,"a")) == 0
+
+! tests numeric transfers other than original testscase.
+
+   call test1 ()
+
+! tests numeric/character transfers.
+
+   call test2 ()
+
+! Test dummies, automatic objects and assumed character length.
+
+   call test3 (ch, ch, ch, 8)
+
+contains
+
+   subroutine test1 ()
+     real(4) :: a(4, 4)
+     integer(2) :: it(4, 2, 4), jt(32)
+
+! Check multi-dimensional sources and that transfer works as an actual
+! argument of reshape.
+
+     a = reshape ((/(rand (), i = 1, 16)/), (/4,4/))
+     jt = transfer (a, it)
+     it = reshape (jt, (/4, 2, 4/))
+     if (any (reshape (transfer (it, a), (/4,4/)) .ne. a)) call abort ()
+
+   end subroutine test1
+
+   subroutine test2 ()
+     integer(4) :: y(4), z(2)
+     character(4) :: ch(4)
+
+! Allow for endian-ness
+     if (bigend) then
+       y = (/(i + 3 + ishft (i + 2, 8) + ishft (i + 1, 16) &
+                + ishft (i, 24), i = 65, 80 , 4)/)
+     else 
+       y = (/(i + ishft (i + 1, 8) + ishft (i + 2, 16) &
+                + ishft (i + 3, 24), i = 65, 80 , 4)/)
+     end if
+
+! Check source array sections in both directions.
+
+     ch = "wxyz"
+     ch(1:2) = transfer (y(2:4:2), ch)
+     if (any (ch(1:2) .ne. (/"EFGH","MNOP"/))) call abort ()
+     ch = "wxyz"
+     ch(1:2) = transfer (y(4:2:-2), ch)
+     if (any (ch(1:2) .ne. (/"MNOP","EFGH"/))) call abort ()
+
+! Check that a complete array transfers with size absent.
+
+     ch = transfer (y, ch)
+     if (any (ch .ne. (/"ABCD","EFGH","IJKL","MNOP"/))) call abort ()
+
+! Check that a character array section is OK
+
+     z = transfer (ch(2:3), y)
+     if (any (z .ne. y(2:3))) call abort ()
+
+! Check dest array sections in both directions.
+
+     ch = "wxyz"
+     ch(3:4) = transfer (y, ch, 2)
+     if (any (ch(3:4) .ne. (/"ABCD","EFGH"/))) call abort ()
+     ch = "wxyz"
+     ch(3:2:-1) = transfer (y, ch, 2)
+     if (any (ch(2:3) .ne. (/"EFGH","ABCD"/))) call abort ()
+
+! Make sure that character to numeric is OK.
+
+     ch = "wxyz"
+     ch(1:2) = transfer (y, ch, 2)
+     if (any (ch(1:2) .ne. (/"ABCD","EFGH"/))) call abort ()
+
+     z = transfer (ch, y)
+     if (any (y(1:2) .ne. z)) call abort ()
+
+   end subroutine test2
+
+   subroutine test3 (ch1, ch2, ch3, clen)
+     integer clen
+     character(8) :: ch1(:)
+     character(*) :: ch2(2)
+     character(clen) :: ch3(2)
+     character(8) :: cntrl(2) = (/"lmnoPQRS","LMNOpqrs"/)
+     integer(8) :: ic(2)
+     ic = transfer (cntrl, ic)
+
+! Check assumed shape.
+
+     if (any (ic .ne. transfer (ch1, ic))) call abort ()
+
+! Check assumed character length.
+
+     if (any (ic .ne. transfer (ch2, ic))) call abort ()
+
+! Check automatic character length.
+
+     if (any (ic .ne. transfer (ch3, ic))) call abort ()
+
+  end subroutine test3
+
+end
diff --git a/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_3.f90 b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_3.f90
new file mode 100644
index 000000000..b97e840a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_3.f90
@@ -0,0 +1,36 @@
+! { dg-do run }

+! Tests fix for PR31193, in which the character length for MOLD in

+! case 1 below was not being translated correctly for character

+! constants and an ICE ensued.  The further cases are either checks

+! or new bugs that were found in the course of development cases 3 & 5.

+!

+! Contributed by Brooks Moses <brooks@gcc.gnu.org>

+!

+function NumOccurances (string, chr, isel) result(n)

+  character(*),intent(in) :: string

+  character(1),intent(in) :: chr

+  integer :: isel

+!

+! return number of occurances of character in given string

+!

+    select case (isel)

+      case (1)

+      n=count(transfer(string, char(1), len(string))==chr)

+      case (2)

+      n=count(transfer(string, chr, len(string))==chr)

+      case (3)

+      n=count(transfer(string, "a", len(string))==chr)

+      case (4)

+      n=count(transfer(string, (/"a","b"/), len(string))==chr)

+      case (5)

+      n=count(transfer(string, string(1:1), len(string))==chr)

+    end select

+  return

+end

+

+  if (NumOccurances("abacadae", "a", 1) .ne. 4) call abort ()

+  if (NumOccurances("abacadae", "a", 2) .ne. 4) call abort ()

+  if (NumOccurances("abacadae", "a", 3) .ne. 4) call abort ()

+  if (NumOccurances("abacadae", "a", 4) .ne. 4) call abort ()

+  if (NumOccurances("abacadae", "a", 5) .ne. 4) call abort ()

+end

diff --git a/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_4.f90 b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_4.f90
new file mode 100644
index 000000000..3a929a814
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_4.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+! Tests patch for pr27155, where character scalar string_lengths
+! were not correctly translated by the array transfer intrinsic.
+!
+! Contributed by Bo Berggren  <bo.berggren@glocalnet.net>
+!
+program trf_test
+      implicit none
+      character(11) :: s1, s2
+      integer(4) :: ia(3)
+      integer(1) :: ba(12)
+      equivalence (ia, ba)
+
+      s1 = 'ABCDEFGHIJK'
+      ia = TRANSFER (s1, (/ 0_4 /))
+      s2 = TRANSFER(ba + 32_1, s2)
+
+      if (s2 .ne. 'abcdefghijk') call abort ()
+
+      s1 = 'AB'
+      ba = TRANSFER (trim (s1)//'       JK' , (/ 0_1 /))
+      s2 = TRANSFER(ia, s2)
+
+      if (trim (s1)//'       JK' .ne. s2) call abort ()
+
+end program trf_test
diff --git a/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_5.f90 b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_5.f90
new file mode 100644
index 000000000..c886b03f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_5.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! PR35680 - used to ICE because the argument of SIZE, being in a restricted
+! expression, was not checked if it too is restricted or is a variable. Since
+! it is neither, an error should be produced.
+!
+! Contributed by  Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!
+program main
+  print *, foo (), bar (), foobar ()
+contains
+  function foo ()
+    integer foo(size (transfer (x, [1])))     ! { dg-error "cannot appear" }
+    real x
+ end function
+  function bar()
+    real x
+    integer bar(size (transfer (x, [1])))     ! { dg-error "cannot appear" }
+ end function
+  function foobar()                           ! { dg-error "no IMPLICIT" }
+    implicit none
+    integer foobar(size (transfer (x, [1])))  ! { dg-error "used before" }
+    real x
+ end function
+end program
diff --git a/gcc/testsuite/gfortran.dg/transfer_assumed_size_1.f90 b/gcc/testsuite/gfortran.dg/transfer_assumed_size_1.f90
new file mode 100644
index 000000000..f42318816
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_assumed_size_1.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+! Tests the fix for the regression PR34080, in which the character
+! length of the assumed length arguments to TRANSFER were getting
+! lost.
+!
+! Drew McCormack <drewmccormack@mac.com>
+!
+module TransferBug
+   type ByteType
+      private
+      character(len=1)                                  :: singleByte
+   end type
+
+   type (ByteType), save                                :: BytesPrototype(1)
+
+contains
+
+   function StringToBytes(v) result (bytes)
+      character(len=*), intent(in)                      :: v
+      type (ByteType)                                   :: bytes(size(transfer(v, BytesPrototype)))
+      bytes = transfer(v, BytesPrototype)
+   end function
+
+   subroutine BytesToString(bytes, string)
+      type (ByteType), intent(in)                       :: bytes(:)
+      character(len=*), intent(out)                     :: string
+      character(len=1)                                  :: singleChar(1)
+      integer                                           :: numChars
+      numChars = size(transfer(bytes,singleChar))
+      string = ''
+      string = transfer(bytes, string)
+      string(numChars+1:) = ''
+   end subroutine
+
+end module
+
+
+program main
+   use TransferBug
+   character(len=100) :: str
+   call BytesToString( StringToBytes('Hi'), str )
+   if (trim(str) .ne. "Hi") call abort ()
+end program
+! { dg-final { cleanup-modules "TransferBug" } }
+
diff --git a/gcc/testsuite/gfortran.dg/transfer_check_1.f90 b/gcc/testsuite/gfortran.dg/transfer_check_1.f90
new file mode 100644
index 000000000..1a1f1a7e4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_check_1.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options -Wsurprising }
+! PR fortran/33037
+!
+print *, transfer('x', 0, 20) ! { dg-warning "has partly undefined result" }
+print *, transfer(1_1, 0) ! { dg-warning "has partly undefined result" }
+print *, transfer([1_2,2_2], 0)
+print *, transfer([1_2,2_2], 0_8) ! { dg-warning "has partly undefined result" }
+end
diff --git a/gcc/testsuite/gfortran.dg/transfer_hollerith_1.f90 b/gcc/testsuite/gfortran.dg/transfer_hollerith_1.f90
new file mode 100644
index 000000000..2ebff5a57
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_hollerith_1.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-O2" }
+! PR 31972, ICE in transfer of Hollerith constant
+  integer, dimension(1) :: i
+  integer :: j
+  i = (/ transfer(4HSOLR, 0) /)
+
+  j = transfer(0, 4HSOLR) ! { dg-error "must not be HOLLERITH" }
+end
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 6 }
+
+! { dg-warning "Hollerith constant" "const" { target *-*-* } 8 }
+
diff --git a/gcc/testsuite/gfortran.dg/transfer_intrinsic_1.f90 b/gcc/testsuite/gfortran.dg/transfer_intrinsic_1.f90
new file mode 100644
index 000000000..b82b9b040
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_intrinsic_1.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Check the fix for PR34955 in which three bytes would be copied
+! from bytes by TRANSFER, instead of the required two.
+!
+! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+subroutine BytesToString(bytes, string)
+    type ByteType
+      integer(kind=1) :: singleByte
+    end type
+    type (ByteType) :: bytes(2)
+    character(len=*) :: string
+    string = transfer(bytes, string)
+  end subroutine
+! { dg-final { scan-tree-dump-times "MIN_EXPR" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/transfer_intrinsic_2.f90 b/gcc/testsuite/gfortran.dg/transfer_intrinsic_2.f90
new file mode 100644
index 000000000..686c0605d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_intrinsic_2.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+!
+! Check the fix for PR34955 in which three bytes would be copied
+! from bytes by TRANSFER, instead of the required two and the
+! resulting string length would be incorrect.
+!
+! Contributed by Dominique Dhumieres  <dominiq@lps.ens.fr>
+!
+  character(len = 1)  :: string = "z"
+  character(len = 20) :: tmp = ""
+  tmp = Upper ("abcdefgh")
+  if (trim(tmp) .ne. "ab") call abort ()
+contains
+  Character (len = 20) Function Upper (string)
+    Character(len = *) string
+    integer :: ij
+    i = size (transfer (string,"xy",len (string)))
+    if (i /= len (string)) call abort ()
+    Upper = ""
+    Upper(1:2) = &
+    transfer (merge (transfer (string,"xy",len (string)),    &
+      string(1:2), .true.), "xy")
+    return
+  end function Upper
+end
diff --git a/gcc/testsuite/gfortran.dg/transfer_intrinsic_3.f90 b/gcc/testsuite/gfortran.dg/transfer_intrinsic_3.f90
new file mode 100644
index 000000000..f0b9b5468
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_intrinsic_3.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! Tests the fix for PR41772 in which the empty array reference
+! 'qname(1:n-1)' was not handled correctly in TRANSFER.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module m
+  implicit none
+contains
+  pure function str_vs(vs) result(s)
+    character, dimension(:), intent(in) :: vs
+    character(len=size(vs)) :: s
+    s = transfer(vs, s)
+  end function str_vs
+  subroutine has_key_ns(uri, localname, n)
+    character(len=*), intent(in) :: uri, localname
+    integer, intent(in) :: n
+    if ((n .lt. 2) .and. (len (uri) .ne. 0)) then
+      call abort
+    else IF ((n .ge. 2) .and. (len (uri) .ne. n - 1)) then 
+      call abort
+    end if
+  end subroutine
+end module m
+
+  use m
+  implicit none
+  character, dimension(:), pointer :: QName
+  integer :: n
+  allocate(qname(6))
+  qname = (/ 'a','b','c','d','e','f' /)
+
+  do n = 0, 3
+    call has_key_ns(str_vs(qname(1:n-1)),"", n)
+  end do
+  deallocate(qname)
+end
+! { dg-final { cleanup-modules "m" } }
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90 b/gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90
new file mode 100644
index 000000000..47be585a7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90
@@ -0,0 +1,50 @@
+! { dg-do run }
+!
+! PR fortran/56615
+!
+! Contributed by  Harald Anlauf
+!
+!
+program gfcbug
+  implicit none
+  integer, parameter             :: n = 8
+  integer                        :: i
+  character(len=1), dimension(n) :: a, b
+  character(len=n)               :: s, t
+  character(len=n/2)             :: u
+
+  do i = 1, n
+     a(i) = achar (i-1 + iachar("a"))
+  end do
+!  print *, "# Forward:"
+!  print *, "a=", a
+  s = transfer (a, s)
+!  print *, "s=", s
+  call cmp (a, s)
+!  print *, "  stride = +2:"
+  do i = 1, n/2
+     u(i:i) = a(2*i-1)
+  end do
+!  print *, "u=", u
+  call cmp (a(1:n:2), u)
+!  print *
+!  print *, "# Backward:"
+  b = a(n:1:-1)
+!  print *, "b=", b
+  t = transfer (b, t)
+!  print *, "t=", t
+  call cmp (b, t)
+!  print *, "  stride = -1:"
+  call cmp (a(n:1:-1), t)
+contains
+  subroutine cmp (b, s)
+    character(len=1), dimension(:), intent(in) :: b
+    character(len=*),               intent(in) :: s
+    character(len=size(b))                     :: c
+    c = transfer (b, c)
+    if (c /= s) then
+      print *, "c=", c, "    ", merge ("  ok","BUG!", c == s)
+      call abort ()
+    end if
+  end subroutine cmp
+end program gfcbug
diff --git a/gcc/testsuite/gfortran.dg/transfer_null_1.f90 b/gcc/testsuite/gfortran.dg/transfer_null_1.f90
new file mode 100644
index 000000000..7201a68b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_null_1.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! Test fix for pr38763, where NULL was not being encoded.
+!
+! Contributed by Steve Kargl <kargl@gcc.gnu.org> from a
+! posting by James van Buskirk on clf.
+!
+program sizetest
+   use ISO_C_BINDING
+   implicit none
+   integer, parameter :: ik1 = selected_int_kind(2)
+   TYPE vehicle_t1
+      INTEGER(C_INT), DIMENSION(:), ALLOCATABLE :: sensors
+   END TYPE vehicle_t1
+   type(vehicle_t1) gfortran_bug_workaround
+   integer i
+   i = size(transfer(vehicle_t1(NULL()),[0_ik1]))
+   print *, i
+   i = size(transfer(vehicle_t1([i]),[0_ik1]))
+   print *, i
+end program sizetest
diff --git a/gcc/testsuite/gfortran.dg/transfer_resolve_1.f90 b/gcc/testsuite/gfortran.dg/transfer_resolve_1.f90
new file mode 100644
index 000000000..8d326a186
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_resolve_1.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! PR40847 - an error in gfc_resolve_transfer caused the character length
+! of 'mold' to be set incorrectly.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+program test_elemental
+
+if (any (transfer_size((/0.,0./),(/'a','b'/)) .ne. [4 ,4])) call abort
+
+contains
+
+   elemental function transfer_size (source, mold)
+     real, intent(in)         :: source
+     character(*), intent(in) :: mold
+     integer                  :: transfer_size
+     transfer_size = SIZE(TRANSFER(source, (/mold/)))
+     return
+   end function transfer_size
+
+end program test_elemental
diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_1.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_1.f90
new file mode 100644
index 000000000..4f92121a5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_simplify_1.f90
@@ -0,0 +1,88 @@
+! { dg-do run }
+! { dg-options "-O2" }
+! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
+! Tests that the PRs caused by the lack of gfc_simplify_transfer are
+! now fixed. These were brought together in the meta-bug PR31237
+! (TRANSFER intrinsic).
+! Remaining PRs on 20070409 :-18769 30881 31194 31216 31424 31427
+!
+program simplify_transfer
+  CHARACTER(LEN=100) :: buffer="1.0 3.0"
+  call pr18769 ()
+  call pr30881 ()
+  call pr31194 ()
+  call pr31216 ()
+  call pr31427 ()
+contains
+  subroutine pr18769 ()
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+    implicit none
+    type t
+       integer :: i
+    end type t
+    type (t), parameter :: u = t (42)
+    integer,  parameter :: idx_list(1) = (/ 1 /)
+    integer             :: j(1) = transfer (u,  idx_list)
+    if (j(1) .ne. 42) call abort ()
+  end subroutine pr18769
+
+  subroutine pr30881 ()
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+    INTEGER, PARAMETER :: K=1
+    INTEGER ::  I
+    I=TRANSFER(.TRUE.,K)
+    SELECT CASE(I)
+      CASE(TRANSFER(.TRUE.,K))
+      CASE(TRANSFER(.FALSE.,K))
+        CALL ABORT()
+      CASE DEFAULT
+        CALL ABORT()
+    END SELECT
+    I=TRANSFER(.FALSE.,K)
+    SELECT CASE(I)
+      CASE(TRANSFER(.TRUE.,K))
+        CALL ABORT()
+      CASE(TRANSFER(.FALSE.,K))
+      CASE DEFAULT
+      CALL ABORT()
+    END SELECT
+  END subroutine pr30881
+
+  subroutine pr31194 ()
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+    real(kind(0d0)) :: NaN = transfer(ishft(int(z'FFF80000',8),32),0d0)
+    write (buffer,'(e12.5)') NaN
+    if (buffer(10:12) .ne. "NaN") call abort ()
+  end subroutine pr31194
+
+  subroutine pr31216 ()
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+    INTEGER :: I
+    REAL :: C,D
+    buffer = "  1.0  3.0"
+    READ(buffer,*) C,D
+    I=TRANSFER(C/D,I)
+    SELECT CASE(I)
+      CASE (TRANSFER(1.0/3.0,1))
+      CASE DEFAULT
+        CALL ABORT()
+    END SELECT
+  END subroutine pr31216
+
+  subroutine pr31427 ()
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+!
+    INTEGER(KIND=1) :: i(1)
+    i = (/ TRANSFER("a", 0_1) /)
+    if (i(1) .ne. ichar ("a")) call abort ()
+  END subroutine pr31427
+end program simplify_transfer
diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_10.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_10.f90
new file mode 100644
index 000000000..3a56e65a6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_simplify_10.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+!
+! PR fortran/46638
+!
+! Contributed by James Van Buskirk
+!
+program test5
+   use ISO_C_BINDING
+   implicit none
+   type, bind(C) :: CPUID_type
+      integer(C_INT32_T) eax
+      integer(C_INT32_T) ebx
+      integer(C_INT32_T) edx
+      integer(C_INT32_T) ecx
+      integer(C_INT32_T) bbb
+   end type CPUID_type
+   type(CPUID_TYPE) result
+  result = transfer(achar(10)//achar(0)//achar(0)//achar(0)//'GenuineIntel'//'abcd',result)
+
+  if((     int(z'0000000A') /= result%eax  &
+      .or. int(z'756E6547') /= result%ebx  &
+      .or. int(z'49656E69') /= result%edx  &
+      .or. int(z'6C65746E') /= result%ecx  &
+      .or. int(z'64636261') /= result%bbb) &
+     .and. & ! Big endian
+     (     int(z'0A000000') /= result%eax  &
+      .or. int(z'47656E75') /= result%ebx  &
+      .or. int(z'696E6549') /= result%edx  &
+      .or. int(z'6E74656C') /= result%ecx  &
+      .or. int(z'61626364') /= result%bbb)) then
+    write(*,'(5(z8.8:1x))') result
+    call abort()
+  end if
+end program test5 
diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_2.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_2.f90
new file mode 100644
index 000000000..46052d0a0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_simplify_2.f90
@@ -0,0 +1,156 @@
+! { dg-do run }
+! { dg-options "-O2" }
+! { dg-add-options ieee }
+! Tests the fix for the meta-bug PR31237 (TRANSFER intrinsic)
+! Exercises gfc_simplify_transfer a random walk through types and shapes
+! and compares its results with the middle-end version that operates on
+! variables.
+!
+  implicit none
+  call integer4_to_real4
+  call real4_to_integer8
+  call integer4_to_integer8
+  call logical4_to_real8
+  call real8_to_integer4
+  call integer8_to_real4
+  call integer8_to_complex4
+  call character16_to_complex8
+  call character16_to_real8
+  call real8_to_character2
+  call dt_to_integer1
+  call character16_to_dt
+contains
+  subroutine integer4_to_real4
+    integer(4), parameter ::  i1 = 11111_4
+    integer(4)            ::  i2 = i1
+    real(4), parameter    ::  r1 = transfer (i1, 1.0_4)
+    real(4)               ::  r2
+
+    r2 = transfer (i2, r2);
+    if (r1 .ne. r2) call abort ()
+  end subroutine integer4_to_real4
+
+  subroutine real4_to_integer8
+    real(4), parameter    ::  r1(2) = (/3.14159_4, 0.0_4/)
+    real(4)               ::  r2(2) = r1
+    integer(8), parameter ::  i1 = transfer (r1, 1_8)
+    integer(8)            ::  i2
+
+    i2 = transfer (r2, 1_8);
+    if (i1 .ne. i2) call abort ()
+  end subroutine real4_to_integer8
+
+  subroutine integer4_to_integer8
+    integer(4), parameter ::  i1(2) = (/11111_4, 22222_4/)
+    integer(4)            ::  i2(2) = i1
+    integer(8), parameter ::  i3 = transfer (i1, 1_8)
+    integer(8)            ::  i4
+
+    i4 = transfer (i2, 1_8);
+    if (i3 .ne. i4) call abort ()
+  end subroutine integer4_to_integer8
+
+  subroutine logical4_to_real8
+    logical(4), parameter ::  l1(2) = (/.false., .true./)
+    logical(4)            ::  l2(2) = l1
+    real(8), parameter    ::  r1 = transfer (l1, 1_8)
+    real(8)               ::  r2
+
+    r2 = transfer (l2, 1_8);
+    if (r1 .ne. r2) call abort ()
+  end subroutine logical4_to_real8
+
+  subroutine real8_to_integer4
+    real(8), parameter    ::  r1 = 3.14159_8
+    real(8)               ::  r2 = r1
+    integer(4), parameter ::  i1(2) = transfer (r1, 1_4, 2)
+    integer(4)            ::  i2(2)
+
+    i2 = transfer (r2, i2, 2);
+    if (any (i1 .ne. i2)) call abort ()
+  end subroutine real8_to_integer4
+
+  subroutine integer8_to_real4
+    integer               ::  k
+    integer(8), parameter ::  i1(2) = transfer ((/asin (1.0_8), log (1.0_8)/), 0_8)
+    integer(8)            ::  i2(2) = i1
+    real(4), parameter    ::  r1(4) = transfer (i1, (/(1.0_4,k=1,4)/))
+    real(4)               ::  r2(4)
+
+    r2 = transfer (i2, r2);
+    if (any (r1 .ne. r2)) call abort ()
+  end subroutine integer8_to_real4
+
+  subroutine integer8_to_complex4
+    integer               ::  k
+    integer(8), parameter ::  i1(2) = transfer ((/asin (1.0_8), log (1.0_8)/), 0_8)
+    integer(8)            ::  i2(2) = i1
+    complex(4), parameter ::  z1(2) = transfer (i1, (/((1.0_4,2.0_4),k=1,2)/))
+    complex(4)            ::  z2(2)
+
+    z2 = transfer (i2, z2);
+    if (any (z1 .ne. z2)) call abort ()
+  end subroutine integer8_to_complex4
+
+  subroutine character16_to_complex8
+    character(16), parameter ::  c1(2) = (/"abcdefghijklmnop","qrstuvwxyz123456"/)
+    character(16)            ::  c2(2) = c1
+    complex(8), parameter    ::  z1(2) = transfer (c1, (1.0_8,1.0_8), 2)
+    complex(8)               ::  z2(2)
+
+    z2 = transfer (c2, z2, 2);
+    if (any (z1 .ne. z2)) call abort ()
+  end subroutine character16_to_complex8
+
+  subroutine character16_to_real8
+    character(16), parameter ::  c1 = "abcdefghijklmnop"
+    character(16)            ::  c2 = c1
+    real(8), parameter    ::  r1(2) = transfer (c1, 1.0_8, 2)
+    real(8)               ::  r2(2)
+
+    r2 = transfer (c2, r2, 2);
+    if (any (r1 .ne. r2)) call abort ()
+  end subroutine character16_to_real8
+
+  subroutine real8_to_character2
+    real(8), parameter    ::  r1 = 3.14159_8
+    real(8)               ::  r2 = r1
+    character(2), parameter ::  c1(4) = transfer (r1, "ab", 4)
+    character(2)            ::  c2(4)
+
+    c2 = transfer (r2, "ab", 4);
+    if (any (c1 .ne. c2)) call abort ()
+  end subroutine real8_to_character2
+
+  subroutine dt_to_integer1
+    integer, parameter    :: i1(4) = (/1_4,2_4,3_4,4_4/)
+    real, parameter       :: r1(4) = (/1.0_4,2.0_4,3.0_4,4.0_4/)
+    type :: mytype
+      integer(4) :: i(4)
+      real(4) :: x(4)
+    end type mytype
+    type (mytype), parameter :: dt1 = mytype (i1, r1)
+    type (mytype)            :: dt2 = dt1
+    integer(1), parameter :: i2(32) = transfer (dt1, 1_1, 32)
+    integer(1)            :: i3(32)
+
+    i3 = transfer (dt2, 1_1, 32);
+    if (any (i2 .ne. i3)) call abort ()
+  end subroutine dt_to_integer1
+
+  subroutine character16_to_dt
+    character(16), parameter ::  c1 = "abcdefghijklmnop"
+    character(16)            ::  c2 = c1
+    type :: mytype
+      real(4) :: x(2)
+    end type mytype
+
+    type (mytype), parameter :: dt1(2) = transfer (c1, mytype ((/1.0,2.0,3.0,4.0/)), 2)
+    type (mytype)            :: dt2(2)
+
+    dt2 = transfer (c2, dt2);
+    if (any (dt1(1)%x .ne. dt2(1)%x)) call abort ()
+    if (any (dt1(2)%x .ne. dt2(2)%x)) call abort ()
+  end subroutine character16_to_dt
+
+end
diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_3.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_3.f90
new file mode 100644
index 000000000..43ca19726
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_simplify_3.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+! { dg-options "-fno-range-check" }
+! PR fortran/32083
+!
+! Test transfers of +Inf and -Inf
+! Testcase contributed by Jos de Kloe <kloedej@knmi.nl>
+!
+
+PROGRAM TestInfinite
+  IMPLICIT NONE
+  integer, parameter :: i8_ = Selected_Int_Kind(18)  ! = integer*8
+  integer, parameter :: r8_ = Selected_Real_Kind(15,307)  ! = real*8
+
+  integer(i8_), parameter :: bit_pattern_PosInf_i8_p = 9218868437227405312_i8_
+  integer(i8_), parameter :: bit_pattern_NegInf_i8_p = -4503599627370496_i8_
+
+  integer(i8_) :: bit_pattern_PosInf_i8 = 9218868437227405312_i8_
+  integer(i8_) :: bit_pattern_NegInf_i8 = -4503599627370496_i8_
+
+  integer(i8_) :: bit_pattern_PosInf_i8_hex
+  integer(i8_) :: bit_pattern_NegInf_i8_hex
+
+  integer(i8_) :: i
+  real(r8_)    :: r
+
+  data bit_pattern_PosInf_i8_hex /z'7FF0000000000000'/
+  !data bit_pattern_NegInf_i8_hex /z'FFF0000000000000'/
+  ! not portable, replaced by:
+  bit_pattern_NegInf_i8_hex = ibset(bit_pattern_PosInf_i8_hex,63)
+
+  if (bit_pattern_NegInf_i8_hex /= bit_pattern_NegInf_i8) call abort()
+  if (bit_pattern_PosInf_i8_hex /= bit_pattern_PosInf_i8) call abort()
+
+  r = transfer(bit_pattern_PosInf_i8,r)
+  if (r /= 1.0_r8_/0.0_r8_) call abort()
+  i = transfer(r,i)
+  if (bit_pattern_PosInf_i8 /= i) call abort()  
+
+  r = transfer(bit_pattern_NegInf_i8,r)
+  if (r /= -1.0_r8_/0.0_r8_) call abort()
+  i = transfer(r,i)
+  if (bit_pattern_NegInf_i8 /= i) call abort()
+
+  r = transfer(bit_pattern_PosInf_i8_p,r)
+  if (r /= 1.0_r8_/0.0_r8_) call abort()
+  i = transfer(r,i)
+  if (bit_pattern_PosInf_i8_p /= i) call abort()
+
+  r = transfer(bit_pattern_NegInf_i8_p,r)
+  if (r /= -1.0_r8_/0.0_r8_) call abort()
+  i = transfer(r,i)
+  if (bit_pattern_NegInf_i8_p /= i) call abort()
+END PROGRAM TestInfinite
diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_4.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_4.f90
new file mode 100644
index 000000000..65b1e41cf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_simplify_4.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! Tests that the in-memory representation of a transferred variable
+! propagates properly.
+!
+  implicit none
+
+  integer, parameter :: ip1 = 42
+  integer, parameter :: ip2 = transfer(transfer(ip1, .true.), 0)
+  integer :: i, ai(4)
+  logical :: b
+
+  if (ip2 .ne. ip1) call abort ()
+  
+  i = transfer(transfer(ip1, .true.), 0)
+  if (i .ne. ip1) call abort ()
+
+  i = 42
+  i = transfer(transfer(i, .true.), 0)
+  if (i .ne. ip1) call abort ()
+
+  b = transfer(transfer(.true., 3.1415), .true.)
+  if (.not.b) call abort ()
+
+  b = transfer(transfer(.false., 3.1415), .true.)
+  if (b) call abort ()
+
+  i = 0
+  b = transfer(i, .true.)
+  ! The standard doesn't guarantee here that b will be .false.,
+  ! though in gfortran for all targets it will.
+
+  ai = (/ 42, 42, 42, 42 /)
+  ai = transfer (transfer (ai, .false., 4), ai)
+  if (any(ai .ne. 42)) call abort
+
+  ai = transfer (transfer ((/ 42, 42, 42, 42 /), &
+&                          (/ .false., .false., .false., .false. /)), ai)
+  if (any(ai .ne. 42)) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_5.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_5.f90
new file mode 100644
index 000000000..65905b87a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_simplify_5.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! Tests the fix for PR32689, in which the TRANSFER with MOLD
+! an array variable, as below, did not simplify.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+!
+program gfcbug67
+  implicit none
+
+  type mytype
+     integer, pointer :: i(:) => NULL ()
+  end type mytype
+  type(mytype) :: t
+
+  print *, size (transfer (1, t% i))
+end program gfcbug67
diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_6.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_6.f90
new file mode 100644
index 000000000..b557c064f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_simplify_6.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! Checks the fix for PR33733, in which the functions of arrays
+! for the 'source' argument would cause an ICE.
+!
+! Contributed by FX Coudert <fxcoudert@gcc.gnu.org>
+!
+  print *, transfer(sqrt([100.]), 0_1)
+  print *, transfer(achar([100]), 0_1)
+end
diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_7.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_7.f90
new file mode 100644
index 000000000..0ba3efa32
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_simplify_7.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! PR fortran/34495 - accepts invalid init-expr with TRANSFER
+
+! 'b' is implicitly typed
+real :: a = transfer(1234, b)              ! { dg-error "does not reduce to a constant" }
+
+! 'c' is used on lhs and rhs
+real :: c = transfer(1234, c)              ! { dg-error "does not reduce to a constant" }
+
+! 'bp' is implicitly typed
+real, parameter :: ap = transfer(1234, bp) ! { dg-error "does not reduce to a constant" }
+
+! 'yp' is used on lhs and rhs
+real, parameter :: cp = transfer(1234, cp) ! { dg-error "before its definition is complete" }
+
+
+! same with arrays
+real, dimension(2) :: a2 = transfer([1, 2], b2)  ! { dg-error "does not reduce to a constant" }
+
+real, dimension(2) :: a2 = transfer([1, 2], b2)  ! { dg-error "does not reduce to a constant" }
+
+dimension :: bp(2)
+real, parameter, dimension(2) :: ap2 = transfer([1, 2], bp2)  ! { dg-error "does not reduce to a constant" }
+
+real, parameter, dimension(2) :: cp2 = transfer([1, 2], cp2)  ! { dg-error "before its definition is complete" }
+
+
+! same with matrices
+real, dimension(2,2) :: a3 = transfer([1, 2, 3, 4], b3)  ! { dg-error "does not reduce to a constant" }
+
+real, dimension(2,2) :: a3 = transfer([1, 2, 3, 4], b3)  ! { dg-error "does not reduce to a constant" }
+
+dimension :: bp3(2,2)
+real, parameter, dimension(2,2) :: ap3 = transfer([1, 2, 3, 4], bp3)  ! { dg-error "does not reduce to a constant" }
+
+real, parameter, dimension(2,2) :: cp3 = transfer([1, 2, 3, 4], cp3)  ! { dg-error "before its definition is complete" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_8.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_8.f90
new file mode 100644
index 000000000..75b084670
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_simplify_8.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-O0" }
+! PR fortran/34537
+! simplify_transfer used to ICE on divide by zero for cases like this,
+! where the mold expression is a non-constant character expression.
+!
+! Testcase contributed by Tobias Burnus <burnus@gcc.gnu.org >
+!
+  character, pointer :: ptr(:)
+  character(8) :: a
+  allocate(ptr(9))
+  ptr = transfer('Sample#0'//achar(0),ptr) ! Causes ICE
+  if (any (ptr .ne. ['S','a','m','p','l','e','#','0',achar(0)])) call abort
+  call test(a)
+  if (a .ne. 'Sample#2') call abort
+contains
+  subroutine test(a)
+    character(len=*) :: a
+    a = transfer('Sample#2',a)
+  end subroutine test
+end
diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_9.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_9.f90
new file mode 100644
index 000000000..02b86111b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_simplify_9.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+!
+! Various checks on simplification of TRANSFER of substrings
+  character(len=4), parameter :: t = "xyzt"
+  integer, parameter :: w = transfer(t,0)
+  integer :: i = 1
+  if (transfer(t,0) /= w) call abort
+  if (transfer(t(:),0) /= w) call abort
+  if (transfer(t(1:4),0) /= w) call abort
+  if (transfer(t(i:i+3),0) /= w) call abort
+
+  if (transfer(t(1:1), 0_1) /= transfer("x", 0_1)) call abort
+  if (transfer(t(2:2), 0_1) /= transfer("y", 0_1)) call abort
+  if (transfer(t(i:i), 0_1) /= transfer("x", 0_1)) call abort
+  if (transfer(t(i+1:i+1), 0_1) /= transfer("y", 0_1)) call abort
+  if (transfer(t(1:2), 0_2) /= transfer("xy", 0_2)) call abort
+  if (transfer(t(3:4), 0_2) /= transfer("zt", 0_2)) call abort
+
+  if (transfer(transfer(-1, t), 0) /= -1) call abort
+  if (transfer(transfer(-1, t(:)), 0) /= -1) call abort
+  if (any (transfer(transfer(-1, (/t(1:1)/)), (/0_1/)) /= -1)) call abort
+  if (transfer(transfer(-1, t(1:1)), 0_1) /= -1) call abort
+  end
diff --git a/gcc/testsuite/gfortran.dg/transpose_1.f90 b/gcc/testsuite/gfortran.dg/transpose_1.f90
new file mode 100644
index 000000000..9ad784ea7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transpose_1.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! Tests the fix for PR32962, in which the result of TRANSPOSE, when
+! an actual argument of an elemental intrinsic would receive the
+! wrong offset.
+!
+! Contributed by Wirawan Purwanto <wirawan0@gmail.com>
+!
+  real(kind=8), allocatable :: b(:,:)
+  real(kind=8) :: a(2,2), c(2,2)
+  i = 2
+  allocate (b(i,i))
+  a(1,1) = 2
+  a(2,1) = 3
+  a(1,2) = 7
+  a(2,2) = 11
+  call foo
+  call bar
+  if (any (c .ne. b)) call abort
+contains
+  subroutine foo
+    b = cos(transpose(a))
+  end subroutine
+  subroutine bar
+    c = transpose(a)
+    c = cos(c)
+  end subroutine
+end program
diff --git a/gcc/testsuite/gfortran.dg/transpose_2.f90 b/gcc/testsuite/gfortran.dg/transpose_2.f90
new file mode 100644
index 000000000..4ab3bc4bb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transpose_2.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-options "-fbounds-check -fno-realloc-lhs" }
+! { dg-shouldfail "Incorrect extent in return value of TRANSPOSE intrinsic in dimension 1: is 2, should be 3" }
+program main
+  implicit none
+  character(len=10) :: in
+  real, dimension(:,:), allocatable :: a,b
+  integer :: ax, ay, bx, by
+
+  in = "2 2 3 2"
+  read (unit=in,fmt='(4I2)') ax, ay, bx, by
+  allocate (a(ax,ay))
+  allocate (b(bx,by))
+  a = 1.0
+  b = 2.1
+  b = transpose(a)
+end program main
+! { dg-output "Fortran runtime error: Array bound mismatch for dimension 1 of
+! array 'b' (3/2)" }
diff --git a/gcc/testsuite/gfortran.dg/transpose_3.f03 b/gcc/testsuite/gfortran.dg/transpose_3.f03
new file mode 100644
index 000000000..269db491d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transpose_3.f03
@@ -0,0 +1,10 @@
+! { dg-do run }
+! Transformational intrinsic TRANSPOSE as initialization expression.
+
+  INTEGER, PARAMETER :: n = 10
+  INTEGER, PARAMETER :: a(n,1) = RESHAPE([ (i, i = 1, n) ], [n, 1])
+  INTEGER, PARAMETER :: b(1,n) = TRANSPOSE(a)
+  INTEGER, PARAMETER :: c(n,1) = TRANSPOSE(b)
+
+  IF (ANY(c /= a)) CALL abort()
+END
diff --git a/gcc/testsuite/gfortran.dg/transpose_conjg_1.f90 b/gcc/testsuite/gfortran.dg/transpose_conjg_1.f90
new file mode 100644
index 000000000..3b28827b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transpose_conjg_1.f90
@@ -0,0 +1,37 @@
+!  { dg-do run }
+!  Tests the fix for PR35740, where the trick of interchanging the descriptor
+!  dimensions to implement TRANSPOSE did not work if it is an argument of
+!  an elemental function - eg. CONJG.  The fix forces a library call for such
+!  cases.  During the diagnosis of the PR, it was found that the scalarizer was
+!  completely thrown if the argument of TRANSPOSE was a non-variable
+!  expression; eg a + c below.  This is also fixed by the library call.
+!
+!  Contributed by Dominik Muth <dominik.muth@gmx.de>
+!
+program main
+  implicit none
+  complex, dimension(2,2) :: a,b,c,d
+  a(1,1) = (1.,1.)
+  a(2,1) = (2.,2.)
+  a(1,2) = (3.,3.)
+  a(2,2) = (4.,4.)
+!
+  b = a
+  b = conjg(transpose(b))
+  d = a
+  d = transpose(conjg(d))
+  if (any (b /= d)) call abort ()
+!
+  d = matmul (b,  a )
+  if (any (d /= matmul (transpose(conjg(a)), a))) call abort ()
+  if (any (d /= matmul (conjg(transpose(a)), a))) call abort ()
+!
+  c = (0.0,1.0)
+  b = conjg(transpose(a + c))
+  d = transpose(conjg(a + c))
+  if (any (b /= d)) call abort ()
+!
+  d = matmul (b,  a + c)
+  if (any (d /= matmul (transpose(conjg(a + c)), a + c))) call abort ()
+  if (any (d /= matmul (conjg(transpose(a + c)), a + c))) call abort ()
+ END program main
diff --git a/gcc/testsuite/gfortran.dg/transpose_intrinsic_func_call_1.f90 b/gcc/testsuite/gfortran.dg/transpose_intrinsic_func_call_1.f90
new file mode 100644
index 000000000..53d727d9b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transpose_intrinsic_func_call_1.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+!
+! PR fortran/46978
+! The coor assignment was using the wrong loop bounds if the argument to
+! transpose was an intrinsic function call
+!
+! Original testcase by Martien Huelsen <m.a.hulsen@tue.nl>
+! Reduced by Tobias Burnus <burnus@net-b.de>
+
+program elastic2
+  implicit none
+  real, allocatable, dimension(:,:) :: coor
+  real, allocatable, dimension(:) :: a
+  integer :: nno
+  nno = 3
+  allocate(a(2*nno))
+  call two()
+  coor = transpose ( reshape ( a, (/2,nno/) ) )
+  if (any(coor /= 12)) call abort
+contains
+  subroutine two()
+    allocate(coor(3,2))
+    coor = 99
+    a = 12
+  end subroutine
+end program elastic2
diff --git a/gcc/testsuite/gfortran.dg/transpose_optimization_1.f90 b/gcc/testsuite/gfortran.dg/transpose_optimization_1.f90
new file mode 100644
index 000000000..885ff7c20
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transpose_optimization_1.f90
@@ -0,0 +1,106 @@
+! { dg-do compile }
+! { dg-options "-Warray-temporaries -fdump-tree-original" }
+!
+! PR fortran/45648
+! Non-copying descriptor transpose optimization (for function call args).
+!
+! Contributed by Richard Sandiford <richard@codesourcery.com>
+
+module foo
+  interface
+    subroutine ext1 (a, b)
+      real, intent (in), dimension (:, :) :: a, b
+    end subroutine ext1
+    subroutine ext2 (a, b)
+      real, intent (in), dimension (:, :) :: a
+      real, intent (out), dimension (:, :) :: b
+    end subroutine ext2
+    subroutine ext3 (a, b)
+      real, dimension (:, :) :: a, b
+    end subroutine ext3
+  end interface
+contains
+  ! No temporary needed here.
+  subroutine test1 (n, a, b, c)
+    integer :: n
+    real, dimension (n, n) :: a, b, c
+    a = matmul (transpose (b), c)
+  end subroutine test1
+
+  ! No temporary either, as we know the arguments to matmul are intent(in)
+  subroutine test2 (n, a, b)
+    integer :: n
+    real, dimension (n, n) :: a, b
+    a = matmul (transpose (b), b)
+  end subroutine test2
+
+  ! No temporary needed.
+  subroutine test3 (n, a, b, c)
+    integer :: n
+    real, dimension (n, n) :: a, c
+    real, dimension (n+4, n+4) :: b
+    a = matmul (transpose (b (2:n+1, 3:n+2)), c)
+  end subroutine test3
+
+  ! A temporary is needed for the result of either the transpose or matmul.
+  subroutine test4 (n, a, b)
+    integer :: n
+    real, dimension (n, n) :: a, b
+    a = matmul (transpose (a), b)       ! { dg-warning "Creating array temporary" }
+  end subroutine test4
+
+  ! The temporary is needed here since the second argument to imp1
+  ! has unknown intent.
+  subroutine test5 (n, a)
+    integer :: n
+    real, dimension (n, n) :: a
+    call imp1 (transpose (a), a)        ! { dg-warning "Creating array temporary" }
+  end subroutine test5
+
+  ! No temporaries are needed here; imp1 can't modify either argument.
+  ! We have to pack the arguments, however. 
+  subroutine test6 (n, a, b)
+    integer :: n
+    real, dimension (n, n) :: a, b
+    call imp1 (transpose (a), transpose (b))    ! { dg-warning "Creating array temporary" }
+  end subroutine test6
+
+  ! No temporaries are needed here; imp1 can't modify either argument.
+  ! We don't have to pack the arguments. 
+  subroutine test6_bis (n, a, b)
+    integer :: n
+    real, dimension (n, n) :: a, b
+    call ext3 (transpose (a), transpose (b))
+  end subroutine test6_bis
+
+  ! No temporary is neede here; the second argument is intent(in).
+  subroutine test7 (n, a)
+    integer :: n
+    real, dimension (n, n) :: a
+    call ext1 (transpose (a), a)
+  end subroutine test7
+
+  ! The temporary is needed here though.
+  subroutine test8 (n, a)
+    integer :: n
+    real, dimension (n, n) :: a
+    call ext2 (transpose (a), a)        ! { dg-warning "Creating array temporary" } 
+  end subroutine test8
+
+  ! Silly, but we don't need any temporaries here.
+  subroutine test9 (n, a)
+    integer :: n
+    real, dimension (n, n) :: a
+    call ext1 (transpose (transpose (a)), a)
+  end subroutine test9
+
+  ! The outer transpose needs a temporary; the inner one doesn't.
+  subroutine test10 (n, a)
+    integer :: n
+    real, dimension (n, n) :: a
+    call ext2 (transpose (transpose (a)), a)    ! { dg-warning "Creating array temporary" }
+  end subroutine test10
+end module foo
+
+! { dg-final { scan-tree-dump-times "struct\[^\\n\]*atmp" 4 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/transpose_optimization_2.f90 b/gcc/testsuite/gfortran.dg/transpose_optimization_2.f90
new file mode 100644
index 000000000..ba0337407
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transpose_optimization_2.f90
@@ -0,0 +1,66 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original " }
+! Checks the fix for PR46896, in which the optimization that passes
+! the argument of TRANSPOSE directly missed the possible aliasing
+! through host association.
+!
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+!
+module mod
+  integer :: b(2,3) = reshape([1,2,3,4,5,6], [2,3])
+contains
+  subroutine msub(x)
+    integer :: x(:,:)
+    b(1,:) = 99
+    b(2,:) = x(:,1)
+    if (any (b(:,1) /= [99, 1]).or.any (b(:,2) /= [99, 3])) call abort()
+  end subroutine msub
+  subroutine pure_msub(x, y)
+    integer, intent(in) :: x(:,:)
+    integer, intent(OUT) :: y(size (x, 2), size (x, 1))
+    y = transpose (x)
+  end subroutine pure_msub
+end
+
+  use mod
+  integer :: a(2,3) = reshape([1,2,3,4,5,6], [2,3])
+  call impure
+  call purity
+contains
+!
+! pure_sub and pure_msub could be PURE, if so declared.  They do not
+! need a temporary.
+!
+  subroutine purity
+    integer :: c(2,3)
+    call pure_sub(transpose(a), c)
+    if (any (c .ne. a)) call abort
+    call pure_msub(transpose(b), c)
+    if (any (c .ne. b)) call abort
+  end subroutine purity
+!
+! sub and msub both need temporaries to avoid aliasing.
+!
+  subroutine impure
+    call sub(transpose(a))
+  end subroutine impure
+
+  subroutine sub(x)
+    integer :: x(:,:)
+    a(1,:) = 88
+    a(2,:) = x(:,1)
+    if (any (a(:,1) /= [88, 1]).or.any (a(:,2) /= [88, 3])) call abort()
+  end subroutine sub
+  subroutine pure_sub(x, y)
+    integer, intent(in) :: x(:,:)
+    integer, intent(OUT) :: y(size (x, 2), size (x, 1))
+    y = transpose (x)
+  end subroutine pure_sub
+end
+!
+! The check below for temporaries gave 14 and 33 for "parm" and "atmp".
+!
+! { dg-final { scan-tree-dump-times "parm" 66 "original" } }
+! { dg-final { scan-tree-dump-times "atmp" 12 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-modules "mod" } }
diff --git a/gcc/testsuite/gfortran.dg/transpose_reshape_r10.f90 b/gcc/testsuite/gfortran.dg/transpose_reshape_r10.f90
new file mode 100644
index 000000000..83da8faeb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transpose_reshape_r10.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+program main
+  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+  character(len=90) line
+  real(k) :: a(3,3)
+  real(k) :: b(9)
+  a = 1.0_k
+  a(1,3) = 0.0_k
+  write (line,'(9G10.6)') transpose(a)
+  write (line,'(9G10.6)') reshape(a,shape(b))
+end
diff --git a/gcc/testsuite/gfortran.dg/trim_1.f90 b/gcc/testsuite/gfortran.dg/trim_1.f90
new file mode 100644
index 000000000..ac1e1f203
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/trim_1.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+
+! Torture-test TRIM and LEN_TRIM for correctness.
+
+
+! Given a total string length and a trimmed length, construct an
+! appropriate string and check gfortran gets it right.
+
+SUBROUTINE check_trim (full_len, trimmed_len)
+  IMPLICIT NONE
+  INTEGER, INTENT(IN) :: full_len, trimmed_len
+  CHARACTER(LEN=full_len) :: string
+
+  string = ""
+  IF (trimmed_len > 0) THEN
+    string(trimmed_len:trimmed_len) = "x"
+  END IF
+
+  IF (LEN (string) /= full_len &
+      .OR. LEN_TRIM (string) /= trimmed_len &
+      .OR. LEN (TRIM (string)) /= trimmed_len &
+      .OR. TRIM (string) /= string (1:trimmed_len)) THEN
+    PRINT *, full_len, trimmed_len
+    PRINT *, LEN (string), LEN_TRIM (string)
+    CALL abort ()
+  END IF
+END SUBROUTINE check_trim
+
+
+! The main program, check with various combinations.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER :: i, j
+
+  DO i = 0, 20
+    DO j = 0, i
+      CALL check_trim (i, j)
+    END DO
+  END DO
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/trim_optimize_1.f90 b/gcc/testsuite/gfortran.dg/trim_optimize_1.f90
new file mode 100644
index 000000000..26aa5cd94
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/trim_optimize_1.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-O -fdump-tree-original" }
+! PR 40628 - optimize unnecessary TRIMs on assignment
+program main
+  character(len=3) :: a
+  character(len=4) :: b,c
+  b = 'abcd'
+  a = trim(b)
+  c = trim(trim(a))
+  if (a /= 'abc') call abort
+  if (c /= 'abc') call abort
+end program main
+
+! { dg-final { scan-tree-dump-times "memmove" 2 "original" } }
+! { dg-final { scan-tree-dump-times "string_trim" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/trim_optimize_2.f90 b/gcc/testsuite/gfortran.dg/trim_optimize_2.f90
new file mode 100644
index 000000000..b7ae1e3e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/trim_optimize_2.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+! { dg-options "-O -fdump-tree-original" }
+! Optimize unnecessary TRIMs in contained namespaces too.
+module faz
+  implicit none
+contains
+  subroutine bar
+    character(len=3) :: a
+    character(len=4) :: b,c
+    b = 'abcd'
+    a = trim(b)
+    c = trim(trim(a))
+    if (a /= 'abc') call abort
+    if (c /= 'abc') call abort
+  end subroutine bar
+end module faz
+
+program main
+  use faz
+  implicit none
+  call foo
+  call bar
+contains
+  subroutine foo
+    character(len=3) :: a
+    character(len=4) :: b,c
+    b = 'abcd'
+    a = trim(b)
+    c = trim(trim(a))
+    if (a /= 'abc') call abort
+    if (c /= 'abc') call abort
+  end subroutine foo
+end program main
+
+! { dg-final { scan-tree-dump-times "memmove" 4 "original" } }
+! { dg-final { scan-tree-dump-times "string_trim" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/trim_optimize_3.f90 b/gcc/testsuite/gfortran.dg/trim_optimize_3.f90
new file mode 100644
index 000000000..33cf8b2b9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/trim_optimize_3.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-O -fdump-tree-original" }
+! PR 47065 - replace trim with substring expressions.
+program main
+  character(len=10) :: a, b
+  character(kind=4,len=10) :: a4, b4
+  character(len=100) :: line
+  a = 'bcd'
+  b = trim(a) // 'x'
+  if (b /= 'bcdx') call abort
+  a4 = 4_"bcd"
+  b4 = trim(a4) // 4_'x'
+  if (b4 /= 4_'bcdx') call abort
+end
+! { dg-final { scan-tree-dump-times "string_len_trim" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/trim_optimize_4.f90 b/gcc/testsuite/gfortran.dg/trim_optimize_4.f90
new file mode 100644
index 000000000..41c65b10b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/trim_optimize_4.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! PR 47065 - make sure that trim optimization does not lead to
+! wrong-code with aliasing.
+! Test case provided by Tobias Burnus.
+program main
+  character(len=12) :: str
+  str = '1234567890'
+  call sub(trim(str), str)
+  ! Should print '12345       '
+  if (str /= '12345       ') call abort
+  call two(trim(str))
+  if (str /= '123         ') call abort
+contains
+  subroutine sub(a,b)
+    character(len=*), intent(in) :: a
+    character(len=*), intent(out) :: b
+    b = ''
+    b = a(1:5)
+  end subroutine sub
+  subroutine two(a)
+    character(len=*), intent(in) :: a
+    str = ''
+    str(1:3) = a(1:3)
+  end subroutine two
+end program main
diff --git a/gcc/testsuite/gfortran.dg/type_decl_1.f90 b/gcc/testsuite/gfortran.dg/type_decl_1.f90
new file mode 100644
index 000000000..93928652a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/type_decl_1.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
+! Fortran 2008: TYPE ( intrinsic-type-spec )
+!
+implicit none
+type(integer) :: a
+type(real) :: b
+type(logical ) :: c
+type(character) :: d
+type(double precision) :: e
+
+type(integer(8)) :: f
+type(real(kind=4)) :: g
+type(logical ( kind = 1 ) ) :: h
+type(character (len=10,kind=1) ) :: i
+
+type(double complex) :: j ! { dg-error "Extension: DOUBLE COMPLEX" }
+end
+
+module m
+  integer, parameter :: k4  = 4
+end module m
+
+type(integer (kind=k4)) function f()
+  use m
+  f = 42
+end
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/type_decl_2.f90 b/gcc/testsuite/gfortran.dg/type_decl_2.f90
new file mode 100644
index 000000000..6525880e0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/type_decl_2.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! Fortran 2008: TYPE ( intrinsic-type-spec )
+!
+implicit none
+type(integer)          :: a ! { dg-error "Fortran 2008" }
+type(real)             :: b ! { dg-error "Fortran 2008" }
+type(logical)          :: c ! { dg-error "Fortran 2008" }
+type(character)        :: d ! { dg-error "Fortran 2008" }
+type(double precision) :: e ! { dg-error "Fortran 2008" }
+end
diff --git a/gcc/testsuite/gfortran.dg/typebound_assignment_1.f03 b/gcc/testsuite/gfortran.dg/typebound_assignment_1.f03
new file mode 100644
index 000000000..359572b0a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_assignment_1.f03
@@ -0,0 +1,35 @@
+! { dg-do compile }
+!
+! PR 47463: [OOP] ICE in gfc_add_component_ref
+!
+! Contributed by Rich Townsend <townsend@astro.wisc.edu>
+
+module hydro_state
+  type :: state_t
+   contains
+     procedure :: assign
+     generic   :: assignment(=) => assign
+  end type state_t
+contains
+  subroutine assign (this, that)
+    class(state_t), intent(inout) :: this
+    class(state_t), intent(in)    :: that
+  end subroutine assign
+end module hydro_state
+
+module hydro_flow
+  use hydro_state
+  type :: flow_t
+     class(state_t), allocatable :: st
+  end type flow_t
+contains
+  subroutine init_comps (this, st)
+    class(flow_t), intent(out) :: this
+    class(state_t), intent(in) :: st
+
+    allocate(state_t :: this%st)
+    this%st = st
+  end subroutine init_comps
+end module hydro_flow 
+
+! { dg-final { cleanup-modules "hydro_state hydro_flow" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_assignment_2.f03 b/gcc/testsuite/gfortran.dg/typebound_assignment_2.f03
new file mode 100644
index 000000000..862535a86
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_assignment_2.f03
@@ -0,0 +1,39 @@
+! { dg-do compile }
+!
+! PR 47463: [OOP] ICE in gfc_add_component_ref
+!
+! Contributed by Rich Townsend <townsend@astro.wisc.edu>
+
+module hydro_grid
+  type :: grid_t
+   contains
+     procedure :: assign
+     generic   :: assignment(=) => assign
+  end type grid_t
+  public :: grid_t
+contains
+  subroutine assign (this, that)
+    class(grid_t), intent(inout) :: this
+    class(grid_t), intent(in)    :: that
+  end subroutine assign
+end module hydro_grid
+
+module hydro_flow
+  use hydro_grid
+  type :: flow_t
+     class(grid_t), allocatable  :: gr
+  end type flow_t
+contains
+  subroutine init_params (this)
+    class(flow_t), intent(out) :: this
+    type(grid_t)               :: gr
+   call init_comps(this, gr)
+  end subroutine init_params
+  subroutine init_comps (this, gr)
+    class(flow_t), intent(out) :: this
+    class(grid_t), intent(in)  :: gr
+    this%gr = gr
+  end subroutine init_comps
+end module hydro_flow 
+
+! { dg-final { cleanup-modules "hydro_grid hydro_flow" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_assignment_3.f03 b/gcc/testsuite/gfortran.dg/typebound_assignment_3.f03
new file mode 100644
index 000000000..ce84a3957
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_assignment_3.f03
@@ -0,0 +1,30 @@
+! { dg-do compile }
+!
+! PR 49074: [OOP] Defined assignment w/ CLASS arrays: Incomplete error message
+!
+! Contribute by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+module foo
+
+  type bar
+  contains
+    generic :: assignment (=) => assgn
+    procedure :: assgn
+  end type
+
+contains
+
+  elemental subroutine assgn (a, b)
+    class (bar), intent (inout) :: a
+    class (bar), intent (in) :: b
+  end subroutine
+
+end module
+
+
+  use foo
+  type (bar) :: foobar(2)
+  foobar = bar()           ! { dg-error "currently not implemented" }
+end
+
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_1.f03 b/gcc/testsuite/gfortran.dg/typebound_call_1.f03
new file mode 100644
index 000000000..d0da0ecd9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_1.f03
@@ -0,0 +1,98 @@
+! { dg-do run }
+
+! Type-bound procedures
+! Check basic calls to NOPASS type-bound procedures.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE add
+  CONTAINS
+    PROCEDURE, NOPASS :: func => func_add
+    PROCEDURE, NOPASS :: sub => sub_add
+    PROCEDURE, NOPASS :: echo => echo_add
+  END TYPE add
+
+  TYPE mul
+  CONTAINS
+    PROCEDURE, NOPASS :: func => func_mul
+    PROCEDURE, NOPASS :: sub => sub_mul
+    PROCEDURE, NOPASS :: echo => echo_mul
+  END TYPE mul
+
+CONTAINS
+
+  INTEGER FUNCTION func_add (a, b)
+    IMPLICIT NONE
+    INTEGER :: a, b
+    func_add = a + b
+  END FUNCTION func_add
+
+  INTEGER FUNCTION func_mul (a, b)
+    IMPLICIT NONE
+    INTEGER :: a, b
+    func_mul = a * b
+  END FUNCTION func_mul
+
+  SUBROUTINE sub_add (a, b, c)
+    IMPLICIT NONE
+    INTEGER, INTENT(IN) :: a, b
+    INTEGER, INTENT(OUT) :: c
+    c = a + b
+  END SUBROUTINE sub_add
+
+  SUBROUTINE sub_mul (a, b, c)
+    IMPLICIT NONE
+    INTEGER, INTENT(IN) :: a, b
+    INTEGER, INTENT(OUT) :: c
+    c = a * b
+  END SUBROUTINE sub_mul
+
+  SUBROUTINE echo_add ()
+    IMPLICIT NONE
+    WRITE (*,*) "Hi from adder!"
+  END SUBROUTINE echo_add
+
+  INTEGER FUNCTION echo_mul ()
+    IMPLICIT NONE
+    echo_mul = 5
+    WRITE (*,*) "Hi from muler!"
+  END FUNCTION echo_mul
+
+  ! Do the testing here, in the same module as the type is.
+  SUBROUTINE test ()
+    IMPLICIT NONE
+
+    TYPE(add) :: adder
+    TYPE(mul) :: muler
+
+    INTEGER :: x
+
+    IF (adder%func (2, 3) /= 5 .OR. muler%func (2, 3) /= 6) THEN
+      CALL abort ()
+    END IF
+
+    CALL adder%sub (2, 3, x)
+    IF (x /= 5) THEN
+      CALL abort ()
+    END IF
+
+    CALL muler%sub (2, 3, x)
+    IF (x /= 6) THEN
+      CALL abort ()
+    END IF
+
+    ! Check procedures without arguments.
+    CALL adder%echo ()
+    x = muler%echo ()
+    CALL adder%echo
+  END SUBROUTINE test
+
+END MODULE m
+
+PROGRAM main
+  USE m, ONLY: test
+  CALL test ()
+END PROGRAM main
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_10.f03 b/gcc/testsuite/gfortran.dg/typebound_call_10.f03
new file mode 100644
index 000000000..ca6038e45
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_10.f03
@@ -0,0 +1,39 @@
+! { dg-do run }
+!
+! PR 39630: [F03] Procedure Pointer Components with PASS
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+module m
+
+ type :: t
+  integer :: i
+ contains
+  procedure, pass(y) :: foo
+ end type t
+
+contains
+
+ subroutine foo(x,y)
+  type(t),optional :: x
+  class(t) :: y
+  if(present(x)) then
+    print *, 'foo', x%i, y%i
+  else
+    print *, 'foo', y%i
+  end if
+ end subroutine foo
+
+end module m
+
+use m
+type(t) :: t1, t2
+t1%i = 3
+t2%i = 4
+call t1%foo()
+call t2%foo()
+call t1%foo(t2)
+end
+
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_11.f03 b/gcc/testsuite/gfortran.dg/typebound_call_11.f03
new file mode 100644
index 000000000..8d7b8f061
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_11.f03
@@ -0,0 +1,48 @@
+! { dg-do compile }
+!
+! PR 42048: [F03] Erroneous syntax error message on TBP call
+!
+! Contributed by Damian Rouson <rouson@sandia.gov>
+
+module grid_module
+ implicit none
+ type grid
+ contains
+   procedure :: new_grid
+ end type
+contains
+ subroutine new_grid(this)
+   class(grid) :: this
+ end subroutine
+end module
+
+module field_module
+ use grid_module
+ implicit none
+
+ type field
+   type(grid) :: mesh
+ end type
+
+contains
+
+ type(field) function new_field()
+  call new_field%mesh%new_grid()
+ end function
+
+ function new_field2() result(new)
+  type(field) :: new
+  call new%mesh%new_grid()
+ end function
+
+ type(field) function new_field3()
+  call g()
+ contains
+  subroutine g()
+    call new_field3%mesh%new_grid()
+  end subroutine g
+ end function new_field3
+
+end module
+
+! { dg-final { cleanup-modules "grid_module field_module" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_12.f03 b/gcc/testsuite/gfortran.dg/typebound_call_12.f03
new file mode 100644
index 000000000..afb0fda71
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_12.f03
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! { dg-options "-fcheck=bounds" }
+!
+! PR 42804: ICE with -fcheck=bounds and type bound procedure call on array element
+!
+! Contributed by Ian Harvey <ian_harvey@bigpond.com>
+
+MODULE ModA
+  IMPLICIT NONE
+  PRIVATE
+  TYPE, PUBLIC :: A
+  CONTAINS
+    PROCEDURE :: Proc => a_proc
+  END TYPE A
+CONTAINS
+  SUBROUTINE a_proc(this, stat)
+    CLASS(A), INTENT(INOUT) :: this
+    INTEGER, INTENT(OUT) :: stat
+    WRITE (*, *) 'a_proc'
+    stat = 0
+  END SUBROUTINE a_proc
+END MODULE ModA
+
+PROGRAM ProgA
+  USE ModA
+  IMPLICIT NONE
+  INTEGER :: ierr
+  INTEGER :: i
+  TYPE(A), ALLOCATABLE :: arr(:)
+  ALLOCATE(arr(2))
+  DO i = 1, 2
+    CALL arr(i)%Proc(ierr)
+  END DO
+END PROGRAM ProgA
+ 
+! { dg-final { cleanup-modules "ModA" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_13.f03 b/gcc/testsuite/gfortran.dg/typebound_call_13.f03
new file mode 100644
index 000000000..0800ba505
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_13.f03
@@ -0,0 +1,43 @@
+! { dg-do run }
+!
+! PR 43256: [OOP] TBP with missing optional arg
+!
+! Contributed by Janus Weil
+
+module module_myobj
+
+  implicit none
+
+  type :: myobj
+  contains
+    procedure, nopass :: myfunc
+  end type
+
+contains
+
+  integer function myfunc(status)
+    integer, optional :: status
+    if (present(status)) then
+      myfunc = 1
+    else
+      myfunc = 2
+    end if
+  end function
+
+end module
+
+
+program test_optional
+
+  use :: module_myobj
+  implicit none
+
+  integer     :: res = 0
+  type(myobj) :: myinstance
+
+  res = myinstance%myfunc()
+  if (res /= 2) call abort()
+
+end program
+
+! { dg-final { cleanup-modules "module_myobj" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_14.f03 b/gcc/testsuite/gfortran.dg/typebound_call_14.f03
new file mode 100644
index 000000000..e8cbf846e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_14.f03
@@ -0,0 +1,29 @@
+! { dg-do compile }
+!
+! PR 44211: [OOP] ICE with TBP of pointer component of derived type array
+!
+! Original test case by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
+! Modified by Janus Weil <janus@gcc.gnu.org>
+
+module ice_module
+  type::ice_type
+     class(ice_type),pointer::next
+   contains
+     procedure::ice_sub
+     procedure::ice_fun
+  end type ice_type
+contains
+  subroutine ice_sub(this)
+    class(ice_type)::this
+  end subroutine
+  integer function ice_fun(this)
+    class(ice_type)::this
+  end function
+  subroutine ice()
+    type(ice_type),dimension(2)::ice_array
+    call ice_array(1)%next%ice_sub()
+    print *,ice_array(2)%next%ice_fun()
+  end subroutine
+end module ice_module
+
+! { dg-final { cleanup-modules "ice_module" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_15.f03 b/gcc/testsuite/gfortran.dg/typebound_call_15.f03
new file mode 100644
index 000000000..ac6a668cc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_15.f03
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+! PR 44558: [OOP] ICE on invalid code: called TBP subroutine as TBP function
+!
+! Contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
+
+module ice5
+  type::a_type
+   contains  
+     procedure::a_subroutine_1
+     procedure::a_subroutine_2
+  end type a_type
+contains
+  real function a_subroutine_1(this)
+    class(a_type)::this
+    real::res
+    res=this%a_subroutine_2()     ! { dg-error "should be a FUNCTION" }
+  end function
+  subroutine a_subroutine_2(this)
+    class(a_type)::this
+    call this%a_subroutine_1()    ! { dg-error "should be a SUBROUTINE" }
+  end subroutine
+end module ice5
+ 
+! { dg-final { cleanup-modules "ice5" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_16.f03 b/gcc/testsuite/gfortran.dg/typebound_call_16.f03
new file mode 100644
index 000000000..fdd60c603
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_16.f03
@@ -0,0 +1,35 @@
+! { dg-do compile }
+!
+! PR 41685: [OOP] internal compiler error: verify_flow_info failed
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+module base_mat_mod
+
+  type  :: base_sparse_mat
+  contains 
+    procedure, pass(a) :: get_nrows
+  end type base_sparse_mat
+  
+contains
+
+  integer function get_nrows(a)
+    implicit none 
+    class(base_sparse_mat), intent(in) :: a
+  end function get_nrows
+
+end module  base_mat_mod
+
+
+  use base_mat_mod
+
+  type, extends(base_sparse_mat) :: s_coo_sparse_mat
+  end type s_coo_sparse_mat
+
+  class(s_coo_sparse_mat), pointer :: a
+  Integer :: m
+  m = a%get_nrows()
+
+end
+
+! { dg-final { cleanup-modules "base_mat_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_17.f03 b/gcc/testsuite/gfortran.dg/typebound_call_17.f03
new file mode 100644
index 000000000..5bd054707
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_17.f03
@@ -0,0 +1,57 @@
+! { dg-do run }
+!
+! PR 44912: [OOP] Segmentation fault on TBP
+!
+! Contributed by Satish.BD <bdsatish@gmail.com>
+
+module polynomial
+implicit none
+
+private
+
+type, public :: polynom
+   complex, allocatable, dimension(:) :: a
+   integer :: n
+ contains
+   procedure :: init_from_coeff
+   procedure :: get_degree
+   procedure :: add_poly
+end type polynom
+
+contains
+  subroutine init_from_coeff(self, coeff)
+    class(polynom), intent(inout) :: self
+    complex, dimension(:), intent(in) :: coeff
+    self%n = size(coeff) - 1
+    allocate(self%a(self%n + 1))
+    self%a = coeff
+    print *,"ifc:",self%a
+  end subroutine init_from_coeff
+
+  function get_degree(self)   result(n)
+    class(polynom), intent(in) :: self
+    integer :: n
+    print *,"gd"
+    n = self%n
+  end function get_degree
+
+  subroutine add_poly(self)
+    class(polynom), intent(in) :: self
+    integer :: s
+    print *,"ap"
+    s = self%get_degree()         !!!! fails here
+  end subroutine
+
+end module polynomial
+
+program test_poly
+   use polynomial, only: polynom
+
+   type(polynom) :: p1
+
+   call p1%init_from_coeff([(1,0),(2,0),(3,0)])
+   call p1%add_poly()
+
+end program test_poly
+
+! { dg-final { cleanup-modules "polynomial" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_18.f03 b/gcc/testsuite/gfortran.dg/typebound_call_18.f03
new file mode 100644
index 000000000..bb94717ad
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_18.f03
@@ -0,0 +1,67 @@
+! { dg-do run }
+!
+! PR 45271: [OOP] Polymorphic code breaks when changing order of USE statements
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+
+module abstract_vector
+  implicit none
+  type, abstract :: vector_class
+  contains
+    procedure(op_assign_v_v), deferred :: assign
+  end type vector_class
+  abstract interface
+    subroutine op_assign_v_v(this,v)
+      import vector_class
+      class(vector_class), intent(inout) :: this
+      class(vector_class), intent(in)    :: v
+    end subroutine
+  end interface
+end module abstract_vector
+
+module concrete_vector
+  use abstract_vector
+  implicit none
+  type, extends(vector_class) :: trivial_vector_type
+  contains
+    procedure :: assign => my_assign
+  end type
+contains
+  subroutine my_assign (this,v)
+    class(trivial_vector_type), intent(inout) :: this
+    class(vector_class),        intent(in)    :: v
+    write (*,*) 'Oops in concrete_vector::my_assign'
+    call abort ()
+  end subroutine
+end module concrete_vector
+
+module concrete_gradient
+  use abstract_vector
+  implicit none
+  type, extends(vector_class) :: trivial_gradient_type
+  contains
+    procedure :: assign => my_assign
+  end type
+contains
+  subroutine my_assign (this,v)
+    class(trivial_gradient_type), intent(inout) :: this
+    class(vector_class),          intent(in)    :: v
+    write (*,*) 'concrete_gradient::my_assign'
+  end subroutine
+end module concrete_gradient
+
+program main
+  !--- exchange these two lines to make the code work:
+  use concrete_vector    ! (1)
+  use concrete_gradient  ! (2)
+  !---
+  implicit none
+  type(trivial_gradient_type)      :: g_initial
+  class(vector_class),  allocatable :: g
+  print *, "cg: before g%assign"
+  allocate(trivial_gradient_type :: g)
+  call g%assign (g_initial)
+  print *, "cg: after  g%assign"
+end program main
+
+! { dg-final { cleanup-modules "abstract_vector concrete_vector concrete_gradient" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_19.f03 b/gcc/testsuite/gfortran.dg/typebound_call_19.f03
new file mode 100644
index 000000000..95b272a80
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_19.f03
@@ -0,0 +1,51 @@
+! { dg-do run }
+!
+! PR 47455: [4.6 Regression][OOP] internal compiler error: in fold_convert_loc, at fold-const.c:2028
+!
+! Contributed by Thomas Henlich <thenlich@users.sourceforge.net>
+
+module class_t
+  type :: tx
+    integer :: i
+  end type
+  type :: t
+    type(tx) :: x
+    procedure(find_x), pointer :: ppc
+  contains
+    procedure :: find_x
+  end type
+  type(tx), target :: zero = tx(0)
+contains
+  function find_x(this)
+    class(t), intent(in) :: this
+    type(tx), pointer :: find_x
+    find_x => zero
+  end function find_x
+end module
+
+program test
+  use class_t
+  class(t),allocatable :: this
+  procedure(find_x), pointer :: pp
+  allocate(this)
+  ! (1) ordinary function call
+  zero = tx(1)
+  this%x = find_x(this)
+  if (this%x%i /= 1) call abort()
+  ! (2) procedure pointer
+  zero = tx(2)
+  pp => find_x
+  this%x = pp(this)
+  if (this%x%i /= 2) call abort()
+  ! (3) PPC
+  zero = tx(3)
+  this%ppc => find_x
+  this%x = this%ppc()
+  if (this%x%i /= 3) call abort()
+   ! (4) TBP
+  zero = tx(4)
+  this%x = this%find_x()
+  if (this%x%i /= 4) call abort()
+end
+
+! { dg-final { cleanup-modules "class_t" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_2.f03 b/gcc/testsuite/gfortran.dg/typebound_call_2.f03
new file mode 100644
index 000000000..5d70f7c17
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_2.f03
@@ -0,0 +1,90 @@
+! { dg-do run }
+
+! Type-bound procedures
+! Check calls with passed-objects.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE add
+    INTEGER :: wrong
+    INTEGER :: val
+  CONTAINS
+    PROCEDURE, PASS :: func => func_add
+    PROCEDURE, PASS(me) :: sub => sub_add
+  END TYPE add
+
+  TYPE trueOrFalse
+    LOGICAL :: val
+  CONTAINS
+    PROCEDURE, PASS :: swap
+  END TYPE trueOrFalse
+
+CONTAINS
+
+  INTEGER FUNCTION func_add (me, x)
+    IMPLICIT NONE
+    CLASS(add) :: me
+    INTEGER :: x
+    func_add = me%val + x
+  END FUNCTION func_add
+
+  SUBROUTINE sub_add (res, me, x)
+    IMPLICIT NONE
+    INTEGER, INTENT(OUT) :: res
+    CLASS(add), INTENT(IN) :: me
+    INTEGER, INTENT(IN) :: x
+    res = me%val + x
+  END SUBROUTINE sub_add
+
+  SUBROUTINE swap (me1, me2)
+    IMPLICIT NONE
+    CLASS(trueOrFalse), INTENT(INOUT) :: me1, me2
+
+    IF (.NOT. me1%val .OR. me2%val) THEN
+      CALL abort ()
+    END IF
+    
+    me1%val = .FALSE.
+    me2%val = .TRUE.
+  END SUBROUTINE swap
+
+  ! Do the testing here, in the same module as the type is.
+  SUBROUTINE test ()
+    IMPLICIT NONE
+
+    TYPE(add) :: adder
+    TYPE(trueOrFalse) :: t, f
+
+    INTEGER :: x
+
+    adder%wrong = 0
+    adder%val = 42
+    IF (adder%func (8) /= 50) THEN
+      CALL abort ()
+    END IF
+
+    CALL adder%sub (x, 8)
+    IF (x /=  50) THEN
+      CALL abort ()
+    END IF
+
+    t%val = .TRUE.
+    f%val = .FALSE.
+
+    CALL t%swap (f)
+    CALL f%swap (t)
+
+    IF (.NOT. t%val .OR. f%val) THEN
+      CALL abort ()
+    END IF
+  END SUBROUTINE test
+
+END MODULE m
+
+PROGRAM main
+  USE m, ONLY: test
+  CALL test ()
+END PROGRAM main
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_20.f03 b/gcc/testsuite/gfortran.dg/typebound_call_20.f03
new file mode 100644
index 000000000..61eee5ba0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_20.f03
@@ -0,0 +1,41 @@
+! { dg-do run }
+!
+! PR 47565: [4.6 Regression][OOP] Segfault with TBP
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+module class_t
+  type :: t
+    procedure(find_y), pointer, nopass :: ppc
+  contains
+    procedure, nopass :: find_y
+  end type
+  integer, private :: count = 0
+contains
+  function find_y() result(res)
+    integer, allocatable :: res
+    allocate(res)
+    count = count + 1
+    res = count
+  end function
+end module
+
+program p
+  use class_t
+  class(t), allocatable :: this
+  integer :: y
+
+  allocate(this)
+  this%ppc => find_y
+  ! (1) ordinary procedure
+  y = find_y()
+  if (y/=1) call abort()
+  ! (2) procedure pointer component
+  y = this%ppc()
+  if (y/=2) call abort()
+  ! (3) type-bound procedure
+  y = this%find_y()
+  if (y/=3) call abort()
+end 
+
+! { dg-final { cleanup-modules "class_t" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_3.f03 b/gcc/testsuite/gfortran.dg/typebound_call_3.f03
new file mode 100644
index 000000000..eabb28ef1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_3.f03
@@ -0,0 +1,48 @@
+! { dg-do run }
+
+! Type-bound procedures
+! Check that calls work across module-boundaries.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE trueOrFalse
+    LOGICAL :: val
+  CONTAINS
+    PROCEDURE, PASS :: swap
+  END TYPE trueOrFalse
+
+CONTAINS
+
+  SUBROUTINE swap (me1, me2)
+    IMPLICIT NONE
+    CLASS(trueOrFalse), INTENT(INOUT) :: me1, me2
+
+    IF (.NOT. me1%val .OR. me2%val) THEN
+      CALL abort ()
+    END IF
+    
+    me1%val = .FALSE.
+    me2%val = .TRUE.
+  END SUBROUTINE swap
+
+END MODULE m
+
+PROGRAM main
+  USE m, ONLY: trueOrFalse
+  IMPLICIT NONE
+
+  TYPE(trueOrFalse) :: t, f
+
+  t%val = .TRUE.
+  f%val = .FALSE.
+
+  CALL t%swap (f)
+  CALL f%swap (t)
+
+  IF (.NOT. t%val .OR. f%val) THEN
+    CALL abort ()
+  END IF
+END PROGRAM main
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_4.f03 b/gcc/testsuite/gfortran.dg/typebound_call_4.f03
new file mode 100644
index 000000000..6cb5e69e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_4.f03
@@ -0,0 +1,51 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Check for recognition/errors with more complicated references and some
+! error-handling in general.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE t
+  CONTAINS
+    PROCEDURE, PASS :: proc
+    PROCEDURE, NOPASS :: func
+  END TYPE t
+
+  TYPE compt
+    TYPE(t) :: myobj
+  END TYPE compt
+
+CONTAINS
+
+  SUBROUTINE proc (me)
+    IMPLICIT NONE
+    CLASS(t), INTENT(INOUT) :: me
+  END SUBROUTINE proc
+
+  INTEGER FUNCTION func ()
+    IMPLICIT NONE
+    func = 1812
+  END FUNCTION func
+
+  SUBROUTINE test ()
+    IMPLICIT NONE
+    TYPE(compt) :: arr(2)
+
+    ! These two are OK.
+    CALL arr(1)%myobj%proc ()
+    WRITE (*,*) arr(2)%myobj%func ()
+
+    ! Can't CALL a function or take the result of a SUBROUTINE.
+    CALL arr(1)%myobj%func () ! { dg-error "SUBROUTINE" }
+    WRITE (*,*) arr(2)%myobj%proc () ! { dg-error "FUNCTION" }
+
+    ! Error.
+    CALL arr(2)%myobj%proc () x ! { dg-error "Junk after" }
+    WRITE (*,*) arr(1)%myobj%func ! { dg-error "Expected argument list" }
+  END SUBROUTINE test
+
+END MODULE m
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_5.f03 b/gcc/testsuite/gfortran.dg/typebound_call_5.f03
new file mode 100644
index 000000000..d9a845b07
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_5.f03
@@ -0,0 +1,41 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Check for correct access-checking on type-bound procedures.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE t
+  CONTAINS
+    PROCEDURE, NOPASS, PRIVATE :: priv => proc
+    PROCEDURE, NOPASS, PUBLIC :: publ => proc
+  END TYPE t
+
+CONTAINS
+
+  SUBROUTINE proc ()
+  END SUBROUTINE proc
+
+  ! This is inside the module.
+  SUBROUTINE test1 ()
+    IMPLICIT NONE
+    TYPE(t) :: obj
+
+    CALL obj%priv () ! { dg-bogus "PRIVATE" }
+    CALL obj%publ ()
+  END SUBROUTINE test1
+
+END MODULE m
+
+! This is outside the module.
+SUBROUTINE test2 ()
+  USE m
+  IMPLICIT NONE
+  TYPE(t) :: obj
+
+  CALL obj%priv () ! { dg-error "PRIVATE" }
+  CALL obj%publ ()
+END SUBROUTINE test2
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_6.f03 b/gcc/testsuite/gfortran.dg/typebound_call_6.f03
new file mode 100644
index 000000000..0ad510eda
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_6.f03
@@ -0,0 +1,45 @@
+! { dg-do run }
+! { dg-output "Super(\n|\r\n|\r).*Sub" }
+
+! Type-bound procedures
+! Check for calling right overloaded procedure.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE supert
+  CONTAINS
+    PROCEDURE, NOPASS :: proc => proc_super
+  END TYPE supert
+
+  TYPE, EXTENDS(supert) :: subt
+  CONTAINS
+    PROCEDURE, NOPASS :: proc => proc_sub
+  END TYPE subt
+
+CONTAINS
+
+  SUBROUTINE proc_super ()
+    IMPLICIT NONE
+    WRITE (*,*) "Super"
+  END SUBROUTINE proc_super
+
+  SUBROUTINE proc_sub ()
+    IMPLICIT NONE
+    WRITE (*,*) "Sub"
+  END SUBROUTINE proc_sub
+
+END MODULE m
+
+PROGRAM main
+  USE m
+  IMPLICIT NONE
+
+  TYPE(supert) :: super
+  TYPE(subt) :: sub
+
+  CALL super%proc
+  CALL sub%proc
+END PROGRAM main
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_7.f03 b/gcc/testsuite/gfortran.dg/typebound_call_7.f03
new file mode 100644
index 000000000..03a1a51cc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_7.f03
@@ -0,0 +1,50 @@
+! { dg-do compile }
+
+! PR fortran/37429
+! Checks for assignments from type-bound functions.
+
+MODULE touching
+  IMPLICIT NONE
+
+  TYPE :: EqnSys33
+  CONTAINS
+    PROCEDURE, NOPASS :: solve1
+    PROCEDURE, NOPASS :: solve2
+    PROCEDURE, NOPASS :: solve3
+  END TYPE EqnSys33
+
+CONTAINS
+
+  FUNCTION solve1 ()
+    IMPLICIT NONE
+    REAL :: solve1(3)
+    solve1 = 0.0
+  END FUNCTION solve1
+
+  CHARACTER(len=5) FUNCTION solve2 ()
+    IMPLICIT NONE
+    solve2 = "hello"
+  END FUNCTION solve2
+
+  REAL FUNCTION solve3 ()
+    IMPLICIT NONE
+    solve3 = 4.2
+  END FUNCTION solve3
+
+  SUBROUTINE fill_gap ()
+    IMPLICIT NONE
+    TYPE(EqnSys33) :: sys
+    REAL :: res
+    REAL :: resArr(3), resSmall(2)
+
+    res = sys%solve1 () ! { dg-error "Incompatible rank" }
+    res = sys%solve2 () ! { dg-error "Can't convert" }
+    resSmall = sys%solve1 () ! { dg-error "Different shape" }
+
+    res = sys%solve3 ()
+    resArr = sys%solve1 ()
+  END SUBROUTINE fill_gap
+
+END MODULE touching
+
+! { dg-final { cleanup-modules "touching" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_8.f03 b/gcc/testsuite/gfortran.dg/typebound_call_8.f03
new file mode 100644
index 000000000..3f65846b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_8.f03
@@ -0,0 +1,32 @@
+! { dg-do compile }
+
+! PR fortran/37429
+! This used to ICE, check that is fixed.
+
+MODULE touching
+  IMPLICIT NONE
+
+  TYPE :: EqnSys33
+  CONTAINS
+    PROCEDURE, NOPASS :: solve1
+  END TYPE EqnSys33
+
+CONTAINS
+
+  FUNCTION solve1 ()
+    IMPLICIT NONE
+    REAL :: solve1(3)
+    solve1 = 0.0
+  END FUNCTION solve1
+
+  SUBROUTINE fill_gap ()
+    IMPLICIT NONE
+    TYPE(EqnSys33) :: sys
+    REAL :: res
+
+    res = sys%solve1 () ! { dg-error "Incompatible rank" }
+  END SUBROUTINE fill_gap
+
+END MODULE touching
+
+! { dg-final { cleanup-modules "touching" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_9.f03 b/gcc/testsuite/gfortran.dg/typebound_call_9.f03
new file mode 100644
index 000000000..4863f07eb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_9.f03
@@ -0,0 +1,60 @@
+! { dg-do compile }
+
+! PR fortran/37638
+! If a PASS(arg) is invalid, a call to this routine later would ICE in
+! resolving.  Check that this also works for GENERIC, in addition to the
+! PR's original test.
+
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+module foo_mod
+  implicit none 
+
+  type base_foo_type 
+    integer           :: nr,nc
+    integer, allocatable :: iv1(:), iv2(:)
+
+  contains
+
+    procedure, pass(a) :: makenull ! { dg-error "has no argument 'a'" }
+    generic :: null2 => makenull   ! { dg-error "Undefined specific binding" }
+
+  end type base_foo_type
+
+contains
+
+  subroutine makenull(m)
+    implicit none
+    type(base_foo_type), intent(inout) :: m
+
+    m%nr=0
+    m%nc=0
+
+  end subroutine makenull
+
+  subroutine foo_free(a,info)
+    implicit none
+    Type(base_foo_type), intent(inout)  :: A
+    Integer, intent(out)        :: info
+    integer             :: iret
+    info  = 0
+
+
+    if (allocated(a%iv1)) then
+      deallocate(a%iv1,stat=iret)
+      if (iret /= 0) info = max(info,2)
+    endif
+    if (allocated(a%iv2)) then
+      deallocate(a%iv2,stat=iret)
+      if (iret /= 0) info = max(info,3)
+    endif
+
+    call a%makenull()
+    call a%null2 () ! { dg-error "should be a SUBROUTINE" }
+
+    Return
+  End Subroutine foo_free
+
+end module foo_mod
+
+! { dg-final { cleanup-modules "foo_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_1.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_1.f03
new file mode 100644
index 000000000..fb1dfaec6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_generic_1.f03
@@ -0,0 +1,96 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Compiling and errors with GENERIC binding declarations.
+! Bindings with NOPASS.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE somet
+  CONTAINS
+    PROCEDURE, NOPASS :: p1 => intf1
+    PROCEDURE, NOPASS :: p1a => intf1a
+    PROCEDURE, NOPASS :: p2 => intf2
+    PROCEDURE, NOPASS :: p3 => intf3
+    PROCEDURE, NOPASS :: subr
+
+    GENERIC :: gen1 => p1a ! { dg-error "are ambiguous" }
+
+    GENERIC, PUBLIC :: gen1 => p1, p2
+    GENERIC :: gen1 => p3 ! Implicitly PUBLIC.
+    GENERIC, PRIVATE :: gen2 => p1
+
+    GENERIC :: gen2 => p2 ! { dg-error "same access" }
+    GENERIC :: gen1 => p1 ! { dg-error "already defined as specific binding" }
+    GENERIC, PASS :: gen3 => p1 ! { dg-error "Expected access-specifier" }
+    GENERIC :: p1 => p1 ! { dg-error "already a non-generic procedure" }
+    PROCEDURE, NOPASS :: gen1 => intf1 ! { dg-error "already a procedure" }
+    GENERIC :: gen3 => ! { dg-error "specific binding" }
+    GENERIC :: gen4 => p1 x ! { dg-error "Junk after" }
+    GENERIC :: gen5 => p_notthere ! { dg-error "Undefined specific binding" }
+    GENERIC :: gen6 => p1
+    GENERIC :: gen7 => gen6 ! { dg-error "must target a specific binding" }
+
+    GENERIC :: gensubr => p2 ! { dg-error "mixed FUNCTION/SUBROUTINE" }
+    GENERIC :: gensubr => subr
+
+  END TYPE somet
+
+  TYPE supert
+  CONTAINS
+    PROCEDURE, NOPASS :: p1 => intf1
+    PROCEDURE, NOPASS :: p1a => intf1a
+    PROCEDURE, NOPASS :: p2 => intf2
+    PROCEDURE, NOPASS :: p3 => intf3
+    PROCEDURE, NOPASS :: sub1 => subr
+
+    GENERIC :: gen1 => p1, p2
+    GENERIC :: gen1 => p3
+    GENERIC :: gen2 => p1
+    GENERIC :: gensub => sub1
+  END TYPE supert
+
+  TYPE, EXTENDS(supert) :: t
+  CONTAINS
+    GENERIC :: gen2 => p1a ! { dg-error "are ambiguous" }
+    GENERIC :: gen2 => p3
+    GENERIC :: p1 => p2 ! { dg-error "can't overwrite specific" }
+    GENERIC :: gensub => p2 ! { dg-error "mixed FUNCTION/SUBROUTINE" }
+
+    PROCEDURE, NOPASS :: gen1 => intf1 ! { dg-error "Can't overwrite GENERIC" }
+  END TYPE t
+
+CONTAINS
+
+  INTEGER FUNCTION intf1 (a, b)
+    IMPLICIT NONE
+    INTEGER :: a, b
+    intf1 = 42
+  END FUNCTION intf1
+
+  INTEGER FUNCTION intf1a (a, b)
+    IMPLICIT NONE
+    INTEGER :: a, b
+    intf1a = 42
+  END FUNCTION intf1a
+
+  INTEGER FUNCTION intf2 (a, b)
+    IMPLICIT NONE
+    REAL :: a, b
+    intf2 = 42.0
+  END FUNCTION intf2
+
+  LOGICAL FUNCTION intf3 ()
+    IMPLICIT NONE
+    intf3 = .TRUE.
+  END FUNCTION intf3
+
+  SUBROUTINE subr (x)
+    IMPLICIT NONE
+    INTEGER :: x
+  END SUBROUTINE subr
+
+END MODULE m
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_10.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_10.f03
new file mode 100644
index 000000000..590fa5278
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_generic_10.f03
@@ -0,0 +1,32 @@
+! { dg-do compile }
+!
+! PR 49196: [OOP] gfortran compiles invalid generic TBP: dummy arguments are type compatible
+!
+! Contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
+
+module generic
+
+  type :: a_type
+   contains
+     procedure :: a_subroutine
+  end type a_type
+
+  type,extends(a_type) :: b_type
+   contains
+     procedure :: b_subroutine
+     generic :: g_sub => a_subroutine,b_subroutine  ! { dg-error "are ambiguous" }
+  end type b_type
+
+contains
+
+  subroutine a_subroutine(this)
+    class(a_type)::this
+  end subroutine a_subroutine
+
+  subroutine b_subroutine(this)
+    class(b_type)::this
+  end subroutine b_subroutine
+
+end module generic 
+
+! { dg-final { cleanup-modules "generic" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_2.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_2.f03
new file mode 100644
index 000000000..c18b306b9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_generic_2.f03
@@ -0,0 +1,64 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Check for errors with calls to GENERIC bindings and their module IO.
+! Calls with NOPASS.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE supert
+  CONTAINS
+    PROCEDURE, NOPASS :: func_int
+    PROCEDURE, NOPASS :: sub_int
+    GENERIC :: func => func_int
+    GENERIC :: sub => sub_int
+  END TYPE supert
+
+  TYPE, EXTENDS(supert) :: t
+  CONTAINS
+    PROCEDURE, NOPASS :: func_real
+    GENERIC :: func => func_real
+  END TYPE t
+
+CONTAINS
+
+  INTEGER FUNCTION func_int (x)
+    IMPLICIT NONE
+    INTEGER :: x
+    func_int = x
+  END FUNCTION func_int
+
+  INTEGER FUNCTION func_real (x)
+    IMPLICIT NONE
+    REAL :: x
+    func_real = INT(x * 4.2)
+  END FUNCTION func_real
+
+  SUBROUTINE sub_int (x)
+    IMPLICIT NONE
+    INTEGER :: x
+  END SUBROUTINE sub_int
+
+END MODULE m
+
+PROGRAM main
+  USE m
+  IMPLICIT NONE
+
+  TYPE(t) :: myobj
+
+  ! These are ok.
+  CALL myobj%sub (1)
+  WRITE (*,*) myobj%func (1)
+  WRITE (*,*) myobj%func (2.5)
+
+  ! These are not.
+  CALL myobj%sub (2.5) ! { dg-error "no matching specific binding" }
+  WRITE (*,*) myobj%func ("hello") ! { dg-error "no matching specific binding" }
+  CALL myobj%func (2.5) ! { dg-error "SUBROUTINE" }
+  WRITE (*,*) myobj%sub (1) ! { dg-error "FUNCTION" }
+
+END PROGRAM main
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_3.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_3.f03
new file mode 100644
index 000000000..d56f91489
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_generic_3.f03
@@ -0,0 +1,62 @@
+! { dg-do run }
+
+! Type-bound procedures
+! Check calls with GENERIC bindings.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE t
+  CONTAINS
+    PROCEDURE, NOPASS :: plain_int
+    PROCEDURE, NOPASS :: plain_real
+    PROCEDURE, PASS(me) :: passed_intint
+    PROCEDURE, PASS(me) :: passed_realreal
+
+    GENERIC :: gensub => plain_int, plain_real, passed_intint, passed_realreal
+  END TYPE t
+
+CONTAINS
+
+  SUBROUTINE plain_int (x)
+    IMPLICIT NONE
+    INTEGER :: x
+    WRITE (*,*) "Plain Integer"
+  END SUBROUTINE plain_int
+
+  SUBROUTINE plain_real (x)
+    IMPLICIT NONE
+    REAL :: x
+    WRITE (*,*) "Plain Real"
+  END SUBROUTINE plain_real
+
+  SUBROUTINE passed_intint (me, x, y)
+    IMPLICIT NONE
+    CLASS(t) :: me
+    INTEGER :: x, y
+    WRITE (*,*) "Passed Integer"
+  END SUBROUTINE passed_intint
+
+  SUBROUTINE passed_realreal (x, me, y)
+    IMPLICIT NONE
+    REAL :: x, y
+    CLASS(t) :: me
+    WRITE (*,*) "Passed Real"
+  END SUBROUTINE passed_realreal
+
+END MODULE m
+
+PROGRAM main
+  USE m
+  IMPLICIT NONE
+
+  TYPE(t) :: myobj
+
+  CALL myobj%gensub (5)
+  CALL myobj%gensub (2.5)
+  CALL myobj%gensub (5, 5)
+  CALL myobj%gensub (2.5, 2.5)
+END PROGRAM main
+
+! { dg-output "Plain Integer(\n|\r\n|\r).*Plain Real(\n|\r\n|\r).*Passed Integer(\n|\r\n|\r).*Passed Real" }
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_4.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_4.f03
new file mode 100644
index 000000000..ff5cd0582
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_generic_4.f03
@@ -0,0 +1,54 @@
+! { dg-do run }
+
+! PR fortran/37588
+! This test used to not resolve the GENERIC binding.
+
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+module bar_mod
+
+  type foo
+    integer :: i
+    
+  contains
+    procedure, pass(a) :: foo_v => foo_v_inner    
+    procedure, pass(a) :: foo_m => foo_m_inner    
+    generic, public    :: foo => foo_v, foo_m
+  end type foo
+  
+  private foo_v_inner, foo_m_inner
+
+contains
+  
+  subroutine foo_v_inner(x,a)
+    real :: x(:)
+    class(foo) :: a
+    
+    a%i = int(x(1))
+    WRITE (*,*) "Vector"
+  end subroutine foo_v_inner
+  
+  subroutine foo_m_inner(x,a)
+    real :: x(:,:)
+    class(foo) :: a
+    
+    a%i = int(x(1,1))
+    WRITE (*,*) "Matrix"
+  end subroutine foo_m_inner
+end module bar_mod
+
+program foobar
+  use bar_mod
+  type(foo) :: dat
+  real :: x1(10), x2(10,10)
+
+  x1=1
+  x2=2
+ 
+  call dat%foo(x1)
+  call dat%foo(x2)
+
+end program foobar
+
+! { dg-output "Vector.*Matrix" }
+! { dg-final { cleanup-modules "bar_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_5.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_5.f03
new file mode 100644
index 000000000..3fd94b154
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_generic_5.f03
@@ -0,0 +1,55 @@
+! { dg-do run }
+
+! Check that generic bindings targetting ELEMENTAL procedures work.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE :: t
+  CONTAINS
+    PROCEDURE, NOPASS :: double
+    PROCEDURE, NOPASS :: double_here
+    GENERIC :: double_it => double
+    GENERIC :: double_inplace => double_here
+  END TYPE t
+
+CONTAINS
+
+  ELEMENTAL INTEGER FUNCTION double (val)
+    IMPLICIT NONE
+    INTEGER, INTENT(IN) :: val
+    double = 2 * val
+  END FUNCTION double
+
+  ELEMENTAL SUBROUTINE double_here (val)
+    IMPLICIT NONE
+    INTEGER, INTENT(INOUT) :: val
+    val = 2 * val
+  END SUBROUTINE double_here
+
+END MODULE m
+
+PROGRAM main
+  USE m
+  IMPLICIT NONE
+
+  TYPE(t) :: obj
+  INTEGER :: arr(42), arr2(42), arr3(42), arr4(42)
+  INTEGER :: i
+
+  arr = (/ (i, i = 1, 42) /)
+
+  arr2 = obj%double (arr)
+  arr3 = obj%double_it (arr)
+
+  arr4 = arr
+  CALL obj%double_inplace (arr4)
+
+  IF (ANY (arr2 /= 2 * arr) .OR. &
+      ANY (arr3 /= 2 * arr) .OR. &
+      ANY (arr4 /= 2 * arr)) THEN
+    CALL abort ()
+  END IF
+END PROGRAM main
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_6.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_6.f03
new file mode 100644
index 000000000..973e10a35
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_generic_6.f03
@@ -0,0 +1,69 @@
+! { dg-do run }
+!
+! PR 43945: [OOP] Derived type with GENERIC: resolved to the wrong specific TBP
+!
+! Contributed by by Salvatore Filippone <sfilippone@uniroma2.it>
+
+module foo_mod
+  type foo
+    integer :: i
+  contains
+    procedure, pass(a) :: doit
+    procedure, pass(a) :: getit
+    generic, public :: do  => doit
+    generic, public :: get => getit
+  end type foo
+  private doit,getit
+contains
+  subroutine  doit(a)
+    class(foo) :: a
+    a%i = 1
+    write(*,*) 'FOO%DOIT base version'
+  end subroutine doit
+  function getit(a) result(res)
+    class(foo) :: a
+    integer :: res
+    res = a%i
+  end function getit
+end module foo_mod
+
+module foo2_mod
+  use foo_mod
+  type, extends(foo) :: foo2
+    integer :: j
+  contains
+    procedure, pass(a) :: doit  => doit2
+    procedure, pass(a) :: getit => getit2
+  end type foo2
+  private doit2, getit2
+
+contains
+
+  subroutine  doit2(a)
+    class(foo2) :: a
+    a%i = 2
+    a%j = 3
+  end subroutine doit2
+  function getit2(a) result(res)
+    class(foo2) :: a
+    integer :: res
+    res = a%j
+  end function getit2
+end module foo2_mod
+
+program testd15
+  use foo2_mod
+  type(foo2) :: af2
+  class(foo), allocatable :: afab 
+
+  allocate(foo2 :: afab)
+  call af2%do()
+  if (af2%i .ne. 2) call abort
+  if (af2%get() .ne. 3) call abort
+  call afab%do()
+  if (afab%i .ne. 2) call abort
+  if (afab%get() .ne. 3) call abort
+
+end program testd15
+
+! { dg-final { cleanup-modules "foo_mod foo2_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_7.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_7.f03
new file mode 100644
index 000000000..2519ab094
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_generic_7.f03
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR 44434: [OOP] ICE in in gfc_add_component_ref
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+module foo_mod
+  type foo
+  contains
+    procedure :: doit
+    generic :: do => doit
+  end type
+contains
+  subroutine  doit(a) 
+    class(foo) :: a
+  end subroutine
+end module
+
+program testd15
+contains
+  subroutine dodo(x)
+    use foo_mod
+    class(foo) :: x
+    call x%do()
+  end subroutine
+end 
+
+! { dg-final { cleanup-modules "foo_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_8.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_8.f03
new file mode 100644
index 000000000..0ee6610e1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_generic_8.f03
@@ -0,0 +1,29 @@
+! { dg-do compile }
+!
+! PR 44565: [4.6 Regression] [OOP] ICE in gimplify_expr with array-valued generic TBP
+!
+! Contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
+
+module ice6
+
+  type :: t
+   contains
+     procedure :: get_array
+     generic :: get_something => get_array
+  end type
+
+contains
+
+  function get_array(this)
+    class(t) :: this
+    real,dimension(2) :: get_array
+  end function get_array
+
+  subroutine do_something(this)
+    class(t) :: this
+    print *,this%get_something()
+  end subroutine do_something
+
+end module ice6 
+
+! { dg-final { cleanup-modules "ice6" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_9.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_9.f03
new file mode 100644
index 000000000..f85bb3857
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_generic_9.f03
@@ -0,0 +1,63 @@
+! { dg-do run }
+!
+! PR 44936: [OOP] Generic TBP not resolved correctly at compile time
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+module foo_mod
+  type foo
+    integer :: i
+  contains
+    procedure, pass(a) :: doit => doit1
+    procedure, pass(a) :: getit=> getit1
+    generic, public :: do  => doit
+    generic, public :: get => getit
+  end type foo
+  private doit1,getit1
+contains
+  subroutine  doit1(a)
+    class(foo) :: a
+    a%i = 1
+    write(*,*) 'FOO%DOIT base version'
+  end subroutine doit1
+  function getit1(a) result(res)
+    class(foo) :: a
+    integer :: res
+    res = a%i
+  end function getit1
+end module foo_mod
+
+module foo2_mod
+  use foo_mod
+  type, extends(foo) :: foo2
+    integer :: j
+  contains
+    procedure, pass(a) :: doit  => doit2
+    procedure, pass(a) :: getit => getit2
+  end type foo2
+  private doit2, getit2
+contains
+  subroutine  doit2(a)
+    class(foo2) :: a
+    a%i = 2
+    a%j = 3
+  end subroutine doit2
+  function getit2(a) result(res)
+    class(foo2) :: a
+    integer :: res
+    res = a%j
+  end function getit2
+end module foo2_mod
+
+program testd15
+  use foo2_mod
+  type(foo2) :: af2
+
+  call af2%do()
+  if (af2%i .ne. 2) call abort
+  if (af2%get() .ne. 3) call abort
+
+end program testd15
+
+! { dg-final { cleanup-modules "foo_mod foo2_mod" } }
+ 
diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_1.f03 b/gcc/testsuite/gfortran.dg/typebound_operator_1.f03
new file mode 100644
index 000000000..f756a595b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_operator_1.f03
@@ -0,0 +1,49 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Check correct type-bound operator definitions.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE t
+    LOGICAL :: x
+  CONTAINS
+    PROCEDURE, PASS :: onearg
+    PROCEDURE, PASS :: twoarg1
+    PROCEDURE, PASS :: twoarg2
+    PROCEDURE, PASS(me) :: assign_proc
+
+    GENERIC :: OPERATOR(.BINARY.) => twoarg1, twoarg2
+    GENERIC :: OPERATOR(.UNARY.) => onearg
+    GENERIC :: ASSIGNMENT(=) => assign_proc
+  END TYPE t
+
+CONTAINS
+
+  INTEGER FUNCTION onearg (me)
+    CLASS(t), INTENT(IN) :: me
+    onearg = 5
+  END FUNCTION onearg
+
+  INTEGER FUNCTION twoarg1 (me, a)
+    CLASS(t), INTENT(IN) :: me
+    INTEGER, INTENT(IN) :: a
+    twoarg1 = 42
+  END FUNCTION twoarg1
+
+  INTEGER FUNCTION twoarg2 (me, a)
+    CLASS(t), INTENT(IN) :: me
+    REAL, INTENT(IN) :: a
+    twoarg2 = 123
+  END FUNCTION twoarg2
+
+  SUBROUTINE assign_proc (me, b)
+    CLASS(t), INTENT(OUT) :: me
+    LOGICAL, INTENT(IN) :: b
+    me%x = .NOT. b
+  END SUBROUTINE assign_proc
+
+END MODULE m
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_2.f03 b/gcc/testsuite/gfortran.dg/typebound_operator_2.f03
new file mode 100644
index 000000000..cae2cdab7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_operator_2.f03
@@ -0,0 +1,67 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Checks for correct errors with invalid OPERATOR/ASSIGNMENT usage.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE t
+  CONTAINS
+    PROCEDURE, PASS :: onearg
+    PROCEDURE, PASS :: onearg_alt => onearg
+    PROCEDURE, PASS :: onearg_alt2 => onearg
+    PROCEDURE, NOPASS :: nopassed => onearg
+    PROCEDURE, PASS :: threearg
+    PROCEDURE, PASS :: sub
+    PROCEDURE, PASS :: sub2
+    PROCEDURE, PASS :: func
+
+    ! These give errors at the targets' definitions.
+    GENERIC :: OPERATOR(.AND.) => sub2
+    GENERIC :: OPERATOR(*) => onearg
+    GENERIC :: ASSIGNMENT(=) => func
+
+    GENERIC :: OPERATOR(.UOPA.) => sub ! { dg-error "must be a FUNCTION" }
+    GENERIC :: OPERATOR(.UOPB.) => threearg ! { dg-error "at most, two arguments" }
+    ! We can't check for the 'at least one argument' error, because in this case
+    ! the procedure must be NOPASS and that other error is issued.  But of
+    ! course this should be alright.
+
+    GENERIC :: OPERATOR(.UNARY.) => onearg_alt
+    GENERIC, PRIVATE :: OPERATOR(.UNARY.) => onearg_alt2 ! { dg-error "must have the same access" }
+
+    GENERIC :: OPERATOR(.UNARYPRIME.) => nopassed ! { dg-error "can't be NOPASS" }
+    GENERIC :: OPERATOR(-) => nopassed ! { dg-error "can't be NOPASS" }
+  END TYPE t
+
+CONTAINS
+
+  INTEGER FUNCTION onearg (me) ! { dg-error "wrong number of arguments" }
+    CLASS(t), INTENT(IN) :: me
+    onearg = 5
+  END FUNCTION onearg
+
+  INTEGER FUNCTION threearg (a, b, c)
+    CLASS(t), INTENT(IN) :: a, b, c
+    threearg = 42
+  END FUNCTION threearg
+
+  LOGICAL FUNCTION func (me, b) ! { dg-error "must be a SUBROUTINE" }
+    CLASS(t), INTENT(OUT) :: me
+    CLASS(t), INTENT(IN) :: b
+    func = .TRUE.
+  END FUNCTION func
+
+  SUBROUTINE sub (a)
+    CLASS(t), INTENT(IN) :: a
+  END SUBROUTINE sub
+
+  SUBROUTINE sub2 (a, x) ! { dg-error "must be a FUNCTION" }
+    CLASS(t), INTENT(IN) :: a
+    INTEGER, INTENT(IN) :: x
+  END SUBROUTINE sub2
+
+END MODULE m
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_3.f03 b/gcc/testsuite/gfortran.dg/typebound_operator_3.f03
new file mode 100644
index 000000000..51ad1d2f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_operator_3.f03
@@ -0,0 +1,125 @@
+! { dg-do run }
+
+! Type-bound procedures
+! Check they can actually be called and run correctly.
+! This also checks for correct module save/restore.
+
+! FIXME: Check that calls to inherited bindings work once CLASS allows that.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE mynum
+    REAL :: num_real
+    INTEGER :: num_int
+  CONTAINS
+    PROCEDURE, PASS, PRIVATE :: add_mynum ! Check that this may be PRIVATE.
+    PROCEDURE, PASS :: add_int
+    PROCEDURE, PASS :: add_real
+    PROCEDURE, PASS :: assign_int
+    PROCEDURE, PASS :: assign_real
+    PROCEDURE, PASS(from) :: assign_to_int
+    PROCEDURE, PASS(from) :: assign_to_real
+    PROCEDURE, PASS :: get_all
+
+    GENERIC :: OPERATOR(+) => add_mynum, add_int, add_real
+    GENERIC :: OPERATOR(.GET.) => get_all
+    GENERIC :: ASSIGNMENT(=) => assign_int, assign_real, &
+                                assign_to_int, assign_to_real
+  END TYPE mynum
+
+CONTAINS
+
+  TYPE(mynum) FUNCTION add_mynum (a, b)
+    CLASS(mynum), INTENT(IN) :: a, b
+    add_mynum = mynum (a%num_real + b%num_real, a%num_int + b%num_int)
+  END FUNCTION add_mynum
+
+  TYPE(mynum) FUNCTION add_int (a, b)
+    CLASS(mynum), INTENT(IN) :: a
+    INTEGER, INTENT(IN) :: b
+    add_int = mynum (a%num_real, a%num_int + b)
+  END FUNCTION add_int
+
+  TYPE(mynum) FUNCTION add_real (a, b)
+    CLASS(mynum), INTENT(IN) :: a
+    REAL, INTENT(IN) :: b
+    add_real = mynum (a%num_real + b, a%num_int)
+  END FUNCTION add_real
+
+  REAL FUNCTION get_all (me)
+    CLASS(mynum), INTENT(IN) :: me
+    get_all = me%num_real + me%num_int
+  END FUNCTION get_all
+
+  SUBROUTINE assign_real (dest, from)
+    CLASS(mynum), INTENT(INOUT) :: dest
+    REAL, INTENT(IN) :: from
+    dest%num_real = from
+  END SUBROUTINE assign_real
+
+  SUBROUTINE assign_int (dest, from)
+    CLASS(mynum), INTENT(INOUT) :: dest
+    INTEGER, INTENT(IN) :: from
+    dest%num_int = from
+  END SUBROUTINE assign_int
+
+  SUBROUTINE assign_to_real (dest, from)
+    REAL, INTENT(OUT) :: dest
+    CLASS(mynum), INTENT(IN) :: from
+    dest = from%num_real
+  END SUBROUTINE assign_to_real
+
+  SUBROUTINE assign_to_int (dest, from)
+    INTEGER, INTENT(OUT) :: dest
+    CLASS(mynum), INTENT(IN) :: from
+    dest = from%num_int
+  END SUBROUTINE assign_to_int
+
+  ! Test it works basically within the module.
+  SUBROUTINE check_in_module ()
+    IMPLICIT NONE
+    TYPE(mynum) :: num
+
+    num = mynum (1.0, 2)
+    num = num + 7
+    IF (num%num_real /= 1.0 .OR. num%num_int /= 9) CALL abort ()
+  END SUBROUTINE check_in_module
+
+END MODULE m
+
+! Here we see it also works for use-associated operators loaded from a module.
+PROGRAM main
+  USE m, ONLY: mynum, check_in_module
+  IMPLICIT NONE
+
+  TYPE(mynum) :: num1, num2, num3
+  REAL :: real_var
+  INTEGER :: int_var
+
+  CALL check_in_module ()
+
+  num1 = mynum (1.0, 2)
+  num2 = mynum (2.0, 3)
+
+  num3 = num1 + num2
+  IF (num3%num_real /= 3.0 .OR. num3%num_int /= 5) CALL abort ()
+
+  num3 = num1 + 5
+  IF (num3%num_real /= 1.0 .OR. num3%num_int /= 7) CALL abort ()
+
+  num3 = num1 + (-100.5)
+  IF (num3%num_real /= -99.5 .OR. num3%num_int /= 2) CALL abort ()
+
+  num3 = 42
+  num3 = -1.2
+  IF (num3%num_real /= -1.2 .OR. num3%num_int /= 42) CALL abort ()
+
+  real_var = num3
+  int_var = num3
+  IF (real_var /= -1.2 .OR. int_var /= 42) CALL abort ()
+
+  IF (.GET. num1 /= 3.0) CALL abort ()
+END PROGRAM main
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_4.f03 b/gcc/testsuite/gfortran.dg/typebound_operator_4.f03
new file mode 100644
index 000000000..835ceb63f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_operator_4.f03
@@ -0,0 +1,92 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Check for errors with operator calls.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE myint
+    INTEGER :: value
+  CONTAINS
+    PROCEDURE, PASS :: add_int
+    PROCEDURE, PASS :: assign_int
+    GENERIC, PRIVATE :: OPERATOR(.PLUS.) => add_int
+    GENERIC, PRIVATE :: OPERATOR(+) => add_int
+    GENERIC, PRIVATE :: ASSIGNMENT(=) => assign_int
+  END TYPE myint
+
+  TYPE myreal
+    REAL :: value
+  CONTAINS
+    PROCEDURE, PASS :: add_real
+    PROCEDURE, PASS :: assign_real
+    GENERIC :: OPERATOR(.PLUS.) => add_real
+    GENERIC :: OPERATOR(+) => add_real
+    GENERIC :: ASSIGNMENT(=) => assign_real
+  END TYPE myreal
+
+CONTAINS
+
+  PURE TYPE(myint) FUNCTION add_int (a, b)
+    CLASS(myint), INTENT(IN) :: a
+    INTEGER, INTENT(IN) :: b
+    add_int = myint (a%value + b)
+  END FUNCTION add_int
+
+  PURE SUBROUTINE assign_int (dest, from)
+    CLASS(myint), INTENT(OUT) :: dest
+    INTEGER, INTENT(IN) :: from
+    dest%value = from
+  END SUBROUTINE assign_int
+
+  TYPE(myreal) FUNCTION add_real (a, b)
+    CLASS(myreal), INTENT(IN) :: a
+    REAL, INTENT(IN) :: b
+    add_real = myreal (a%value + b)
+  END FUNCTION add_real
+
+  SUBROUTINE assign_real (dest, from)
+    CLASS(myreal), INTENT(OUT) :: dest
+    REAL, INTENT(IN) :: from
+    dest%value = from
+  END SUBROUTINE assign_real
+
+  SUBROUTINE in_module ()
+    TYPE(myint) :: x
+    x = 0 ! { dg-bogus "Can't convert" }
+    x = x + 42 ! { dg-bogus "Operands of" }
+    x = x .PLUS. 5 ! { dg-bogus "Unknown operator" }
+  END SUBROUTINE in_module
+
+  PURE SUBROUTINE iampure ()
+    TYPE(myint) :: x
+
+    x = 0 ! { dg-bogus "is not PURE" }
+    x = x + 42 ! { dg-bogus "to a non-PURE procedure" }
+    x = x .PLUS. 5 ! { dg-bogus "to a non-PURE procedure" }
+  END SUBROUTINE iampure
+
+END MODULE m
+
+PURE SUBROUTINE iampure2 ()
+  USE m
+  IMPLICIT NONE
+  TYPE(myreal) :: x
+
+  x = 0.0 ! { dg-error "is not PURE" }
+  x = x + 42.0 ! { dg-error "to a non-PURE procedure" }
+  x = x .PLUS. 5.0 ! { dg-error "to a non-PURE procedure" }
+END SUBROUTINE iampure2
+
+PROGRAM main
+  USE m
+  IMPLICIT NONE
+  TYPE(myint) :: x
+
+  x = 0 ! { dg-error "Can't convert" }
+  x = x + 42 ! { dg-error "Operands of" }
+  x = x .PLUS. 5 ! { dg-error "Unknown operator" }
+END PROGRAM main
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_5.f03 b/gcc/testsuite/gfortran.dg/typebound_operator_5.f03
new file mode 100644
index 000000000..440c1b52c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_operator_5.f03
@@ -0,0 +1,30 @@
+! { dg-do compile }
+!
+! PR 45933: [4.6 regression] [OOP] ICE in gfc_add_component_ref, at fortran/class.c:77
+!
+! Contributed by Mark Rashid <mmrashid@ucdavis.edu>
+
+MODULE DEF1
+  TYPE :: DAT
+    INTEGER :: NN
+  CONTAINS
+    PROCEDURE :: LESS_THAN
+    GENERIC :: OPERATOR (.LT.) => LESS_THAN
+  END TYPE
+CONTAINS
+  LOGICAL FUNCTION LESS_THAN(A, B)
+    CLASS (DAT), INTENT (IN) :: A, B
+    LESS_THAN = (A%NN .LT. B%NN)
+  END FUNCTION
+END MODULE
+
+PROGRAM P
+  USE DEF1
+  TYPE NODE
+    TYPE (DAT), POINTER :: PT
+  END TYPE
+  CLASS (NODE),POINTER :: A, B
+  PRINT *, A%PT .LT. B%PT
+END
+
+! { dg-final { cleanup-modules "DEF1" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_6.f03 b/gcc/testsuite/gfortran.dg/typebound_operator_6.f03
new file mode 100644
index 000000000..b2c3ee8b4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_operator_6.f03
@@ -0,0 +1,73 @@
+! { dg-do run }
+!
+! PR 45961: [4.6 Regression] [OOP] Problem with polymorphic type-bound operators
+!
+! Contributed by Mark Rashid <mmrashid@ucdavis.edu>
+
+MODULE DAT_MOD
+
+  TYPE :: DAT
+    INTEGER :: NN
+  CONTAINS
+    PROCEDURE :: LESS_THAN
+    GENERIC :: OPERATOR (.LT.) => LESS_THAN
+  END TYPE DAT
+
+CONTAINS
+
+  LOGICAL FUNCTION LESS_THAN(A, B)
+    CLASS (DAT), INTENT (IN) :: A, B
+    LESS_THAN = (A%NN .LT. B%NN)
+  END FUNCTION LESS_THAN
+
+END MODULE DAT_MOD
+
+
+MODULE NODE_MOD
+  USE DAT_MOD
+
+  TYPE NODE
+    INTEGER :: KEY
+    CLASS (DAT), POINTER :: PT
+  CONTAINS
+    PROCEDURE :: LST
+    GENERIC :: OPERATOR (.LT.) => LST
+  END TYPE NODE
+
+CONTAINS
+
+  LOGICAL FUNCTION LST(A, B)
+    CLASS (NODE), INTENT (IN) :: A, B
+    IF (A%KEY .GT. 0 .AND. B%KEY .GT. 0) THEN
+      LST = (A%KEY .LT. B%KEY)
+    ELSE
+      LST = (A%PT .LT. B%PT)
+    END IF
+  END FUNCTION LST
+
+END MODULE NODE_MOD
+
+
+PROGRAM TEST
+  USE NODE_MOD
+  IMPLICIT NONE
+
+  CLASS (DAT), POINTER :: POINTA => NULL(), POINTB => NULL()
+  CLASS (NODE), POINTER :: NDA => NULL(), NDB => NULL()
+
+  ALLOCATE (DAT :: POINTA)
+  ALLOCATE (DAT :: POINTB)
+  ALLOCATE (NODE :: NDA)
+  ALLOCATE (NODE :: NDB)
+
+  POINTA%NN = 5
+  NDA%PT => POINTA
+  NDA%KEY = 2
+  POINTB%NN = 10
+  NDB%PT => POINTB
+  NDB%KEY = 3
+
+  if (.NOT. NDA .LT. NDB) call abort()
+END
+
+! { dg-final { cleanup-modules "DAT_MOD NODE_MOD" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_1.f08 b/gcc/testsuite/gfortran.dg/typebound_proc_1.f08
new file mode 100644
index 000000000..53868a463
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_1.f08
@@ -0,0 +1,69 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Test that the basic syntax for specific bindings is parsed and resolved.
+
+MODULE othermod
+  IMPLICIT NONE
+
+CONTAINS
+
+  SUBROUTINE othersub ()
+    IMPLICIT NONE
+  END SUBROUTINE othersub
+
+END MODULE othermod
+
+MODULE testmod
+  USE othermod
+  IMPLICIT NONE
+
+  TYPE t1
+    ! Might be empty
+  CONTAINS
+    PROCEDURE proc1
+    PROCEDURE, PASS(me) :: p2 => proc2
+  END TYPE t1
+
+  TYPE t2
+    INTEGER :: x
+  CONTAINS
+    PRIVATE
+    PROCEDURE, NOPASS, PRIVATE :: othersub
+    PROCEDURE,NON_OVERRIDABLE,PUBLIC,PASS :: proc3
+  END TYPE t2
+
+  TYPE t3
+  CONTAINS
+    ! This might be empty for Fortran 2008
+  END TYPE t3
+
+  TYPE t4
+  CONTAINS
+    PRIVATE
+    ! Empty, too
+  END TYPE t4
+
+CONTAINS
+  
+  SUBROUTINE proc1 (me)
+    IMPLICIT NONE
+    CLASS(t1) :: me
+  END SUBROUTINE proc1
+
+  REAL FUNCTION proc2 (x, me)
+    IMPLICIT NONE
+    REAL :: x
+    CLASS(t1) :: me
+    proc2 = x / 2
+  END FUNCTION proc2
+
+  INTEGER FUNCTION proc3 (me)
+    IMPLICIT NONE
+    CLASS(t2) :: me
+    proc3 = 42
+  END FUNCTION proc3
+
+END MODULE testmod
+
+! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_10.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_10.f03
new file mode 100644
index 000000000..3f372c815
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_10.f03
@@ -0,0 +1,43 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Test for resolution errors with DEFERRED, namely checks about invalid
+! overriding and taking into account inherited DEFERRED bindings.
+! Also check that DEFERRED attribute is saved to module correctly.
+
+MODULE m1
+  IMPLICIT NONE
+
+  ABSTRACT INTERFACE
+    SUBROUTINE intf ()
+    END SUBROUTINE intf
+  END INTERFACE
+
+  TYPE, ABSTRACT :: abstract_type
+  CONTAINS
+    PROCEDURE(intf), DEFERRED, NOPASS :: def
+    PROCEDURE, NOPASS :: nodef => realproc
+  END TYPE abstract_type
+
+CONTAINS
+
+  SUBROUTINE realproc ()
+  END SUBROUTINE realproc
+
+END MODULE m1
+
+MODULE m2
+  USE m1
+  IMPLICIT NONE
+
+  TYPE, ABSTRACT, EXTENDS(abstract_type) :: sub_type1
+  CONTAINS
+    PROCEDURE(intf), DEFERRED, NOPASS :: nodef ! { dg-error "must not be DEFERRED" }
+  END TYPE sub_type1
+
+  TYPE, EXTENDS(abstract_type) :: sub_type2 ! { dg-error "must be ABSTRACT" }
+  END TYPE sub_type2
+
+END MODULE m2
+
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_11.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_11.f03
new file mode 100644
index 000000000..fafc149f5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_11.f03
@@ -0,0 +1,33 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Test that legal usage of DEFERRED is accepted.
+
+MODULE testmod
+  IMPLICIT NONE
+
+  ABSTRACT INTERFACE
+    SUBROUTINE intf ()
+    END SUBROUTINE intf
+  END INTERFACE
+
+  TYPE, ABSTRACT :: abstract_type
+  CONTAINS
+    PROCEDURE(intf), DEFERRED, NOPASS :: p1
+    PROCEDURE(realproc), DEFERRED, NOPASS :: p2
+  END TYPE abstract_type
+
+  TYPE, EXTENDS(abstract_type) :: sub_type
+  CONTAINS
+    PROCEDURE, NOPASS :: p1 => realproc
+    PROCEDURE, NOPASS :: p2 => realproc
+  END TYPE sub_type
+
+CONTAINS
+
+  SUBROUTINE realproc ()
+  END SUBROUTINE realproc
+
+END MODULE testmod
+
+! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_12.f90 b/gcc/testsuite/gfortran.dg/typebound_proc_12.f90
new file mode 100644
index 000000000..4612d4982
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_12.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! Test the fix for PR41258, where an ICE was caused by a search
+! for a typebound procedure to resolve d%c%e
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+  TYPE a
+    TYPE(b), DIMENSION(:), POINTER :: c  ! { dg-error "type that has not been declared" }
+  END TYPE
+  TYPE(a), POINTER :: d
+  CALL X(d%c%e)         ! { dg-error "before it is defined" }
+end
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_13.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_13.f03
new file mode 100644
index 000000000..62054b6fa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_13.f03
@@ -0,0 +1,49 @@
+! { dg-do compile }
+
+! PR fortran/41177
+! Test for additional errors with type-bound procedure bindings.
+! Namely that non-scalar base objects are rejected for TBP calls which are
+! NOPASS, and that passed-object dummy arguments must be scalar, non-POINTER
+! and non-ALLOCATABLE.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE t
+  CONTAINS
+    PROCEDURE, NOPASS :: myproc
+  END TYPE t
+
+  TYPE t2
+  CONTAINS
+! FIXME: uncomment and dejagnuify once class arrays are enabled
+!    PROCEDURE, PASS :: nonscalar ! { "must be scalar" }
+    PROCEDURE, PASS :: is_pointer ! { dg-error "must not be POINTER" }
+    PROCEDURE, PASS :: is_allocatable ! { dg-error "must not be ALLOCATABLE" }
+  END TYPE t2
+
+CONTAINS
+
+  SUBROUTINE myproc ()
+  END SUBROUTINE myproc
+
+!  SUBROUTINE nonscalar (me)
+!    CLASS(t2), INTENT(IN) :: me(:)
+!  END SUBROUTINE nonscalar
+
+  SUBROUTINE is_pointer (me)
+    CLASS(t2), POINTER, INTENT(IN) :: me
+  END SUBROUTINE is_pointer
+
+  SUBROUTINE is_allocatable (me)
+    CLASS(t2), ALLOCATABLE, INTENT(IN) :: me
+  END SUBROUTINE is_allocatable
+
+  SUBROUTINE test ()
+    TYPE(t) :: arr(2)
+    CALL arr%myproc () ! { dg-error "must be scalar" }
+  END SUBROUTINE test
+
+END MODULE m
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_14.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_14.f03
new file mode 100644
index 000000000..766a0ef66
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_14.f03
@@ -0,0 +1,33 @@
+! { dg-do compile }
+!
+! PR 40117: [OOP][F2008] Type-bound procedure: allow list after PROCEDURE
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m
+
+implicit none
+
+type :: t
+contains
+  procedure :: foo, bar, baz
+end type
+
+contains
+
+  subroutine foo (this)
+    class(t) :: this
+  end subroutine
+
+  real function bar (this)
+    class(t) :: this
+  end function
+
+  subroutine baz (this, par)
+    class(t) :: this
+    integer :: par
+  end subroutine
+
+end
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_15.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_15.f03
new file mode 100644
index 000000000..37907b3f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_15.f03
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR 40117: [OOP][F2008] Type-bound procedure: allow list after PROCEDURE
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org> 
+
+module m
+
+implicit none
+
+type :: t
+contains
+  procedure :: foo
+  procedure :: bar, baz  ! { dg-error "PROCEDURE list" }
+end type
+
+contains
+
+  subroutine foo (this)
+    class(t) :: this
+  end subroutine
+
+  subroutine bar (this)
+    class(t) :: this
+  end subroutine
+
+  subroutine baz (this)
+    class(t) :: this
+  end subroutine
+
+end
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_16.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_16.f03
new file mode 100644
index 000000000..828f51022
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_16.f03
@@ -0,0 +1,58 @@
+! { dg-do compile }
+!
+! PR 44549: [OOP][F2008] Type-bound procedure: bogus error from list after PROCEDURE
+!
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+
+MODULE rational_numbers
+  IMPLICIT NONE
+  PRIVATE
+  TYPE,PUBLIC :: rational
+    PRIVATE
+    INTEGER n,d
+
+    CONTAINS
+    ! ordinary type-bound procedure
+    PROCEDURE :: real => rat_to_real
+    ! specific type-bound procedures for generic support
+    PROCEDURE,PRIVATE :: rat_asgn_i, rat_plus_rat, rat_plus_i
+    PROCEDURE,PRIVATE,PASS(b) :: i_plus_rat
+    ! generic type-bound procedures
+    GENERIC :: ASSIGNMENT(=) => rat_asgn_i
+    GENERIC :: OPERATOR(+) => rat_plus_rat, rat_plus_i, i_plus_rat
+  END TYPE
+  CONTAINS
+    ELEMENTAL REAL FUNCTION rat_to_real(this) RESULT(r)
+      CLASS(rational),INTENT(IN) :: this
+      r = REAL(this%n)/this%d
+    END FUNCTION
+
+    ELEMENTAL SUBROUTINE rat_asgn_i(a,b)
+      CLASS(rational),INTENT(OUT) :: a
+      INTEGER,INTENT(IN) :: b
+      a%n = b
+      a%d = 1
+    END SUBROUTINE
+
+    ELEMENTAL TYPE(rational) FUNCTION rat_plus_i(a,b) RESULT(r)
+      CLASS(rational),INTENT(IN) :: a
+      INTEGER,INTENT(IN) :: b
+      r%n = a%n + b*a%d
+      r%d = a%d
+    END FUNCTION
+
+    ELEMENTAL TYPE(rational) FUNCTION i_plus_rat(a,b) RESULT(r)
+      INTEGER,INTENT(IN) :: a
+      CLASS(rational),INTENT(IN) :: b
+      r%n = b%n + a*b%d
+      r%d = b%d
+    END FUNCTION
+
+    ELEMENTAL TYPE(rational) FUNCTION rat_plus_rat(a,b) RESULT(r)
+      CLASS(rational),INTENT(IN) :: a,b
+      r%n = a%n*b%d + b%n*a%d
+      r%d = a%d*b%d
+    END FUNCTION
+END
+
+! { dg-final { cleanup-modules "rational_numbers" } } 
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_17.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_17.f03
new file mode 100644
index 000000000..5c1a1c30c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_17.f03
@@ -0,0 +1,26 @@
+! { dg-do compile }
+!
+! PR 44962: [OOP] ICE with specification expression SIZE(<CLASS>)
+!
+! Contributed by Satish.BD <bdsatish@gmail.com>
+
+
+module array
+
+type :: t_array
+  real, dimension(10) :: coeff
+contains
+  procedure :: get_coeff
+end type t_array
+
+contains
+
+function get_coeff(self) result(coeff)
+  class(t_array), intent(in) :: self
+  real, dimension(size(self%coeff)) :: coeff !! The SIZE here carashes !!
+end function get_coeff
+
+end module array
+
+
+! { dg-final { cleanup-modules "array" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_18.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_18.f03
new file mode 100644
index 000000000..4ddd178f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_18.f03
@@ -0,0 +1,29 @@
+! { dg-do compile }
+!
+! PR 45456: [4.6 Regression] [OOP] Bogus pointer initialization error on pointer-valued TBP
+!
+! Contributed by Andrew Benson <abenson@its.caltech.edu>
+
+module Merger_Trees
+  private
+  public :: mergerTree
+
+  type mergerTree
+   contains
+     procedure :: getNode => Tree_Node_Get
+  end type mergerTree
+
+contains
+
+  function Tree_Node_Get(thisTree,nodeIndex) result(foundNode)
+    implicit none
+    class(mergerTree), intent(inout) :: thisTree
+    integer,           intent(in)    :: nodeIndex
+    integer,           pointer       :: foundNode
+
+    return
+  end function Tree_Node_Get
+
+end module Merger_Trees
+
+! { dg-final { cleanup-modules "Merger_Trees" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_19.f90 b/gcc/testsuite/gfortran.dg/typebound_proc_19.f90
new file mode 100644
index 000000000..be15bf09f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_19.f90
@@ -0,0 +1,43 @@
+! { dg-do compile }
+!
+! PR fortran/47399
+!
+! Contributed by Wolfgang Kilian.
+!
+
+module mytypes
+   implicit none
+   private
+   public :: mytype, get_i
+
+   integer, save :: i_priv = 13
+   type :: mytype
+      integer :: dummy
+    contains
+      procedure, nopass :: i => get_i
+   end type mytype
+ contains
+   pure function get_i () result (i)
+     integer :: i
+     i = i_priv
+   end function get_i
+end module mytypes
+
+subroutine test()
+   use mytypes
+   implicit none
+
+   type(mytype) :: a
+   type(mytype), parameter :: a_const = mytype (0)
+   integer, dimension (get_i()) :: x            ! #1
+   integer, dimension (a%i()) :: y              ! #2
+   integer, dimension (a_const%i()) :: z        ! #3
+
+   if (size (x) /= 13 .or. size(y) /= 13 .or. size(z) /= 13) call abort()
+!   print *, size (x), size(y), size(z)
+end subroutine test
+
+call test()
+end
+
+! { dg-final { cleanup-modules "mytypes" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_2.f90 b/gcc/testsuite/gfortran.dg/typebound_proc_2.f90
new file mode 100644
index 000000000..70ae2ca73
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_2.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! Type-bound procedures
+! Test that F95 does not allow type-bound procedures
+
+MODULE testmod
+  IMPLICIT NONE
+
+  TYPE t
+    INTEGER :: x
+  CONTAINS ! { dg-error "Fortran 2003" }
+    PROCEDURE proc1 ! { dg-error "Fortran 2003" }
+    PROCEDURE :: proc2 => p2 ! { dg-error "Fortran 2003" }
+  END TYPE t
+
+CONTAINS
+  
+  SUBROUTINE proc1 (me)
+    IMPLICIT NONE
+    TYPE(t1) :: me
+  END SUBROUTINE proc1
+
+  REAL FUNCTION proc2 (me, x)
+    IMPLICIT NONE
+    TYPE(t1) :: me
+    REAL :: x
+    proc2 = x / 2
+  END FUNCTION proc2
+
+END MODULE testmod
+
+! { dg-final { cleanup-modules "testmod" } }
+! { dg-excess-errors "no IMPLICIT type" }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_20.f90 b/gcc/testsuite/gfortran.dg/typebound_proc_20.f90
new file mode 100644
index 000000000..4fee2f3ba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_20.f90
@@ -0,0 +1,68 @@
+! { dg-do compile }
+! TODO: make runtime testcase once bug is fixed
+!
+! PR fortran/47455
+!
+! Based on an example by Thomas Henlich
+!
+
+module class_t
+    type :: tx
+        integer, dimension(:), allocatable :: i
+    end type tx
+    type :: t
+        type(tx), pointer :: x
+        type(tx) :: y
+    contains
+        procedure :: calc
+        procedure :: find_x
+        procedure :: find_y
+    end type t
+contains
+    subroutine calc(this)
+        class(t), target :: this
+        type(tx), target :: that
+        that%i = [1,2]
+        this%x => this%find_x(that, .true.)
+        if (associated (this%x)) call abort()
+        this%x => this%find_x(that, .false.)
+        if(any (this%x%i /= [5, 7])) call abort()
+        if (.not.associated (this%x,that)) call abort()
+        allocate(this%x)
+        if (associated (this%x,that)) call abort()
+        if (allocated(this%x%i)) call abort()
+        this%x = this%find_x(that, .false.)
+        that%i = [3,4]
+        if(any (this%x%i /= [5, 7])) call abort() ! FAILS
+
+        if (allocated (this%y%i)) call abort()
+        this%y = this%find_y()  ! FAILS
+        if (.not.allocated (this%y%i)) call abort()
+        if(any (this%y%i /= [6, 8])) call abort()
+    end subroutine calc
+    function find_x(this, that, l_null)
+       class(t), intent(in) :: this
+       type(tx), target  :: that
+       type(tx), pointer :: find_x
+       logical :: l_null
+       if (l_null) then
+         find_x => null()
+       else
+         find_x => that
+         that%i = [5, 7]
+       end if
+    end function find_x
+    function find_y(this) result(res)
+        class(t), intent(in) :: this
+        type(tx), allocatable :: res
+        allocate(res)
+        res%i = [6, 8]
+   end function find_y
+end module class_t
+
+use class_t
+type(t) :: x
+call x%calc()
+end
+
+! { dg-final { cleanup-modules "class_t" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_21.f90 b/gcc/testsuite/gfortran.dg/typebound_proc_21.f90
new file mode 100644
index 000000000..6c16d46ff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_21.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+!
+! PR fortran/47455
+!
+module class_t
+    type :: tx
+        integer, dimension(:), allocatable :: i
+    end type tx
+    type :: t
+        type(tx), pointer :: x
+    contains
+        procedure :: calc
+        procedure :: find_x
+    end type t
+contains
+    subroutine calc(this)
+        class(t), target :: this
+        this%x = this%find_x()
+    end subroutine calc
+    function find_x(this)
+        class(t), intent(in) :: this
+        type(tx), pointer :: find_x
+        find_x => null()
+    end function find_x
+end module class_t
+
+! { dg-final { cleanup-modules "class_t" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_22.f90 b/gcc/testsuite/gfortran.dg/typebound_proc_22.f90
new file mode 100644
index 000000000..f7691c5f2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_22.f90
@@ -0,0 +1,49 @@
+! { dg-do compile }
+!
+! PR fortran/48810
+!
+! Contributed by Andrew Baldwin
+!
+      module qtest
+      type foobar
+        integer :: x
+        contains
+        private
+        procedure :: gimmex
+        generic, public :: getx => gimmex
+      end type foobar
+      contains
+        function gimmex(foo)
+          class (foobar) :: foo
+          integer :: gimmex
+          gimmex = foo%x
+        end function gimmex
+      end module qtest
+
+      module qtestPriv
+      type foobarPriv
+        integer :: x
+        contains
+        private
+        procedure :: gimmexPriv
+        generic, private :: getxPriv => gimmexPriv
+      end type foobarPriv
+      contains
+        function gimmexPriv(foo)
+          class (foobarPriv) :: foo
+          integer :: gimmex
+          gimmex = foo%x
+        end function gimmexPriv
+      end module qtestPriv
+
+      program quicktest
+      use qtest
+      use qtestPriv
+      type (foobar) :: foo
+      type (foobarPriv) :: fooPriv
+      integer :: bar
+      bar = foo%getx()  ! OK
+      bar = fooPriv%getxPriv() ! { dg-error " is PRIVATE " }
+      end program quicktest
+
+! { dg-final { cleanup-modules "qtest qtestpriv" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_23.f90 b/gcc/testsuite/gfortran.dg/typebound_proc_23.f90
new file mode 100644
index 000000000..ff682a41b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_23.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+!
+! PR 49562: [4.6/4.7 Regression] [OOP] assigning value to type-bound function
+!
+! Contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
+
+module ice
+  type::ice_type
+   contains
+     procedure::ice_func
+  end type
+  integer, target :: it = 0
+contains
+  function ice_func(this)
+    integer, pointer :: ice_func
+    class(ice_type)::this
+    ice_func => it
+  end function ice_func
+  subroutine ice_sub(a)
+    class(ice_type)::a
+    a%ice_func() = 1
+  end subroutine ice_sub
+end module
+
+use ice
+type(ice_type) :: t
+if (it/=0) call abort()
+call ice_sub(t)
+if (it/=1) call abort()
+end
+
+! { dg-final { cleanup-modules "ice" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_24.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_24.f03
new file mode 100644
index 000000000..f200e0efb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_24.f03
@@ -0,0 +1,32 @@
+! { dg-do compile }
+!
+! PR 49112: [4.6/4.7 Regression] [OOP] Missing type-bound procedure, "duplicate save" warnings and internal compiler error
+!
+! Contributed by John <jwmwalrus@gmail.com>
+
+module datetime_mod
+
+  implicit none
+
+  type :: DateTime
+    integer :: year, month, day
+  contains
+    procedure :: getFormattedString
+  end type
+
+  type(DateTime) :: ISO_REFERENCE_DATE = DateTime(1875, 5, 20)
+
+contains
+
+  character function getFormattedString(dt)
+    class(DateTime) :: dt
+  end function
+
+  subroutine test
+    type(DateTime) :: dt
+    print *,dt%getFormattedString()
+  end subroutine
+
+end module 
+
+! { dg-final { cleanup-modules "datetime_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_3.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_3.f03
new file mode 100644
index 000000000..13b90c14f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_3.f03
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! Type-bound procedures
+! Test that F2003 does not allow empty CONTAINS sections.
+
+MODULE testmod
+  IMPLICIT NONE
+
+  TYPE t
+    INTEGER :: x
+  CONTAINS
+  END TYPE t ! { dg-error "Fortran 2008" }
+
+END MODULE testmod
+
+! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_4.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_4.f03
new file mode 100644
index 000000000..60aa728a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_4.f03
@@ -0,0 +1,39 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Test for errors in specific bindings, during parsing (not resolution).
+
+MODULE testmod
+  IMPLICIT NONE
+
+  TYPE t
+    REAL :: a
+  CONTAINS
+    PROCEDURE p0 ! { dg-error "no IMPLICIT|module procedure" }
+    PRIVATE ! { dg-error "must precede" }
+    PROCEDURE p1 => proc1 ! { dg-error "::" }
+    PROCEDURE :: ! { dg-error "Expected binding name" }
+    PROCEDURE ! { dg-error "Expected binding name" }
+    PROCEDURE ? ! { dg-error "Expected binding name" }
+    PROCEDURE :: p2 => ! { dg-error "Expected binding target" }
+    PROCEDURE :: p3 =>, ! { dg-error "Expected binding target" }
+    PROCEDURE p4, ! { dg-error "Expected binding name" }
+    PROCEDURE :: p5 => proc2, ! { dg-error "Expected binding name" }
+    PROCEDURE :: p0 => proc3 ! { dg-error "already a procedure" }
+    PROCEDURE, PASS p6 ! { dg-error "::" }
+    PROCEDURE, PASS NON_OVERRIDABLE ! { dg-error "Expected" }
+    PROCEDURE PASS :: ! { dg-error "Syntax error" }
+    PROCEDURE, PASS (x ! { dg-error "Expected" }
+    PROCEDURE, PASS () ! { dg-error "Expected" }
+    PROCEDURE, NOPASS, PASS ! { dg-error "illegal PASS" }
+    PROCEDURE, PASS, NON_OVERRIDABLE, PASS(x) ! { dg-error "illegal PASS" }
+    PROCEDURE, PUBLIC, PRIVATE ! { dg-error "Duplicate" }
+    PROCEDURE, NON_OVERRIDABLE, NON_OVERRIDABLE ! { dg-error "Duplicate" }
+    PROCEDURE, NOPASS, NOPASS ! { dg-error "illegal NOPASS" }
+  END TYPE t
+
+CONTAINS
+
+END MODULE testmod
+
+! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_5.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_5.f03
new file mode 100644
index 000000000..fdd15b388
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_5.f03
@@ -0,0 +1,119 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Test for errors in specific bindings, during resolution.
+
+MODULE othermod
+  IMPLICIT NONE
+CONTAINS
+
+  REAL FUNCTION proc_noarg ()
+    IMPLICIT NONE
+  END FUNCTION proc_noarg
+
+END MODULE othermod
+
+MODULE testmod
+  USE othermod
+  IMPLICIT NONE
+
+  INTEGER :: noproc
+
+  PROCEDURE() :: proc_nointf
+
+  INTERFACE
+    SUBROUTINE proc_intf ()
+    END SUBROUTINE proc_intf
+  END INTERFACE
+
+  ABSTRACT INTERFACE
+    SUBROUTINE proc_abstract_intf ()
+    END SUBROUTINE proc_abstract_intf
+  END INTERFACE
+
+  TYPE supert
+  CONTAINS
+    PROCEDURE, NOPASS :: super_overrid => proc_sub_noarg
+    PROCEDURE, NOPASS, NON_OVERRIDABLE :: super_nonoverrid => proc_sub_noarg
+  END TYPE supert
+
+  TYPE, EXTENDS(supert) :: t
+  CONTAINS
+
+    ! Bindings that should succeed
+    PROCEDURE, NOPASS :: p0 => proc_noarg
+    PROCEDURE, PASS :: p1 => proc_arg_first
+    PROCEDURE proc_arg_first
+    PROCEDURE, PASS(me) :: p2 => proc_arg_middle
+    PROCEDURE, PASS(me), NON_OVERRIDABLE :: p3 => proc_arg_last
+    PROCEDURE, NOPASS :: p4 => proc_nome
+    PROCEDURE, NOPASS :: p5 => proc_intf
+    PROCEDURE, NOPASS :: super_overrid => proc_sub_noarg
+
+    ! Bindings that should not succeed
+    PROCEDURE :: e0 => undefined ! { dg-error "has no IMPLICIT|module procedure" }
+    PROCEDURE, PASS :: e1 => proc_noarg ! { dg-error "at least one argument" }
+    PROCEDURE :: e2 => proc_noarg ! { dg-error "at least one argument" }
+    PROCEDURE, PASS(me) :: e3 => proc_nome ! { dg-error "no argument 'me'" }
+    PROCEDURE, PASS(me) :: e4 => proc_mewrong ! { dg-error "Non-polymorphic passed-object dummy argument" }
+    PROCEDURE, PASS :: e5 => proc_mewrong ! { dg-error "Non-polymorphic passed-object dummy argument" }
+    PROCEDURE :: e6 => noproc ! { dg-error "module procedure" }
+    PROCEDURE :: e7 => proc_nointf ! { dg-error "explicit interface" }
+    PROCEDURE, NOPASS :: e8 => proc_abstract_intf ! { dg-error "explicit interface" }
+    PROCEDURE :: super_nonoverrid => proc_arg_first ! { dg-error "NON_OVERRIDABLE" }
+
+  END TYPE t
+
+CONTAINS
+
+  SUBROUTINE proc_arg_first (me, x)
+    IMPLICIT NONE
+    CLASS(t) :: me
+    REAL :: x
+  END SUBROUTINE proc_arg_first
+
+  INTEGER FUNCTION proc_arg_middle (x, me, y)
+    IMPLICIT NONE
+    REAL :: x, y
+    CLASS(t) :: me
+  END FUNCTION proc_arg_middle
+
+  SUBROUTINE proc_arg_last (x, me)
+    IMPLICIT NONE
+    CLASS(t) :: me
+    REAL :: x
+  END SUBROUTINE proc_arg_last
+
+  SUBROUTINE proc_nome (arg, x, y)
+    IMPLICIT NONE
+    TYPE(t) :: arg
+    REAL :: x, y
+  END SUBROUTINE proc_nome
+
+  SUBROUTINE proc_mewrong (me, x)
+    IMPLICIT NONE
+    REAL :: x
+    INTEGER :: me
+  END SUBROUTINE proc_mewrong
+
+  SUBROUTINE proc_sub_noarg ()
+  END SUBROUTINE proc_sub_noarg
+
+END MODULE testmod
+
+PROGRAM main
+  IMPLICIT NONE
+
+  TYPE t
+  CONTAINS
+    PROCEDURE, NOPASS :: proc_no_module ! { dg-error "module procedure" }
+  END TYPE t
+
+CONTAINS
+
+  SUBROUTINE proc_no_module ()
+  END SUBROUTINE proc_no_module
+
+END PROGRAM main
+
+! { dg-final { cleanup-modules "othermod testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_6.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_6.f03
new file mode 100644
index 000000000..266cc0231
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_6.f03
@@ -0,0 +1,180 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Test for the check if overriding methods "match" the overridden ones by their
+! characteristics.
+
+MODULE testmod
+  IMPLICIT NONE
+
+  TYPE supert
+  CONTAINS
+
+    ! For checking the PURE/ELEMENTAL matching.
+    PROCEDURE, NOPASS :: pure1 => proc_pure
+    PROCEDURE, NOPASS :: pure2 => proc_pure
+    PROCEDURE, NOPASS :: nonpure => proc_sub
+    PROCEDURE, NOPASS :: elemental1 => proc_elemental
+    PROCEDURE, NOPASS :: elemental2 => proc_elemental
+    PROCEDURE, NOPASS :: nonelem1 => proc_nonelem
+    PROCEDURE, NOPASS :: nonelem2 => proc_nonelem
+
+    ! Same number of arguments!
+    PROCEDURE, NOPASS :: three_args_1 => proc_threearg
+    PROCEDURE, NOPASS :: three_args_2 => proc_threearg
+
+    ! For SUBROUTINE/FUNCTION/result checking.
+    PROCEDURE, NOPASS :: subroutine1 => proc_sub
+    PROCEDURE, NOPASS :: subroutine2 => proc_sub
+    PROCEDURE, NOPASS :: intfunction1 => proc_intfunc
+    PROCEDURE, NOPASS :: intfunction2 => proc_intfunc
+    PROCEDURE, NOPASS :: intfunction3 => proc_intfunc
+
+    ! For access-based checks.
+    PROCEDURE, NOPASS, PRIVATE :: priv => proc_sub
+    PROCEDURE, NOPASS, PUBLIC :: publ1 => proc_sub
+    PROCEDURE, NOPASS, PUBLIC :: publ2 => proc_sub
+
+    ! For passed-object dummy argument checks.
+    PROCEDURE, NOPASS :: nopass1 => proc_stme1
+    PROCEDURE, NOPASS :: nopass2 => proc_stme1
+    PROCEDURE, PASS :: pass1 => proc_stme1
+    PROCEDURE, PASS(me) :: pass2 => proc_stme1
+    PROCEDURE, PASS(me1) :: pass3 => proc_stmeme
+
+    ! For corresponding dummy arguments.
+    PROCEDURE, PASS :: corresp1 => proc_stmeint
+    PROCEDURE, PASS :: corresp2 => proc_stmeint
+    PROCEDURE, PASS :: corresp3 => proc_stmeint
+
+  END TYPE supert
+
+  ! Checking for NON_OVERRIDABLE is in typebound_proc_5.f03.
+
+  TYPE, EXTENDS(supert) :: t
+  CONTAINS
+
+    ! For checking the PURE/ELEMENTAL matching.
+    PROCEDURE, NOPASS :: pure1 => proc_pure ! Ok, both pure.
+    PROCEDURE, NOPASS :: pure2 => proc_sub ! { dg-error "must also be PURE" }
+    PROCEDURE, NOPASS :: nonpure => proc_pure ! Ok, overridden not pure.
+    PROCEDURE, NOPASS :: elemental1 => proc_elemental ! Ok, both elemental.
+    PROCEDURE, NOPASS :: elemental2 => proc_nonelem ! { dg-error "must also be" }
+    PROCEDURE, NOPASS :: nonelem1 => proc_nonelem ! Ok, non elemental.
+    PROCEDURE, NOPASS :: nonelem2 => proc_elemental ! { dg-error "must not be ELEMENTAL" }
+
+    ! Same number of arguments!
+    PROCEDURE, NOPASS :: three_args_1 => proc_threearg ! Ok.
+    PROCEDURE, NOPASS :: three_args_2 => proc_twoarg ! { dg-error "same number of formal arguments" }
+
+    ! For SUBROUTINE/FUNCTION/result checking.
+    PROCEDURE, NOPASS :: subroutine1 => proc_sub ! Ok, both subroutines.
+    PROCEDURE, NOPASS :: subroutine2 => proc_intfunc ! { dg-error "must also be a SUBROUTINE" }
+    PROCEDURE, NOPASS :: intfunction1 => proc_intfunc ! Ok, matching functions.
+    PROCEDURE, NOPASS :: intfunction2 => proc_sub ! { dg-error "must also be a FUNCTION" }
+    PROCEDURE, NOPASS :: intfunction3 => proc_realfunc ! { dg-error "matching result types" }
+
+    ! For access-based checks.
+    PROCEDURE, NOPASS, PUBLIC :: priv => proc_sub ! Ok, increases visibility.
+    PROCEDURE, NOPASS, PUBLIC :: publ1 => proc_sub ! Ok, both PUBLIC.
+    PROCEDURE, NOPASS, PRIVATE :: publ2 => proc_sub ! { dg-error "must not be PRIVATE" }
+
+    ! For passed-object dummy argument checks.
+    PROCEDURE, NOPASS :: nopass1 => proc_stme1 ! Ok, both NOPASS.
+    PROCEDURE, PASS :: nopass2 => proc_tme1 ! { dg-error "must also be NOPASS" }
+    PROCEDURE, PASS :: pass1 => proc_tme1 ! Ok.
+    PROCEDURE, NOPASS :: pass2 => proc_stme1 ! { dg-error "must also be PASS" }
+    PROCEDURE, PASS(me2) :: pass3 => proc_tmeme ! { dg-error "same position" }
+
+    ! For corresponding dummy arguments.
+    PROCEDURE, PASS :: corresp1 => proc_tmeint ! Ok.
+    PROCEDURE, PASS :: corresp2 => proc_tmeintx ! { dg-error "should be named 'a'" }
+    PROCEDURE, PASS :: corresp3 => proc_tmereal ! { dg-error "Types mismatch for dummy argument 'a'" }
+
+  END TYPE t
+
+CONTAINS
+
+  PURE SUBROUTINE proc_pure ()
+  END SUBROUTINE proc_pure
+
+  ELEMENTAL SUBROUTINE proc_elemental (arg)
+    IMPLICIT NONE
+    INTEGER, INTENT(INOUT) :: arg
+  END SUBROUTINE proc_elemental
+
+  SUBROUTINE proc_nonelem (arg)
+    IMPLICIT NONE
+    INTEGER, INTENT(INOUT) :: arg
+  END SUBROUTINE proc_nonelem
+
+  SUBROUTINE proc_threearg (a, b, c)
+    IMPLICIT NONE
+    INTEGER :: a, b, c
+  END SUBROUTINE proc_threearg
+
+  SUBROUTINE proc_twoarg (a, b)
+    IMPLICIT NONE
+    INTEGER :: a, b
+  END SUBROUTINE proc_twoarg
+
+  SUBROUTINE proc_sub ()
+  END SUBROUTINE proc_sub
+
+  INTEGER FUNCTION proc_intfunc ()
+    proc_intfunc = 42
+  END FUNCTION proc_intfunc
+
+  REAL FUNCTION proc_realfunc ()
+    proc_realfunc = 42.0
+  END FUNCTION proc_realfunc
+
+  SUBROUTINE proc_stme1 (me, a)
+    IMPLICIT NONE
+    CLASS(supert) :: me
+    INTEGER :: a
+  END SUBROUTINE proc_stme1
+
+  SUBROUTINE proc_tme1 (me, a)
+    IMPLICIT NONE
+    CLASS(t) :: me
+    INTEGER :: a
+  END SUBROUTINE proc_tme1
+
+  SUBROUTINE proc_stmeme (me1, me2)
+    IMPLICIT NONE
+    CLASS(supert) :: me1, me2
+  END SUBROUTINE proc_stmeme
+
+  SUBROUTINE proc_tmeme (me1, me2)
+    IMPLICIT NONE
+    CLASS(t) :: me1, me2
+  END SUBROUTINE proc_tmeme
+
+  SUBROUTINE proc_stmeint (me, a)
+    IMPLICIT NONE
+    CLASS(supert) :: me
+    INTEGER :: a
+  END SUBROUTINE proc_stmeint
+
+  SUBROUTINE proc_tmeint (me, a)
+    IMPLICIT NONE
+    CLASS(t) :: me
+    INTEGER :: a
+  END SUBROUTINE proc_tmeint
+
+  SUBROUTINE proc_tmeintx (me, x)
+    IMPLICIT NONE
+    CLASS(t) :: me
+    INTEGER :: x
+  END SUBROUTINE proc_tmeintx
+
+  SUBROUTINE proc_tmereal (me, a)
+    IMPLICIT NONE
+    CLASS(t) :: me
+    REAL :: a
+  END SUBROUTINE proc_tmereal
+
+END MODULE testmod
+
+! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_7.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_7.f03
new file mode 100644
index 000000000..ebf611e67
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_7.f03
@@ -0,0 +1,32 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Tests that SEQUENCE and BIND(C) types do not allow a type-bound procedure
+! section.
+
+MODULE testmod
+  USE ISO_C_BINDING
+  IMPLICIT NONE
+
+  TYPE sequencet
+    SEQUENCE
+    INTEGER :: a, b
+  CONTAINS ! { dg-error "SEQUENCE" }
+    PROCEDURE, NOPASS :: proc_noarg
+  END TYPE sequencet
+
+  TYPE, BIND(C) :: bindct
+    INTEGER(c_int) :: a
+    REAL(c_float) :: b
+  CONTAINS ! { dg-error "BIND" }
+    PROCEDURE, NOPASS :: proc_noarg
+  END TYPE bindct
+
+CONTAINS
+
+  SUBROUTINE proc_noarg ()
+  END SUBROUTINE proc_noarg
+
+END MODULE testmod
+
+! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_8.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_8.f03
new file mode 100644
index 000000000..df7764d34
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_8.f03
@@ -0,0 +1,37 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Test for name collision between type-bound procedures and components.
+
+MODULE testmod
+  IMPLICIT NONE
+
+  TYPE t
+    REAL :: comp
+  CONTAINS
+    PROCEDURE, NOPASS :: comp => proc ! { dg-error "same name as a component" }
+  END TYPE t
+
+  TYPE supert
+    INTEGER :: comp1
+  CONTAINS
+    PROCEDURE, NOPASS :: comp2 => proc
+  END TYPE supert
+
+  TYPE, EXTENDS(supert) :: subt1
+    INTEGER :: comp2 ! { dg-error "same name" }
+  END TYPE subt1
+
+  TYPE, EXTENDS(supert) :: subt2
+  CONTAINS
+    PROCEDURE, NOPASS :: comp1 => proc ! { dg-error "same name as an inherited component" }
+  END TYPE subt2
+
+CONTAINS
+
+  SUBROUTINE proc ()
+  END SUBROUTINE proc
+
+END MODULE testmod
+
+! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_9.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_9.f03
new file mode 100644
index 000000000..9106de695
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_9.f03
@@ -0,0 +1,33 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Test for basic parsing errors for invalid DEFERRED.
+
+MODULE testmod
+  IMPLICIT NONE
+
+  ABSTRACT INTERFACE
+    SUBROUTINE intf ()
+    END SUBROUTINE intf
+  END INTERFACE
+
+  TYPE not_abstract
+  CONTAINS
+    PROCEDURE(intf), DEFERRED, NOPASS :: proc ! { dg-error "is not ABSTRACT" }
+  END TYPE not_abstract
+
+  TYPE, ABSTRACT :: abstract_type
+  CONTAINS
+    PROCEDURE, DEFERRED :: p2 ! { dg-error "Interface must be specified" }
+    PROCEDURE(intf), NOPASS :: p3 ! { dg-error "should be declared DEFERRED" }
+    PROCEDURE(intf), DEFERRED, NON_OVERRIDABLE :: p4 ! { dg-error "can't both" }
+    PROCEDURE(unknown), DEFERRED :: p5 ! { dg-error "has no IMPLICIT|module procedure" }
+    PROCEDURE(intf), DEFERRED, DEFERRED :: p6 ! { dg-error "Duplicate DEFERRED" }
+    PROCEDURE(intf), DEFERRED :: p6 => proc ! { dg-error "is invalid for DEFERRED" }
+    PROCEDURE(), DEFERRED :: p7 ! { dg-error "Interface-name expected" }
+    PROCEDURE(intf, DEFERRED) :: p8 ! { dg-error "'\\)' expected" }
+  END TYPE abstract_type
+
+END MODULE testmod
+
+! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/typed_subroutine_1.f90 b/gcc/testsuite/gfortran.dg/typed_subroutine_1.f90
new file mode 100644
index 000000000..38619e7b8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typed_subroutine_1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! Tests the fix for 25088, in which the compiler failed to detect that
+! a called object had a type.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+ INTEGER :: S ! { dg-error "has a type, which is not consistent with the CALL " }
+ CALL S()     ! { dg-error "has a type, which is not consistent with the CALL " }
+ END
+ SUBROUTINE S
+ END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/unary_operator.f90 b/gcc/testsuite/gfortran.dg/unary_operator.f90
new file mode 100644
index 000000000..ee16e18a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unary_operator.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! PR fortran/34536 -- unary operators following arithmetic ones
+
+  real :: x
+  x = 2.0 ** -3 * 5  ! { dg-warning "Unary operator following arithmetic operator" }
+end
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/uncommon_block_data_1.f90 b/gcc/testsuite/gfortran.dg/uncommon_block_data_1.f90
new file mode 100644
index 000000000..54547e89c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/uncommon_block_data_1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! Tests the fix for 25083, in which the compiler failed to detect that
+! data variables in BLOCK DATA were not in COMMON.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+ BLOCK DATA D
+  INTEGER I ! { dg-error "must be in COMMON" }
+  DATA I /1/
+ END BLOCK DATA
+END
diff --git a/gcc/testsuite/gfortran.dg/underflow.f90 b/gcc/testsuite/gfortran.dg/underflow.f90
new file mode 100644
index 000000000..631fd5a43
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/underflow.f90
@@ -0,0 +1,5 @@
+! { dg-do compile }
+program a
+   real x
+   x = tiny(x) / huge(x)  ! { dg-warning "Arithmetic underflow" "" }
+end program a
diff --git a/gcc/testsuite/gfortran.dg/unexpected_interface.f90 b/gcc/testsuite/gfortran.dg/unexpected_interface.f90
new file mode 100644
index 000000000..87c73c850
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unexpected_interface.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR fortran/43592
+! Original code submitted by Joost VandeVondele
+! Dejagnu-ification by Steven G. Kargl
+! 
+ interface assignment (=)
+  interface pseudo_scalar  ! { dg-error "Unexpected INTERFACE statement" }
+  pure function double_tensor2odd (x, t2) result (xt2)
+! { dg-error "Unexpected end of file" "" { target "*-*-*" } 0 }
diff --git a/gcc/testsuite/gfortran.dg/unf_io_convert_1.f90 b/gcc/testsuite/gfortran.dg/unf_io_convert_1.f90
new file mode 100644
index 000000000..317656997
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unf_io_convert_1.f90
@@ -0,0 +1,95 @@
+! { dg-do run }
+! { dg-options "-pedantic" }
+!  This test verifies the most basic sequential unformatted I/O
+!  with convert="swap".
+!  Adapted from seq_io.f.
+!      write 3 records of various sizes
+!      then read them back
+program main
+  implicit none
+  integer size
+  parameter(size=100)
+  logical debug 
+  data debug /.FALSE./
+! set debug to true for help in debugging failures.
+  integer m(2)
+  integer n
+  real r(size)
+  integer i
+  character(4) str
+
+  m(1) = Z'11223344' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
+  m(2) = Z'55667788' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
+  n    = Z'77AABBCC' ! { dg-warning "BOZ literal at .1. outside a DATA statement" }
+  str = 'asdf'
+  do i = 1,size
+     r(i) = i
+  end do
+  open(9,form="unformatted",access="sequential",convert="swap") ! { dg-warning "Extension: CONVERT" }
+  write(9) m  ! an array of 2
+  write(9) n  ! an integer
+  write(9) r  ! an array of reals
+  write(9)str ! String
+! zero all the results so we can compare after they are read back
+  do i = 1,size
+     r(i) = 0
+  end do
+  m(1) = 0
+  m(2) = 0
+  n = 0
+  str = ' '
+  
+  rewind(9)
+  read(9) m
+  read(9) n
+  read(9) r
+  read(9) str
+  !
+  ! check results
+  if (m(1).ne.Z'11223344') then
+     if (debug) then
+        print '(A,Z8)','m(1) incorrect.  m(1) = ',m(1)
+     else
+        call abort
+     endif
+  endif
+  
+  if (m(2).ne.Z'55667788') then
+     if (debug) then
+        print '(A,Z8)','m(2) incorrect.  m(2) = ',m(2)
+     else
+        call abort
+     endif
+  endif
+  
+  if (n.ne.Z'77AABBCC') then
+     if (debug) then
+        print '(A,Z8)','n incorrect.  n = ',n
+     else
+        call abort
+     endif
+  endif
+  
+  do i = 1,size
+     if (int(r(i)).ne.i) then
+        if (debug) then
+           print*,'element ',i,' was ',r(i),' should be ',i
+        else
+           call abort
+        endif
+     endif
+  end do
+  if (str .ne. 'asdf') then
+     if (debug) then
+        print *,'str incorrect, str = ', str
+     else
+        call abort
+     endif
+  end if
+  ! use hexdump to look at the file "fort.9"
+  if (debug) then
+     close(9)
+  else
+     close(9,status='DELETE')
+  endif
+end program main
diff --git a/gcc/testsuite/gfortran.dg/unf_io_convert_2.f90 b/gcc/testsuite/gfortran.dg/unf_io_convert_2.f90
new file mode 100644
index 000000000..f29f6ee24
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unf_io_convert_2.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+program main
+  complex(kind=4) :: c
+  real(kind=4) :: a(2)
+  integer(kind=4) :: i(2)
+  integer(kind=1) :: b(8)
+  integer(kind=8) :: j
+
+  c = (3.14, 2.71)
+  open (10, form="unformatted",convert="swap") ! { dg-warning "Extension: CONVERT" }
+  write (10) c
+  rewind (10)
+  read (10) a
+  if (a(1) /= 3.14 .or. a(2) /= 2.71) call abort
+  close(10,status="delete")
+
+  open (10, form="unformatted",convert="big_endian") ! { dg-warning "Extension: CONVERT" }
+  i = (/ Z'11223344', Z'55667700' /)
+  write (10) i
+  rewind (10)
+  read (10) b
+  if (any(b /= (/ Z'11', Z'22', Z'33', Z'44', Z'55', Z'66', Z'77', Z'00' /))) &
+    call abort
+  backspace 10
+  read (10) j
+  if (j /= Z'1122334455667700') call abort
+  close (10, status="delete")
+
+  open (10, form="unformatted", convert="little_endian") ! { dg-warning "Extension: CONVERT" }
+  write (10) i
+  rewind (10)
+  read (10) b
+  if (any(b /= (/ Z'44', Z'33', Z'22', Z'11', Z'00', Z'77', Z'66', Z'55' /))) &
+    call abort
+  backspace 10
+  read (10) j
+  if (j /= Z'5566770011223344') call abort
+  close (10, status="delete")
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/unf_io_convert_3.f90 b/gcc/testsuite/gfortran.dg/unf_io_convert_3.f90
new file mode 100644
index 000000000..860107354
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unf_io_convert_3.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+program main
+  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+  real(kind=k) a,b,c
+  a = 1.1_k
+  open(10,convert="swap",form="unformatted") ! { dg-warning "Extension: CONVERT" }
+  write(10) a
+  backspace 10
+  read (10) b
+  close(10,status="delete")
+  if (a /= b) call abort
+  write (11) a
+  backspace 11
+  open (11,form="unformatted")
+  read (11) c
+  if (a .ne. c) call abort
+  close (11, status="delete")
+end program main
diff --git a/gcc/testsuite/gfortran.dg/unf_io_convert_4.f90 b/gcc/testsuite/gfortran.dg/unf_io_convert_4.f90
new file mode 100644
index 000000000..88cb78ff0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unf_io_convert_4.f90
@@ -0,0 +1,14 @@
+!  { dg-do run }
+!  { dg-options "-fconvert=big-endian" }
+program main
+  character (len=30) ch
+  open (10,form="unformatted",convert="little_endian") 
+  inquire (10, convert=ch) 
+  if (ch .ne. "LITTLE_ENDIAN") call abort
+  close (10, status="delete")
+
+  open(11,form="unformatted")
+  inquire (11, convert=ch)
+  if (ch .ne. "BIG_ENDIAN") call abort
+  close (11, status="delete")
+end program main
diff --git a/gcc/testsuite/gfortran.dg/unf_read_corrupted_1.f90 b/gcc/testsuite/gfortran.dg/unf_read_corrupted_1.f90
new file mode 100644
index 000000000..e7bb441e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unf_read_corrupted_1.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! Test the error message when an unformatted file has become
+! corrupted.
+program main
+  implicit none
+  integer(kind=4) :: i1, i2
+  integer :: ios
+  character(len=50) :: msg
+
+  ! Write out a truncated unformatted sequential file by
+  ! using unformatted stream.
+
+  open (10, form="unformatted", access="stream", file="foo.dat", &
+  status="unknown")
+  write (10) 16_4, 1_4
+  close (10, status="keep")
+
+  ! Try to read
+  open (10, file="foo.dat", form="unformatted", access="sequential")
+  i1 = 0
+  i2 = 0
+  read (10, iostat=ios, iomsg=msg) i1, i2
+  if (ios == 0) call abort
+  if (i1 /= 1) call abort
+  if (msg /= "Unformatted file structure has been corrupted") call abort
+  close (10, status="delete")
+end program main
diff --git a/gcc/testsuite/gfortran.dg/unf_read_corrupted_2.f90 b/gcc/testsuite/gfortran.dg/unf_read_corrupted_2.f90
new file mode 100644
index 000000000..1788b457d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unf_read_corrupted_2.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! PR31880 silent data corruption in gfortran read statement
+! Test from PR.
+      program r3
+
+      integer(kind=4) :: a(1025),b(1025),c(1025),d(2048),e(1022)
+      
+      a = 5
+      b = 6
+      c = 7
+      e = 8
+
+      do i=1,2048
+         d(i)=i
+      end do
+
+      open  (3,form='unformatted', status="scratch")
+      write (3) a,b,c,d,e
+      rewind 3
+      d = 0
+      read  (3) a,b,c,d
+      close (3)
+
+      if (d(1).ne.1) call abort
+      if (d(2048).ne.2048) call abort
+
+      end
diff --git a/gcc/testsuite/gfortran.dg/unf_short_record_1.f90 b/gcc/testsuite/gfortran.dg/unf_short_record_1.f90
new file mode 100644
index 000000000..45c94c294
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unf_short_record_1.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! PR 29627 - partial reads of unformatted records
+program main
+  character a(3)
+  character(len=50) msg
+  open(10, form="unformatted", status="unknown")
+  write (10) 'a'
+  write (10) 'c'
+  a = 'b'
+  rewind 10
+  read (10, err=20, iomsg=msg) a
+  call abort
+20 continue
+  if (msg .ne. "I/O past end of record on unformatted file") call abort
+  if (a(1) .ne. 'a' .or. a(2) .ne. 'b' .or. a(3) .ne. 'b') call abort
+  close (10, status="delete")
+end program main
diff --git a/gcc/testsuite/gfortran.dg/unformatted_recl_1.f90 b/gcc/testsuite/gfortran.dg/unformatted_recl_1.f90
new file mode 100644
index 000000000..9618ff27a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unformatted_recl_1.f90
@@ -0,0 +1,26 @@
+! { dg-do run { target fd_truncate } } 
+! PR31099 Runtime error on legal code using RECL
+program test
+  integer(kind=4) :: a, b
+  a=1
+  b=2
+  open(10, status="scratch", form="unformatted", recl=8)
+  write(10) a,b
+  write(10) a,b
+  write(10) a,b
+  write(10) b, a
+  rewind(10)
+  write(10) a,b
+  write(10) a,b
+  write(10) a,b
+  write(10) b, a
+  b=0
+  a=0
+  rewind(10)
+  read(10) a, b
+  read(10) a, b
+  read(10) a, b
+  read(10) a, b
+  if ((a.ne.2).and.( b.ne.1)) call abort()
+end program test
+
diff --git a/gcc/testsuite/gfortran.dg/unformatted_subrecord_1.f90 b/gcc/testsuite/gfortran.dg/unformatted_subrecord_1.f90
new file mode 100644
index 000000000..02ed28863
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unformatted_subrecord_1.f90
@@ -0,0 +1,47 @@
+! { dg-do run { target fd_truncate } }
+! { dg-options "-fmax-subrecord-length=16" }
+! Test Intel record markers with 16-byte subrecord sizes.
+! PR 32770:  Use explicit kinds for all integers and constants,
+! to avoid problems with -fdefault-integer-8 and -fdefault-real-8
+program main
+  implicit none
+  integer(kind=4), dimension(20) :: n
+  integer(kind=4), dimension(30) :: m
+  integer(kind=4) :: i
+  real(kind=4) :: r
+  integer(kind=4) :: k
+  ! Maximum subrecord length is 16 here, or the test will fail.
+  open (10, file="f10.dat", &
+       form="unformatted", access="sequential")
+  n = (/ (i**2, i=1, 20) /)
+  write (10) n
+  close (10)
+  ! Read back the file, including record markers.
+  open (10, file="f10.dat", form="unformatted", access="stream")
+  read (10) m
+  if (any(m .ne. (/ -16, 1, 4, 9, 16, 16, -16, 25, 36, 49, 64, &
+       -16, -16, 81, 100, 121, 144, -16, -16, 169, 196, 225, & 
+       256, -16, 16, 289, 324, 361, 400, -16 /))) call abort
+  close (10)
+  open (10, file="f10.dat", form="unformatted", &
+       access="sequential")
+  m = 42
+  read (10) m(1:5)
+  if (any(m(1:5) .ne. (/ 1, 4, 9, 16, 25 /))) call abort
+  if (any(m(6:30) .ne. 42)) call abort
+  backspace 10
+  n = 0
+  read (10) n(1:5)
+  if (any(n(1:5) .ne. (/ 1, 4, 9, 16, 25 /))) call abort
+  if (any(n(6:20) .ne. 0)) call abort
+  ! Append to the end of the file
+  write (10) 3.14_4
+  ! Test multiple backspace statements
+  backspace 10
+  backspace 10
+  read (10) k
+  if (k .ne. 1) call abort
+  read (10) r
+  if (abs(r-3.14_4) .gt. 1e-7) call abort
+  close (10, status="delete")
+end program main
diff --git a/gcc/testsuite/gfortran.dg/unit_1.f90 b/gcc/testsuite/gfortran.dg/unit_1.f90
new file mode 100644
index 000000000..5233bc870
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unit_1.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! PR40638 Run Time Error: Unit number in I/O statement too large
+      program main
+      integer(kind=2) ::  lun, anum
+      integer(kind=1) ::  looney, bin
+      lun  = 12
+      anum = 5
+      looney = 42
+      bin = 23
+      open (lun, status='scratch')
+      write(lun,*) anum
+      anum = 0
+      rewind(lun)
+      read (lun, *) anum
+      if (anum.ne.5) call abort
+      open (looney, status='scratch')
+      write(looney,*)bin
+      bin = 0
+      rewind (looney)
+      read (looney,*)bin
+      if (bin.ne.23) call abort
+      close (lun)
+      close (looney)
+      end
diff --git a/gcc/testsuite/gfortran.dg/unlimited_fmt_1.f08 b/gcc/testsuite/gfortran.dg/unlimited_fmt_1.f08
new file mode 100644
index 000000000..5089d32ff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unlimited_fmt_1.f08
@@ -0,0 +1,17 @@
+! { dg-do run }
+! PR41075 Implement unlimited format item '*'.
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program unlimited
+   implicit none
+   integer i
+   character(len=60) :: string
+   integer, parameter :: n = 10
+   integer, dimension(n) :: iarray
+   iarray = (/ (i,i=1,n) /)
+   do i=1,10
+     write( string, '( "iarray =", *(g0, :, ","))') &
+     & "abcdefg",iarray, i,"jklmnop"
+   end do
+   if (string.ne."iarray =abcdefg,1,2,3,4,5,6,7,8,9,10,10,jklmnop") &
+   & call abort
+end program unlimited
diff --git a/gcc/testsuite/gfortran.dg/unpack_bounds_1.f90 b/gcc/testsuite/gfortran.dg/unpack_bounds_1.f90
new file mode 100644
index 000000000..2b64128e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unpack_bounds_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-fbounds-check -fno-realloc-lhs" }
+! { dg-shouldfail "Incorrect extent in return value of UNPACK intrinsic in dimension 2: is 1, should be 2" }
+program main
+  integer, allocatable, dimension(:) :: vector
+  integer, allocatable, dimension(:,:) :: res
+  logical, allocatable, dimension(:,:) :: mask
+
+  allocate (vector(2))
+  allocate (mask(2,2))
+  allocate (res(2,1))
+
+  vector = 1
+  mask = reshape((/ .TRUE., .FALSE., .FALSE., .TRUE. /),(/2,2/))
+  res = unpack(vector, mask, 0)
+  print *,res
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return value of UNPACK intrinsic in dimension 2: is 1, should be 2" }
diff --git a/gcc/testsuite/gfortran.dg/unpack_bounds_2.f90 b/gcc/testsuite/gfortran.dg/unpack_bounds_2.f90
new file mode 100644
index 000000000..fd049f5ab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unpack_bounds_2.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect size of return value in UNPACK intrinsic: should be at least 3, is 2" }
+program main
+  integer, allocatable, dimension(:) :: vector
+  integer, allocatable, dimension(:,:) :: res
+  logical, allocatable, dimension(:,:) :: mask
+
+  allocate (vector(2))
+  allocate (mask(2,2))
+  allocate (res(2,2))
+
+  vector = 1
+  mask = reshape((/ .TRUE., .TRUE., .FALSE., .TRUE. /),(/2,2/))
+  res = unpack(vector, mask, 0)
+  print *,res
+end program main
+! { dg-output "Fortran runtime error: Incorrect size of return value in UNPACK intrinsic: should be at least 3, is 2" }
diff --git a/gcc/testsuite/gfortran.dg/unpack_bounds_3.f90 b/gcc/testsuite/gfortran.dg/unpack_bounds_3.f90
new file mode 100644
index 000000000..c6734b14c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unpack_bounds_3.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect size of return value in UNPACK intrinsic: should be at least 3, is 2" }
+program main
+  integer, allocatable, dimension(:) :: vector
+  integer, allocatable, dimension(:,:) :: res
+  integer, allocatable, dimension(:,:) :: field
+  logical, allocatable, dimension(:,:) :: mask
+
+  allocate (vector(3))
+  allocate (mask(2,2))
+  allocate (res(2,2))
+  allocate (field(3,2))
+
+  vector = 1
+  field = 0
+  mask = reshape((/ .TRUE., .TRUE., .FALSE., .TRUE. /),(/2,2/))
+  res = unpack(vector, mask, field)
+  print *,res
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in FIELD of UNPACK intrinsic in dimension 1: is 3, should be 2" }
diff --git a/gcc/testsuite/gfortran.dg/unpack_init_expr.f03 b/gcc/testsuite/gfortran.dg/unpack_init_expr.f03
new file mode 100644
index 000000000..924694cad
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unpack_init_expr.f03
@@ -0,0 +1,15 @@
+! { dg-do run }
+!
+! Example from F2003, sec 13.7.125
+!
+  INTEGER, PARAMETER :: m(3,3) = RESHAPE ([1,0,0,0,1,0,0,0,1], [3,3])
+  INTEGER, PARAMETER :: v(3)   = [1,2,3]
+  LOGICAL, PARAMETER :: F = .FALSE., T = .TRUE.
+  LOGICAL, PARAMETER :: q(3,3) = RESHAPE ([F,T,F,T,F,F,F,F,T], [3,3])
+
+  INTEGER, PARAMETER :: r1(3,3) = UNPACK (V, MASK=Q, FIELD=M)
+  INTEGER, PARAMETER :: r2(3,3) = UNPACK (V, MASK=Q, FIELD=0)
+
+  IF (ANY (r1 /= RESHAPE ([1,1,0,2,1,0,0,0,3], [3,3]))) CALL ABORT()
+  IF (ANY (r2 /= RESHAPE ([0,1,0,2,0,0,0,0,3], [3,3]))) CALL ABORT()
+END
diff --git a/gcc/testsuite/gfortran.dg/unpack_mask_1.f90 b/gcc/testsuite/gfortran.dg/unpack_mask_1.f90
new file mode 100644
index 000000000..628473fcf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unpack_mask_1.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! PR 32731 - upack lacked conversion for kind=1 and kind=2 mask
+program main
+  implicit none
+  character(len=80) line
+  logical(kind=1),dimension(2,2) :: mask1
+  logical(kind=1),dimension(2,2) :: mask2
+  mask1 = .true.
+  mask2 = .true.
+  write(unit=line,fmt='(4I4)') unpack((/1,2,3,4/),mask1,0)
+  write(unit=line,fmt='(4I4)') unpack((/1,2,3,4/),mask2,0)
+end program main
diff --git a/gcc/testsuite/gfortran.dg/unpack_zerosize_1.f90 b/gcc/testsuite/gfortran.dg/unpack_zerosize_1.f90
new file mode 100644
index 000000000..8a41f5d9d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unpack_zerosize_1.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! PR 32217 - unpack used to crash at runtime with a zero-sized
+!            array.  Test case submitted by Jaroslav Hajek.
+program bug_report
+  implicit none
+  integer,parameter:: rp = kind(1.d0),na = 6
+  real(rp),allocatable:: hhe(:,:,:),hhc(:,:,:),dv(:)
+  integer:: nhh,ndv
+  nhh = 0
+  allocate(hhe(nhh,2,2))
+  ndv = 2*na + count(hhe /= 0)
+  allocate(hhc(nhh,2,2),dv(ndv))
+  hhc = unpack(dv(2*na+1:),hhe /= 0._rp,0._rp)
+end program bug_report
diff --git a/gcc/testsuite/gfortran.dg/unreferenced_use_assoc_1.f90 b/gcc/testsuite/gfortran.dg/unreferenced_use_assoc_1.f90
new file mode 100644
index 000000000..57892d532
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unreferenced_use_assoc_1.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+! Tests the  fix for PR31424.
+!
+module InternalCompilerError
+
+   type Byte
+      private 
+      character(len=1)     :: singleByte
+   end type
+
+   type (Byte)             :: BytesPrototype(1)
+
+   type UserType
+      real :: r
+   end type
+
+contains
+
+   function UserTypeToBytes(user) result (bytes) 
+      type(UserType) :: user 
+      type(Byte)     :: bytes(size(transfer(user, BytesPrototype)))
+      bytes = transfer(user, BytesPrototype) 
+   end function
+
+   subroutine DoSomethingWithBytes(bytes)
+      type(Byte), intent(in)     :: bytes(:)
+   end subroutine
+
+end module
+
+
+program main
+   use InternalCompilerError
+   type (UserType) :: user 
+
+   ! The following line caused the ICE 
+   call DoSomethingWithBytes( UserTypeToBytes(user) )
+
+end program 
+! { dg-final { cleanup-modules "InternalCompilerError" } }
diff --git a/gcc/testsuite/gfortran.dg/unused_artificial_dummies_1.f90 b/gcc/testsuite/gfortran.dg/unused_artificial_dummies_1.f90
new file mode 100644
index 000000000..bfeceaf57
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unused_artificial_dummies_1.f90
@@ -0,0 +1,50 @@
+! { dg-do compile }
+! { dg-options "-Wunused-variable -Wunused-parameter" }
+! This tests the fix for PR18111 in which some artificial declarations
+! were being listed as unused parameters:
+! (i) Array dummies, where a copy is made;
+! (ii) The dummies of "entry thunks" (ie. the articial procedures that
+! represent ENTRYs and call the "entry_master" function; and
+! (iii) The __entry parameter of the entry_master function, which
+! indentifies the calling entry thunk.
+! All of these have DECL_ARTIFICIAL (tree) set.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module foo
+  implicit none
+contains
+
+!This is the original problem
+
+  subroutine bar(arg1, arg2, arg3, arg4, arg5)
+    character(len=80), intent(in) :: arg1
+    character(len=80), dimension(:), intent(in) :: arg2
+    integer, dimension(arg4), intent(in) :: arg3
+    integer, intent(in) :: arg4
+    character(len=arg4), intent(in) :: arg5
+    print *, arg1, arg2, arg3, arg4, arg5
+  end subroutine bar
+
+! This ICED with the first version of the fix because gfc_build_dummy_array_decl
+! sometimes NULLS sym->backend_decl; taken from aliasing_dummy_1.f90
+
+  subroutine foo1 (slist, i)
+    character(*), dimension(*) :: slist
+    integer i
+    write (slist(i), '(2hi=,i3)') i
+  end subroutine foo1
+
+! This tests the additions to the fix that prevent the dummies of entry thunks
+! and entry_master __entry parameters from being listed as unused.
+
+  function f1 (a)
+    integer, dimension (2, 2) :: a, b, f1, e1
+    f1 (:, :) = 15 + a
+    return
+  entry e1 (b)
+    e1 (:, :) = 42 + b
+  end function
+
+end module foo
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/use_1.f90 b/gcc/testsuite/gfortran.dg/use_1.f90
new file mode 100644
index 000000000..94d5db283
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_1.f90
@@ -0,0 +1,9 @@
+      ! { dg-do compile }
+      ! { dg-options "-ffixed-form" }
+      module foo
+      end module foo
+
+      subroutine bar1
+      usefoo
+      end
+      ! { dg-final { cleanup-modules "iso_fortran_env" } }
diff --git a/gcc/testsuite/gfortran.dg/use_10.f90 b/gcc/testsuite/gfortran.dg/use_10.f90
new file mode 100644
index 000000000..e52fcff7e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_10.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+module a
+ implicit none
+interface operator(.op.)
+  module procedure sub
+end interface
+interface operator(.ops.)
+  module procedure sub2
+end interface
+
+contains
+  function sub(i)
+    integer :: sub
+    integer,intent(in) :: i
+    sub = -i
+  end function sub
+  function sub2(i)
+    integer :: sub2
+    integer,intent(in) :: i
+    sub2 = i
+  end function sub2
+end module a
+
+program test
+use a, only: operator(.op.), operator(.op.), &
+operator(.my.)=>operator(.op.),operator(.ops.)=>operator(.op.)
+implicit none
+if (.my.2 /= -2 .or. .op.3 /= -3 .or. .ops.7 /= -7) call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/use_11.f90 b/gcc/testsuite/gfortran.dg/use_11.f90
new file mode 100644
index 000000000..02efe8e51
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_11.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! Test the fix for a regression caused by the fix for PR33541,
+! in which the second local version of a would not be associated.
+!
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+!            and Tobias Burnus <burnus@gcc.gnu.org>
+!
+module m
+  integer :: a
+end module m
+
+use m, local1 => a
+use m, local2 => a
+local1 = 5
+local2 = 3
+if (local1 .ne. local2) call abort ()
+end
+! { dg-final { cleanup-modules "test" } }
diff --git a/gcc/testsuite/gfortran.dg/use_12.f90 b/gcc/testsuite/gfortran.dg/use_12.f90
new file mode 100644
index 000000000..7406dc433
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_12.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-Wreturn-type" }
+! Tests the fix of PR34545, in which the 'numclusters' that determines the size
+! of fnres was not properly associated.
+!
+! Reported by Jon D. Richards <jon_d_r@msn.com>
+!
+module m1
+  integer :: numclusters = 2
+end module m1
+
+module m2
+  contains
+    function get_nfirst( ) result(fnres)  ! { dg-warning "not set" }
+      use m1, only: numclusters
+      real :: fnres(numclusters)   ! change to REAL and it works!!  
+    end function get_nfirst
+end module m2
+
+program kmeans_driver
+   use m1
+   use m2
+   integer :: nfirst(3)
+   nfirst(1:numclusters) = get_nfirst( )
+end program kmeans_driver
+! { dg-final { cleanup-modules "m1 m2" } }
diff --git a/gcc/testsuite/gfortran.dg/use_13.f90 b/gcc/testsuite/gfortran.dg/use_13.f90
new file mode 100644
index 000000000..1fe7b1eac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_13.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+!
+! PR fortran/44360
+!
+! Test-case based on a contribution of Vittorio Zecca.
+!
+! The used subroutine was not the use-associated but the host associated one!
+! The use-associated function/variable were already working properly.
+!
+module m
+  integer :: var = 43
+contains
+ integer function fun()
+   fun = 42
+ end function fun
+ subroutine fun2()
+   var = 44
+ end subroutine fun2
+end module m
+
+module m2
+  integer :: var = -2
+contains
+ subroutine test()
+   ! All procedures/variables below refer to the ones in module "m"
+   ! and not to the siblings in this module "m2".
+   use m 
+   if (fun() /= 42) call abort()
+   if (var /= 43) call abort()
+   call fun2()
+   if (var /= 44) call abort()
+ end subroutine test
+ integer function fun()
+   call abort()
+   fun = -3
+ end function fun
+ subroutine fun2()
+   call abort()
+ end subroutine fun2
+end module m2
+
+use m2
+call test()
+end
+! { dg-final { cleanup-modules "m m2" } }
diff --git a/gcc/testsuite/gfortran.dg/use_2.f90 b/gcc/testsuite/gfortran.dg/use_2.f90
new file mode 100644
index 000000000..48dcb8d7c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_2.f90
@@ -0,0 +1,4 @@
+! { dg-do compile }
+subroutine bar1
+  usefoo ! { dg-error "Unclassifiable statement" }
+end
diff --git a/gcc/testsuite/gfortran.dg/use_22.f90 b/gcc/testsuite/gfortran.dg/use_22.f90
new file mode 100644
index 000000000..d61df6713
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_22.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+!
+! PR fortran/55827
+! gfortran used to ICE with the call to `tostring' depending on how the
+! `tostring' symbol was USE-associated.
+!
+! Contributed by Lorenz Hüdepohl <bugs@stellardeath.org>
+
+module stringutils
+  interface
+    pure function strlen(handle) result(len)
+      integer, intent(in) :: handle
+      integer :: len
+    end function
+  end interface
+end module
+module intermediate ! does not die if this module is merged with stringutils
+  contains
+  function tostring(handle) result(string)
+    use stringutils
+    integer, intent(in) :: handle
+    character(len=strlen(handle)) :: string
+  end function
+end module
+module usage
+  contains
+  subroutine dies_here(handle)
+    use stringutils ! does not die if this unnecessary line is omitted or placed after "use intermediate"
+    use intermediate
+    integer :: handle
+    write(*,*) tostring(handle) ! ICE
+  end subroutine
+end module
+
+
diff --git a/gcc/testsuite/gfortran.dg/use_23.f90 b/gcc/testsuite/gfortran.dg/use_23.f90
new file mode 100644
index 000000000..da05e1a8e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_23.f90
@@ -0,0 +1,42 @@
+! { dg-do compile }
+!
+! PR fortran/42769
+! This test used to ICE in resolve_typebound_procedure because T1's GET
+! procedure was wrongly associated to MOD2's MY_GET (instead of the original
+! MOD1's MY_GET) in MOD3's SUB.
+!
+! Original testcase by Salvator Filippone <sfilippone@uniroma2.it>
+! Reduced by Janus Weil <janus@gcc.gnu.org>
+
+module mod1
+  type :: t1
+  contains
+    procedure, nopass :: get => my_get
+  end type
+contains 
+  logical function my_get()
+  end function
+end module
+
+module mod2
+contains 
+  logical function my_get()
+  end function
+end module
+
+module mod3
+contains
+  subroutine sub(a)
+    use mod2, only: my_get
+    use mod1, only: t1
+    type(t1) :: a
+  end subroutine
+end module
+
+
+use mod2, only: my_get
+use mod3, only: sub
+end 
+
+
+
diff --git a/gcc/testsuite/gfortran.dg/use_24.f90 b/gcc/testsuite/gfortran.dg/use_24.f90
new file mode 100644
index 000000000..b709347b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_24.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+!
+! PR fortran/42769
+! The static resolution of A%GET used to be incorrectly simplified to MOD2's
+! MY_GET instead of the original MOD1's MY_GET, depending on the order in which
+! MOD1 and MOD2 were use-associated.
+!
+! Original testcase by Salvator Filippone <sfilippone@uniroma2.it>
+! Reduced by Janus Weil <janus@gcc.gnu.org>
+
+module mod1
+  type :: t1
+  contains
+    procedure, nopass :: get => my_get
+  end type
+contains 
+  subroutine my_get(i)
+    i = 2
+  end subroutine
+end module
+
+module mod2
+contains 
+  subroutine my_get(i)    ! must have the same name as the function in mod1
+    i = 5
+  end subroutine
+end module
+
+
+ call test1()
+ call test2()
+
+contains
+
+ subroutine test1()
+  use mod2
+  use mod1
+  type(t1) :: a
+  call a%get(j)
+  if (j /= 2) call abort
+ end subroutine test1
+
+ subroutine test2()
+  use mod1
+  use mod2
+  type(t1) :: a
+  call a%get(j)
+  if (j /= 2) call abort
+ end subroutine test2
+end
+
+
+
diff --git a/gcc/testsuite/gfortran.dg/use_25.f90 b/gcc/testsuite/gfortran.dg/use_25.f90
new file mode 100644
index 000000000..b79297f9f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_25.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+!
+! PR fortran/42769
+! This test used to be rejected because the typebound call A%GET was
+! simplified to MY_GET which is an ambiguous name in the main program
+! namespace.
+!
+! Original testcase by Salvator Filippone <sfilippone@uniroma2.it>
+! Reduced by Janus Weil <janus@gcc.gnu.org>
+
+module mod1
+  type :: t1
+  contains
+    procedure, nopass :: get => my_get
+  end type
+contains 
+  subroutine my_get()
+    print *,"my_get (mod1)"
+  end subroutine
+end module
+
+module mod2
+contains 
+  subroutine my_get()    ! must have the same name as the function in mod1
+    print *,"my_get (mod2)"
+  end subroutine
+end module
+
+  use mod2
+  use mod1
+  type(t1) :: a
+  call call_get
+  contains
+  subroutine call_get
+    call a%get()
+  end subroutine call_get
+end
+
+
diff --git a/gcc/testsuite/gfortran.dg/use_26.f90 b/gcc/testsuite/gfortran.dg/use_26.f90
new file mode 100644
index 000000000..2e66401a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_26.f90
@@ -0,0 +1,76 @@
+! { dg-do compile }
+!
+! PR fortran/45836
+! The B_TYPE_INSTANCE%SIZERETURN() typebound function used to be rejected on a
+! type mismatch because the function was resolved to A's SIZERETURN instead of
+! B's because of the ambiguity of the SIZERETURN name in the MAIN namespace.
+!
+! Original testcase by someone <ortp21@gmail.com>
+
+module A
+implicit none
+    type :: a_type
+    private
+        integer :: size = 1
+    contains
+        procedure :: sizeReturn
+    end type a_type
+    contains
+        function sizeReturn( a_type_ )
+            implicit none
+            integer :: sizeReturn
+            class(a_type) :: a_type_
+
+            sizeReturn = a_type_%size
+        end function sizeReturn
+end module A
+
+module B
+implicit none
+    type :: b_type
+    private
+        integer :: size = 2
+    contains
+        procedure :: sizeReturn
+    end type b_type
+    contains
+        function sizeReturn( b_type_ )
+            implicit none
+            integer :: sizeReturn
+            class(b_type) :: b_type_
+
+            sizeReturn = b_type_%size
+        end function sizeReturn
+end module B
+
+program main
+
+  call test1
+  call test2
+
+contains
+
+  subroutine test1
+    use A
+    use B
+    implicit none
+    type(a_type) :: a_type_instance
+    type(b_type) :: b_type_instance
+
+    print *, a_type_instance%sizeReturn()
+    print *, b_type_instance%sizeReturn()
+  end subroutine test1
+
+  subroutine test2
+    use B
+    use A
+    implicit none
+    type(a_type) :: a_type_instance
+    type(b_type) :: b_type_instance
+
+    print *, a_type_instance%sizeReturn()
+    print *, b_type_instance%sizeReturn()
+  end subroutine test2
+end program main
+
+
diff --git a/gcc/testsuite/gfortran.dg/use_27.f90 b/gcc/testsuite/gfortran.dg/use_27.f90
new file mode 100644
index 000000000..71d77cc01
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_27.f90
@@ -0,0 +1,103 @@
+! { dg-do run }
+!
+! PR fortran/45900
+! The BTYPEINSTANCE%CALLBACK() typebound call was resolved incorrectly to
+! A's CALLBACK procedure instead of B's because the CALLBACK name is ambiguous
+! in the MAIN namespace.
+!
+! Original testcase by someone <ortp21@gmail.com>
+
+module A
+implicit none
+    type :: aType
+    contains
+        procedure :: callback
+    end type aType
+    contains
+        subroutine callback( callback_, i )
+            implicit none
+            class(aType) :: callback_
+            integer :: i
+
+            i = 3
+        end subroutine callback
+
+        subroutine solver( callback_, i )
+            implicit none
+            class(aType) :: callback_
+            integer :: i
+
+            call callback_%callback(i)
+        end subroutine solver
+end module A
+
+module B
+use A, only: aType
+implicit none
+    type, extends(aType) :: bType
+        integer :: i
+    contains
+        procedure :: callback
+    end type bType
+    contains
+        subroutine callback( callback_, i )
+            implicit none
+            class(bType) :: callback_
+            integer :: i
+
+            i = 7
+        end subroutine callback
+end module B
+
+program main
+  call test1()
+  call test2()
+
+contains
+
+  subroutine test1
+    use A
+    use B
+    implicit none
+    type(aType) :: aTypeInstance
+    type(bType) :: bTypeInstance
+    integer :: iflag
+
+    bTypeInstance%i = 4
+
+    iflag = 0
+    call bTypeInstance%callback(iflag)
+    if (iflag /= 7) call abort
+    iflag = 1
+    call solver( bTypeInstance, iflag )
+    if (iflag /= 7) call abort
+
+    iflag = 2
+    call aTypeInstance%callback(iflag)
+    if (iflag /= 3) call abort
+  end subroutine test1
+
+  subroutine test2
+    use B
+    use A
+    implicit none
+    type(aType) :: aTypeInstance
+    type(bType) :: bTypeInstance
+    integer :: iflag
+
+    bTypeInstance%i = 4
+
+    iflag = 0
+    call bTypeInstance%callback(iflag)
+    if (iflag /= 7) call abort
+    iflag = 1
+    call solver( bTypeInstance, iflag )
+    if (iflag /= 7) call abort
+
+    iflag = 2
+    call aTypeInstance%callback(iflag)
+    if (iflag /= 3) call abort
+  end subroutine test2
+end program main
+
+
diff --git a/gcc/testsuite/gfortran.dg/use_3.f90 b/gcc/testsuite/gfortran.dg/use_3.f90
new file mode 100644
index 000000000..54100d191
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_3.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+module foo
+end module foo
+
+  use foo
+  use :: foo
+  use, intrinsic iso_fortran_env ! { dg-error "\"::\" was expected after module nature" }
+  use, non_intrinsic iso_fortran_env ! { dg-error "\"::\" was expected after module nature" }
+  use, nonintrinsic :: iso_fortran_env ! { dg-error "shall be either INTRINSIC or NON_INTRINSIC" }
+  use, intrinsic :: iso_fortran_env
+end
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/use_4.f90 b/gcc/testsuite/gfortran.dg/use_4.f90
new file mode 100644
index 000000000..b7249b0f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_4.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! PR fortran/30973
+! Using symbols with the name of the module
+
+module foo
+  integer :: i
+end module foo
+
+module bar
+  integer :: j
+end module bar
+
+module test
+  use foo, only:
+  integer :: foo ! { dg-error "cannot have a type" }
+end module test
+
+module test2
+  use bar, only: foo => j
+  use foo ! ok, unless foo is accessed
+end module test2
+
+module test3
+  use bar, only: foo => j
+  use foo ! ok, unless foo is accessed
+  foo = 5 ! { dg-error "is an ambiguous reference to 'j'" }
+end module test3
+
+program test_foo
+  use foo, only: foo  ! { dg-error "been used as an external module name" }
+  use foo, only: i => foo! { dg-error "been used as an external module name" }
+  use foo, only: foo => i! { dg-error "been used as an external module name" }
+end program
+! { dg-final { cleanup-modules "foo bar test test2 test3" } }
diff --git a/gcc/testsuite/gfortran.dg/use_5.f90 b/gcc/testsuite/gfortran.dg/use_5.f90
new file mode 100644
index 000000000..0554f394a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_5.f90
@@ -0,0 +1,49 @@
+! { dg-do run }
+! Renaming of operators
+module z
+  interface operator(.addfive.)
+    module procedure sub2
+  end interface
+contains
+function sub2(x)
+  integer :: sub
+  integer,intent(in) :: x
+  sub2 = x + 5
+end function sub2
+end module z
+
+module y
+  interface operator(.addfive.)
+    module procedure sub
+  end interface
+contains
+function sub(x)
+  integer :: sub
+  integer,intent(in) :: x
+  sub = x + 15
+end function sub
+end module y
+
+module x
+  interface operator(.addfive.)
+    module procedure sub
+  end interface
+contains
+function sub(x)
+  integer :: sub
+  integer,intent(in) :: x
+  sub = x + 25
+end function sub
+end module x
+
+use x, only : operator(.bar.) => operator(.addfive.)
+use y, operator(.my.) => operator(.addfive.)
+use z
+ integer :: i
+ i = 2
+ if ((.bar. i) /= 2+25) call abort ()
+ if ((.my. i) /= 2+15) call abort ()
+ if ((.addfive. i) /= 2+5) call abort ()
+end
+
+! { dg-final { cleanup-modules "x y z" } }
diff --git a/gcc/testsuite/gfortran.dg/use_6.f90 b/gcc/testsuite/gfortran.dg/use_6.f90
new file mode 100644
index 000000000..2be10b76b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_6.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! Renaming of operators
+module z
+  interface operator(.addfive.)
+    module procedure sub2
+  end interface
+contains
+function sub2(x)
+  integer :: sub
+  integer,intent(in) :: x
+  sub2 = x + 5
+end function sub2
+end module z
+
+module y
+  interface operator(.addfive.)
+    module procedure sub
+  end interface
+contains
+function sub(x)
+  integer :: sub
+  integer,intent(in) :: x
+  sub = x + 15
+end function sub
+end module y
+
+module x
+  interface operator(.addfive.)
+    module procedure sub
+  end interface
+contains
+function sub(x)
+  integer :: sub
+  integer,intent(in) :: x
+  sub = x + 25
+end function sub
+end module x
+
+use x, only : operator(.bar.) => operator(.addfive.) ! { dg-error "Fortran 2003: Renaming operators in USE statements" }
+use y, operator(.my.) => operator(.addfive.) ! { dg-error "Fortran 2003: Renaming operators in USE statements" }
+use z
+end
+
+! { dg-final { cleanup-modules "x y z" } }
diff --git a/gcc/testsuite/gfortran.dg/use_7.f90 b/gcc/testsuite/gfortran.dg/use_7.f90
new file mode 100644
index 000000000..7ebd1e2bf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_7.f90
@@ -0,0 +1,49 @@
+! { dg-do compile }
+! Renaming of operators
+module z
+  type myT
+    integer :: t
+  end type myT
+  interface operator(+)
+    module procedure sub2
+  end interface
+contains
+function sub2(x)
+  type(myT) :: sub2
+  type(myT),intent(in) :: x
+  sub2%t = x%t + 5
+end function sub2
+end module z
+
+module y
+  interface operator(.addfive.)
+    module procedure sub
+  end interface
+contains
+function sub(x)
+  integer :: sub
+  integer,intent(in) :: x
+  sub = x + 15
+end function sub
+end module y
+
+module x
+  interface operator(.addfive.)
+    module procedure sub
+  end interface
+contains
+function sub(x)
+  integer :: sub
+  integer,intent(in) :: x
+  sub = x + 25
+end function sub
+end module x
+
+use z, operator(-) => operator(+) ! { dg-error "Syntax error in USE statement" }
+use z, operator(.op.) => operator(+) ! { dg-error "Syntax error in USE statement" }
+use x, only : bar => operator(.addfive.) ! { dg-error "Syntax error in USE statement" }
+use y, operator(.my.) => sub ! { dg-error "Syntax error in USE statement" }
+use y, operator(+) => operator(.addfive.) ! { dg-error "Syntax error in USE statement" }
+end
+
+! { dg-final { cleanup-modules "x y z" } }
diff --git a/gcc/testsuite/gfortran.dg/use_8.f90 b/gcc/testsuite/gfortran.dg/use_8.f90
new file mode 100644
index 000000000..adb265e5b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_8.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+module a
+
+  type, private, bind(C) b ! { dg-error "Expected :: in TYPE definition" }
+    integer i
+  end type b ! { dg-error "Expecting END MODULE statement" }
+
+  type, public c ! { dg-error "Expected :: in TYPE definition" }
+    integer j
+  end type c ! { dg-error "Expecting END MODULE statement" }
+
+  type, private d ! { dg-error "Expected :: in TYPE definition" }
+    integer k
+  end type b ! { dg-error "Expecting END MODULE statement" }
+
+  type, bind(C), public e ! { dg-error "Expected :: in TYPE definition" }
+    integer l
+  end type e ! { dg-error "Expecting END MODULE statement" }
+
+  type, bind(C) f ! { dg-error "Expected :: in TYPE definition" }
+    integer m
+  end type f ! { dg-error "Expecting END MODULE statement" }
+
+end module a
diff --git a/gcc/testsuite/gfortran.dg/use_9.f90 b/gcc/testsuite/gfortran.dg/use_9.f90
new file mode 100644
index 000000000..419ef47f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_9.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+module test
+  interface operator(.bar.)
+     module procedure func
+  end interface
+contains
+function func(a)
+  integer,intent(in) :: a
+  integer :: funct
+  func = a+1
+end function
+end module test
+
+use test, only: operator(.func.) ! { dg-error "not found in module 'test'" }
+end
+! { dg-final { cleanup-modules "test" } }
diff --git a/gcc/testsuite/gfortran.dg/use_allocated_1.f90 b/gcc/testsuite/gfortran.dg/use_allocated_1.f90
new file mode 100644
index 000000000..e590f6a95
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_allocated_1.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! PR17678
+! We were incorrectly setting use-associated variables to unallocated
+! on procedure entry.
+module foo
+  integer, dimension(:), allocatable :: bar
+end module
+
+program main
+  use foo
+  allocate (bar(10))
+  call init
+end program main
+
+subroutine init
+  use foo
+  if (.not.allocated(bar)) call abort
+end subroutine init
+
+! { dg-final { cleanup-modules "foo" } }
diff --git a/gcc/testsuite/gfortran.dg/use_iso_c_binding.f90 b/gcc/testsuite/gfortran.dg/use_iso_c_binding.f90
new file mode 100644
index 000000000..8a28490f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_iso_c_binding.f90
@@ -0,0 +1,50 @@
+! { dg-do compile }
+! this is to simply test that the various ways the use statement can 
+! appear are handled by the compiler, since i did a special treatment 
+! of the intrinsic iso_c_binding module.  note: if the user doesn't 
+! provide the 'intrinsic' keyword, the compiler will check for a user 
+! provided module by the name of iso_c_binding before using the 
+! intrinsic one.  --Rickett, 09.26.06
+module use_stmt_0
+  ! this is an error because c_ptr_2 does not exist 
+  use, intrinsic :: iso_c_binding, only: c_ptr_2 ! { dg-error "Symbol 'c_ptr_2' referenced at \\(1\\) not found" }
+end module use_stmt_0
+
+module use_stmt_1
+  ! this is an error because c_ptr_2 does not exist 
+  use iso_c_binding, only: c_ptr_2 ! { dg-error "Symbol 'c_ptr_2' referenced at \\(1\\) not found" }
+end module use_stmt_1
+
+module use_stmt_2
+  ! works fine
+  use, intrinsic :: iso_c_binding, only: c_ptr
+end module use_stmt_2
+
+module use_stmt_3
+  ! works fine
+  use iso_c_binding, only: c_ptr
+end module use_stmt_3
+
+module use_stmt_4
+  ! works fine
+  use, intrinsic :: iso_c_binding
+end module use_stmt_4
+
+module use_stmt_5
+  ! works fine
+  use iso_c_binding
+end module use_stmt_5
+
+module use_stmt_6
+  ! hmm, is this an error?  if so, it's not being caught...
+  ! --Rickett, 09.13.06
+  use, intrinsic :: iso_c_binding, only: c_int, c_int
+end module use_stmt_6
+
+module use_stmt_7
+  ! hmm, is this an error?  if so, it's not being caught...
+  ! --Rickett, 09.13.06
+  use iso_c_binding, only: c_int, c_int
+end module use_stmt_7
+
+! { dg-final { cleanup-modules "use_stmt_2 use_stmt_3 use_stmt_4 use_stmt_5 use_stmt_6 use_stmt_7" } }
diff --git a/gcc/testsuite/gfortran.dg/use_only_1.f90 b/gcc/testsuite/gfortran.dg/use_only_1.f90
new file mode 100644
index 000000000..e01324384
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_only_1.f90
@@ -0,0 +1,92 @@
+! { dg-do run }
+! { dg-options "-O1" }
+! Checks the fix for PR33541, in which a requirement of
+! F95 11.3.2 was not being met: The local names 'x' and
+! 'y' coming from the USE statements without an ONLY clause
+! should not survive in the presence of the locally renamed
+! versions. In fixing the PR, the same correction has been
+! made to generic interfaces.
+!
+! Reported by Reported by John Harper in
+! http://gcc.gnu.org/ml/fortran/2007-09/msg00397.html
+!
+MODULE xmod
+  integer(4) :: x = -666
+  private foo, bar
+  interface xfoobar
+    module procedure foo, bar
+  end interface
+contains
+  integer function foo ()
+    foo = 42
+  end function
+  integer function bar (a)
+    integer a
+    bar = a
+  end function
+END MODULE xmod
+
+MODULE ymod
+  integer(4) :: y = -666
+  private foo, bar
+  interface yfoobar
+    module procedure foo, bar
+  end interface
+contains
+  integer function foo ()
+    foo = 42
+  end function
+  integer function bar (a)
+    integer a
+    bar = a
+  end function
+END MODULE ymod
+
+  integer function xfoobar () ! These function as defaults should...
+    xfoobar = 99
+  end function
+
+  integer function yfoobar () ! ...the rename works correctly.
+    yfoobar = 99
+  end function
+
+PROGRAM test2uses
+  implicit integer(2) (a-z)
+  x = 666  ! These assignments generate implicitly typed
+  y = 666  ! local variables 'x' and 'y'.
+  call test1
+  call test2
+  call test3
+contains
+  subroutine test1  ! Test the fix of the original PR
+    USE xmod
+    USE xmod, ONLY: xrenamed => x
+    USE ymod, ONLY: yrenamed => y
+    USE ymod
+    implicit integer(2) (a-z)
+    if (kind(xrenamed) == kind(x)) call abort ()
+    if (kind(yrenamed) == kind(y)) call abort ()
+  end subroutine
+
+  subroutine test2  ! Test the fix applies to generic interfaces
+    USE xmod
+    USE xmod, ONLY: xfoobar_renamed => xfoobar
+    USE ymod, ONLY: yfoobar_renamed => yfoobar
+    USE ymod
+    implicit integer(4) (a-z)
+    if (xfoobar_renamed (42) == xfoobar ()) call abort ()
+    if (yfoobar_renamed (42) == yfoobar ()) call abort ()
+  end subroutine
+
+  subroutine test3  ! Check that USE_NAME == LOCAL_NAME is OK
+    USE xmod
+    USE xmod, ONLY: x => x, xfoobar => xfoobar
+    USE ymod, ONLY: y => y, yfoobar => yfoobar
+    USE ymod
+    if (kind (x) /= 4) call abort ()    
+    if (kind (y) /= 4) call abort ()    
+    if (xfoobar (77) /= 77_4) call abort ()
+    if (yfoobar (77) /= 77_4) call abort ()
+  end subroutine
+END PROGRAM test2uses
+! { dg-final { cleanup-modules "xmod ymod" } }
diff --git a/gcc/testsuite/gfortran.dg/use_only_2.f90 b/gcc/testsuite/gfortran.dg/use_only_2.f90
new file mode 100644
index 000000000..313953ec8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_only_2.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! Checks the fix for PR34672, in which generic interfaces were not
+! being written correctly, when renamed.
+!
+! Contributed by Jos de Kloe <kloedej@knmi.nl> 
+!
+MODULE MyMod1

+  integer, parameter :: i2_ = Selected_Int_Kind(4)

+END Module MyMod1

+

+module MyMod2

+  INTERFACE write_int

+     module procedure write_int_local

+  END INTERFACE

+contains

+  subroutine write_int_local(value)

+    integer, intent(in)  :: value

+    print *,value

+  end subroutine write_int_local

+end module MyMod2

+

+module MyMod3

+  USE MyMod2, only: write_MyInt   => write_int

+  USE MyMod1, only: i2_

+end module MyMod3

+

+module MyMod4

+  USE MyMod3, only: write_MyInt

+end module MYMOD4

+! { dg-final { cleanup-modules "MyMod1 MyMod2 MyMod3 MyMod4" } }
diff --git a/gcc/testsuite/gfortran.dg/use_only_3.f90 b/gcc/testsuite/gfortran.dg/use_only_3.f90
new file mode 100644
index 000000000..509752a7b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_only_3.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! This tests the patch for PR34975, in which 'n', 'ipol', and 'i' would be
+! determined to have 'no IMPLICIT type'.  It turned out to be fiendishly
+! difficult to write a testcase for this PR because even the smallest changes
+! would make the bug disappear.  This is the testcase provided in the PR, except
+! that all the modules are put in 'use_only_3.inc' in the same order as the
+! makefile.  Even this has an effect; only 'n' is now determined to be
+! improperly typed.  All this is due to the richness of the symtree and the
+! way in which the renaming inserted new symtree entries.  Unless somenody can
+! come up with a reduced version, this relatively large file will have to be added
+! to the testsuite.  Fortunately, it only has to be comiled once:)
+!  
+! Reported by Tobias Burnus <burnus@gcc.gnu.org>
+!
+include 'use_only_3.inc'
+subroutine dforceb(c0, i, betae, ipol, bec0, ctabin, gqq, gqqm, qmat, dq2, df)
+  use gvecs
+  use gvecw, only: ngw
+  use parameters
+  use electrons_base, only: nx => nbspx, n => nbsp, nspin, f
+  use constants
+  use cvan
+  use ions_base
+  use ions_base, only : nas => nax
+  implicit none
+
+  integer ipol, i, ctabin
+  complex c0(n), betae, df,&
+       &   gqq,gqqm,&
+       &   qmat
+  real bec0,&
+       &   dq2,  gmes
+
+ end subroutine dforceb
+! { dg-final { cleanup-modules "cell_base cvan gvecs kinds" } }
+! { dg-final { cleanup-modules "constants electrons_base gvecw parameters" } }
+! { dg-final { cleanup-modules "control_flags electrons_nose ions_base" } }
+
diff --git a/gcc/testsuite/gfortran.dg/use_only_3.inc b/gcc/testsuite/gfortran.dg/use_only_3.inc
new file mode 100644
index 000000000..7b860096b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_only_3.inc
@@ -0,0 +1,998 @@
+    MODULE kinds
+      INTEGER, PARAMETER :: DP = selected_real_kind(14,200)
+      PRIVATE
+      PUBLIC :: DP
+    END MODULE kinds
+
+MODULE constants
+  USE kinds, ONLY : DP
+  IMPLICIT NONE
+  SAVE
+  REAL(DP), PARAMETER :: pi = 3.14159265358979323846_DP
+  REAL(DP), PARAMETER :: tpi= 2.0_DP * pi
+  REAL(DP), PARAMETER :: fpi= 4.0_DP * pi
+  REAL(DP), PARAMETER :: sqrtpi = 1.77245385090551602729_DP 
+  REAL(DP), PARAMETER :: sqrtpm1= 1.0_DP / sqrtpi
+  REAL(DP), PARAMETER :: sqrt2  = 1.41421356237309504880_DP
+  REAL(DP), PARAMETER :: H_PLANCK_SI      = 6.6260693D-34    ! J s
+  REAL(DP), PARAMETER :: K_BOLTZMANN_SI   = 1.3806505D-23    ! J K^-1 
+  REAL(DP), PARAMETER :: ELECTRON_SI      = 1.60217653D-19   ! C
+  REAL(DP), PARAMETER :: ELECTRONVOLT_SI  = 1.60217653D-19   ! J  
+  REAL(DP), PARAMETER :: ELECTRONMASS_SI  = 9.1093826D-31    ! Kg
+  REAL(DP), PARAMETER :: HARTREE_SI       = 4.35974417D-18   ! J
+  REAL(DP), PARAMETER :: RYDBERG_SI       = HARTREE_SI/2.0_DP! J
+  REAL(DP), PARAMETER :: BOHR_RADIUS_SI   = 0.5291772108D-10 ! m
+  REAL(DP), PARAMETER :: AMU_SI           = 1.66053886D-27   ! Kg
+  REAL(DP), PARAMETER :: K_BOLTZMANN_AU   = K_BOLTZMANN_SI / HARTREE_SI
+  REAL(DP), PARAMETER :: K_BOLTZMANN_RY   = K_BOLTZMANN_SI / RYDBERG_SI
+  REAL(DP), PARAMETER :: AUTOEV           = HARTREE_SI / ELECTRONVOLT_SI
+  REAL(DP), PARAMETER :: RYTOEV           = AUTOEV / 2.0_DP
+  REAL(DP), PARAMETER :: AMU_AU           = AMU_SI / ELECTRONMASS_SI
+  REAL(DP), PARAMETER :: AMU_RY           = AMU_AU / 2.0_DP
+  REAL(DP), PARAMETER :: AU_SEC           = H_PLANCK_SI/tpi/HARTREE_SI
+  REAL(DP), PARAMETER :: AU_PS            = AU_SEC * 1.0D+12
+  REAL(DP), PARAMETER :: AU_GPA           = HARTREE_SI / BOHR_RADIUS_SI ** 3 &
+                                            / 1.0D+9 
+  REAL(DP), PARAMETER :: RY_KBAR          = 10.0_dp * AU_GPA / 2.0_dp
+  !
+  REAL(DP), PARAMETER :: DEBYE_SI         = 3.3356409519 * 1.0D-30 ! C*m 
+  REAL(DP), PARAMETER :: AU_DEBYE         = ELECTRON_SI * BOHR_RADIUS_SI / &
+                                            DEBYE_SI
+  REAL(DP), PARAMETER :: eV_to_kelvin = ELECTRONVOLT_SI / K_BOLTZMANN_SI
+  REAL(DP), PARAMETER :: ry_to_kelvin = RYDBERG_SI / K_BOLTZMANN_SI
+  REAL(DP), PARAMETER :: eps4  = 1.0D-4
+  REAL(DP), PARAMETER :: eps6  = 1.0D-6
+  REAL(DP), PARAMETER :: eps8  = 1.0D-8
+  REAL(DP), PARAMETER :: eps14 = 1.0D-14
+  REAL(DP), PARAMETER :: eps16 = 1.0D-16
+  REAL(DP), PARAMETER :: eps32 = 1.0D-32
+  REAL(DP), PARAMETER :: gsmall = 1.0d-12
+  REAL(DP), PARAMETER :: e2 = 2.D0      ! the square of the electron charge
+  REAL(DP), PARAMETER :: degspin = 2.D0 ! the number of spins per level
+  REAL(DP), PARAMETER :: amconv = AMU_RY
+  REAL(DP), PARAMETER :: uakbar = RY_KBAR
+  REAL(DP), PARAMETER :: bohr_radius_cm = bohr_radius_si * 100.0
+  REAL(DP), PARAMETER :: BOHR_RADIUS_ANGS = bohr_radius_cm * 1.0D8
+  REAL(DP), PARAMETER :: ANGSTROM_AU = 1.0/BOHR_RADIUS_ANGS
+  REAL(DP), PARAMETER :: DIP_DEBYE = AU_DEBYE
+  REAL(DP), PARAMETER :: AU_TERAHERTZ  = AU_PS
+  REAL(DP), PARAMETER :: AU_TO_OHMCMM1 = 46000.0D0 ! (ohm cm)^-1
+  !
+
+END MODULE constants
+
+!
+! Copyright (C) 2001-2005 Quantum-ESPRESSO group
+! This file is distributed under the terms of the
+! GNU General Public License. See the file `License'
+! in the root directory of the present distribution,
+! or http://www.gnu.org/copyleft/gpl.txt .
+!
+!
+!---------------------------------------------------------------------------
+MODULE parameters
+  !---------------------------------------------------------------------------
+  !
+  IMPLICIT NONE
+  SAVE
+  !
+  INTEGER, PARAMETER :: &
+       ntypx  = 10,     &! max number of different types of atom
+       npsx   = ntypx,  &! max number of different PPs (obsolete)
+       npk    = 40000,  &! max number of k-points               
+       lmaxx  = 3,      &! max non local angular momentum (l=0 to lmaxx)      
+       nchix  = 6,      &! max number of atomic wavefunctions per atom
+       ndmx   = 2000     ! max number of points in the atomic radial mesh
+  !
+  INTEGER, PARAMETER :: &
+       nbrx = 14,          &! max number of beta functions
+       lqmax= 2*lmaxx+1,   &! max number of angular momenta of Q
+       nqfx = 8             ! max number of coefficients in Q smoothing
+  !
+  INTEGER, PARAMETER :: nacx    = 10         ! max number of averaged 
+                                             ! quantities saved to the restart
+  INTEGER, PARAMETER :: nsx     = ntypx      ! max number of species
+  INTEGER, PARAMETER :: natx    = 5000       ! max number of atoms
+  INTEGER, PARAMETER :: npkx    = npk        ! max number of K points
+  INTEGER, PARAMETER :: ncnsx   = 101        ! max number of constraints
+  INTEGER, PARAMETER :: nspinx  = 2          ! max number of spinors
+  !
+  INTEGER, PARAMETER :: nhclm   = 4  ! max number NH chain length, nhclm can be
+                                     ! easily increased since the restart file 
+                                     ! should be able to handle it, perhaps
+                                     ! better to align nhclm by 4
+  !
+  INTEGER, PARAMETER :: max_nconstr = 100
+  !
+  INTEGER, PARAMETER  ::  maxcpu = 2**17  ! Maximum number of CPU
+  INTEGER, PARAMETER  ::  maxgrp = 128    ! Maximum number of task-groups
+  !
+END MODULE parameters
+
+MODULE control_flags
+  USE kinds
+  USE parameters
+  IMPLICIT NONE
+  SAVE
+  TYPE convergence_criteria
+     !
+     LOGICAL  :: active
+     INTEGER  :: nstep
+     REAL(DP) :: ekin
+     REAL(DP) :: derho
+     REAL(DP) :: force
+     !
+  END TYPE convergence_criteria
+  !
+  TYPE ionic_conjugate_gradient
+     !
+     LOGICAL  :: active
+     INTEGER  :: nstepix
+     INTEGER  :: nstepex
+     REAL(DP) :: ionthr
+     REAL(DP) :: elethr
+     !
+  END TYPE ionic_conjugate_gradient
+  !
+  CHARACTER(LEN=4) :: program_name = ' '  !  used to control execution flow inside module
+  !
+  LOGICAL :: tvlocw    = .FALSE. ! write potential to unit 46 (only cp, seldom used)
+  LOGICAL :: trhor     = .FALSE. ! read rho from      unit 47 (only cp, seldom used)
+  LOGICAL :: trhow     = .FALSE. ! CP code, write rho to restart dir
+  !
+  LOGICAL :: tsde          = .FALSE. ! electronic steepest descent
+  LOGICAL :: tzeroe        = .FALSE. ! set to zero the electronic velocities
+  LOGICAL :: tfor          = .FALSE. ! move the ions ( calculate forces )
+  LOGICAL :: tsdp          = .FALSE. ! ionic steepest descent
+  LOGICAL :: tzerop        = .FALSE. ! set to zero the ionic velocities
+  LOGICAL :: tprnfor       = .FALSE. ! print forces to standard output
+  LOGICAL :: taurdr        = .FALSE. ! read ionic position from standard input
+  LOGICAL :: tv0rd         = .FALSE. ! read ionic velocities from standard input
+  LOGICAL :: tpre          = .FALSE. ! calculate stress, and (in fpmd) variable cell dynamic
+  LOGICAL :: thdyn         = .FALSE. ! variable-cell dynamics (only cp)
+  LOGICAL :: tsdc          = .FALSE. ! cell geometry steepest descent
+  LOGICAL :: tzeroc        = .FALSE. ! set to zero the cell geometry velocities
+  LOGICAL :: tstress       = .FALSE. ! print stress to standard output
+  LOGICAL :: tortho        = .FALSE. ! use iterative orthogonalization 
+  LOGICAL :: tconjgrad     = .FALSE. ! use conjugate gradient electronic minimization
+  LOGICAL :: timing        = .FALSE. ! print out timing information
+  LOGICAL :: memchk        = .FALSE. ! check for memory leakage
+  LOGICAL :: tprnsfac      = .FALSE. ! print out structure factor 
+  LOGICAL :: toptical      = .FALSE. ! print out optical properties
+  LOGICAL :: tcarpar       = .FALSE. ! tcarpar is set TRUE for a "pure" Car Parrinello simulation
+  LOGICAL :: tdamp         = .FALSE. ! Use damped dinamics for electrons
+  LOGICAL :: tdampions     = .FALSE. ! Use damped dinamics for electrons
+  LOGICAL :: tatomicwfc    = .FALSE. ! Use atomic wavefunctions as starting guess for ch. density
+  LOGICAL :: tscreen       = .FALSE. ! Use screened coulomb potentials for cluster calculations
+  LOGICAL :: twfcollect    = .FALSE. ! Collect wave function in the restart file at the end of run.
+  LOGICAL :: tuspp         = .FALSE. ! Ultra-soft pseudopotential are being used
+  INTEGER :: printwfc      = -1      ! Print wave functions, temporarely used only by ensemble-dft
+  LOGICAL :: force_pairing = .FALSE. ! ...   Force pairing
+  LOGICAL :: tchi2         = .FALSE. ! Compute Chi^2
+  !
+  TYPE (convergence_criteria) :: tconvthrs
+                              !  thresholds used to check GS convergence 
+  !
+  ! ... Ionic vs Electronic step frequency
+  ! ... When "ion_nstep > 1" and "electron_dynamics = 'md' | 'sd' ", ions are 
+  ! ... propagated every "ion_nstep" electronic step only if the electronic 
+  ! ... "ekin" is lower than "ekin_conv_thr"
+  !
+  LOGICAL :: tionstep = .FALSE.
+  INTEGER :: nstepe   = 1  
+                            !  parameters to control how many electronic steps 
+                            !  between ions move
+
+  LOGICAL :: tsteepdesc = .FALSE.
+                            !  parameters for electronic steepest desceent
+
+  TYPE (ionic_conjugate_gradient) :: tconjgrad_ion
+                            !  conjugate gradient for ionic minimization
+
+  INTEGER :: nbeg   = 0 ! internal code for initialization ( -1, 0, 1, 2, .. )
+  INTEGER :: ndw    = 0 !
+  INTEGER :: ndr    = 0 !
+  INTEGER :: nomore = 0 !
+  INTEGER :: iprint = 0 ! print output every iprint step
+  INTEGER :: isave  = 0 ! write restart to ndr unit every isave step
+  INTEGER :: nv0rd  = 0 !
+  INTEGER :: iprsta = 0 ! output verbosity (increasing from 0 to infinity)
+  !
+  ! ... .TRUE. if only gamma point is used
+  !
+  LOGICAL :: gamma_only = .TRUE.
+  !
+  LOGICAL :: tnewnfi = .FALSE.
+  INTEGER :: newnfi  = 0
+  !
+  ! This variable is used whenever a timestep change is requested
+  !
+  REAL(DP) :: dt_old = -1.0D0
+  !
+  ! ... Wave function randomization
+  !
+  LOGICAL  :: trane = .FALSE.
+  REAL(DP) :: ampre = 0.D0
+  !
+  ! ... Ionic position randomization
+  !
+  LOGICAL  :: tranp(nsx) = .FALSE.
+  REAL(DP) :: amprp(nsx) = 0.D0
+  !
+  ! ... Read the cell from standard input
+  !
+  LOGICAL :: tbeg = .FALSE.
+  !
+  ! ... This flags control the calculation of the Dipole Moments
+  !
+  LOGICAL :: tdipole = .FALSE.
+  !
+  ! ... Flags that controls DIIS electronic minimization
+  !
+  LOGICAL :: t_diis        = .FALSE.
+  LOGICAL :: t_diis_simple = .FALSE.
+  LOGICAL :: t_diis_rot    = .FALSE.
+  !
+  ! ... Flag controlling the Nose thermostat for electrons
+  !
+  LOGICAL :: tnosee = .FALSE.
+  !
+  ! ... Flag controlling the Nose thermostat for the cell
+  !
+  LOGICAL :: tnoseh = .FALSE.
+  !
+  ! ... Flag controlling the Nose thermostat for ions
+  !
+  LOGICAL  :: tnosep = .FALSE.
+  LOGICAL  :: tcap   = .FALSE.
+  LOGICAL  :: tcp    = .FALSE.
+  REAL(DP) :: tolp   = 0.D0   !  tolerance for temperature variation
+  !
+  REAL(DP), PUBLIC :: &
+       ekin_conv_thr = 0.D0, &!  conv. threshold for fictitious e. kinetic energy
+       etot_conv_thr = 0.D0, &!  conv. threshold for DFT energy
+       forc_conv_thr = 0.D0   !  conv. threshold for atomic forces
+  INTEGER, PUBLIC :: &
+       ekin_maxiter = 100,   &!  max number of iter. for ekin convergence
+       etot_maxiter = 100,   &!  max number of iter. for etot convergence
+       forc_maxiter = 100     !  max number of iter. for atomic forces conv.
+  !
+  ! ... Several variables controlling the run ( used mainly in PW calculations )
+  !
+  ! ... logical flags controlling the execution
+  !
+  LOGICAL, PUBLIC :: &
+    lfixatom,           &! if .TRUE. some atom is kept fixed
+    lscf,               &! if .TRUE. the calc. is selfconsistent
+    lbfgs,              &! if .TRUE. the calc. is a relaxation based on new BFGS scheme
+    lmd,                &! if .TRUE. the calc. is a dynamics
+    lmetadyn,           &! if .TRUE. the calc. is a meta-dynamics
+    lpath,              &! if .TRUE. the calc. is a path optimizations
+    lneb,               &! if .TRUE. the calc. is NEB dynamics
+    lsmd,               &! if .TRUE. the calc. is string dynamics
+    lwf,                &! if .TRUE. the calc. is with wannier functions
+    lphonon,            &! if .TRUE. the calc. is phonon
+    lbands,             &! if .TRUE. the calc. is band structure
+    lconstrain,         &! if .TRUE. the calc. is constraint
+    ldamped,            &! if .TRUE. the calc. is a damped dynamics
+    lrescale_t,         &! if .TRUE. the ionic temperature is rescaled
+    langevin_rescaling, &! if .TRUE. the ionic dynamics is overdamped Langevin
+    lcoarsegrained,     &! if .TRUE. a coarse-grained phase-space is used
+    restart              ! if .TRUE. restart from results of a preceding run
+  !
+  LOGICAL, PUBLIC :: &
+    remove_rigid_rot     ! if .TRUE. the total torque acting on the atoms is
+                         ! removed
+  !
+  ! ... pw self-consistency
+  !
+  INTEGER, PUBLIC :: &
+    ngm0,             &! used in mix_rho
+    niter,            &! the maximum number of iteration
+    nmix,             &! the number of iteration kept in the history
+    imix               ! the type of mixing (0=plain,1=TF,2=local-TF)
+  REAL(DP), PUBLIC  :: &
+    mixing_beta,      &! the mixing parameter
+    tr2                ! the convergence threshold for potential
+  LOGICAL, PUBLIC :: &
+    conv_elec          ! if .TRUE. electron convergence has been reached
+  !
+  ! ... pw diagonalization
+  !
+  REAL(DP), PUBLIC  :: &
+    ethr               ! the convergence threshold for eigenvalues  
+  INTEGER, PUBLIC :: &
+    david,            &! used on Davidson diagonalization
+    isolve,           &! Davidson or CG or DIIS diagonalization
+    max_cg_iter,      &! maximum number of iterations in a CG di
+    diis_buff,        &! dimension of the buffer in diis
+    diis_ndim          ! dimension of reduced basis in DIIS
+  LOGICAL, PUBLIC :: &
+    diago_full_acc     ! if true all the empty eigenvalues have the same
+                       ! accuracy of the occupied ones
+  !
+  ! ... wfc and rho extrapolation
+  !
+  REAL(DP), PUBLIC  :: &
+    alpha0,           &! the mixing parameters for the extrapolation
+    beta0              ! of the starting potential
+  INTEGER, PUBLIC :: &
+    history,          &! number of old steps available for potential updating
+    pot_order,        &! type of potential updating ( see update_pot )
+    wfc_order          ! type of wavefunctions updating ( see update_pot )
+  !
+  ! ... ionic dynamics
+  !
+  INTEGER, PUBLIC :: &
+    nstep,            &! number of ionic steps
+    istep = 0          ! current ionic step  
+  LOGICAL, PUBLIC :: &
+    conv_ions          ! if .TRUE. ionic convergence has been reached
+  REAL(DP), PUBLIC  :: &
+    upscale            ! maximum reduction of convergence threshold
+  !
+  ! ... system's symmetries
+  !
+  LOGICAL, PUBLIC :: &
+    nosym,            &! if .TRUE. no symmetry is used
+    noinv = .FALSE.    ! if .TRUE. eliminates inversion symmetry
+  !
+  ! ... phonon calculation
+  !
+  INTEGER, PUBLIC :: &
+    modenum            ! for single mode phonon calculation
+  !
+  ! ... printout control
+  !
+  LOGICAL, PUBLIC :: &
+    reduce_io          ! if .TRUE. reduce the I/O to the strict minimum
+  INTEGER, PUBLIC :: &
+    iverbosity         ! type of printing ( 0 few, 1 all )
+  LOGICAL, PUBLIC :: &
+    use_para_diago = .FALSE.  ! if .TRUE. a parallel Householder algorithm 
+  INTEGER, PUBLIC :: &
+    para_diago_dim = 0        ! minimum matrix dimension above which a parallel
+  INTEGER  :: ortho_max = 0    ! maximum number of iterations in routine ortho
+  REAL(DP) :: ortho_eps = 0.D0 ! threshold for convergence in routine ortho
+  LOGICAL, PUBLIC :: &
+    use_task_groups = .FALSE.  ! if TRUE task groups parallelization is used
+  INTEGER, PUBLIC :: iesr = 1
+  LOGICAL,          PUBLIC :: tvhmean = .FALSE.  
+  REAL(DP),         PUBLIC :: vhrmin = 0.0d0
+  REAL(DP),         PUBLIC :: vhrmax = 1.0d0
+  CHARACTER(LEN=1), PUBLIC :: vhasse = 'Z'
+  LOGICAL,          PUBLIC :: tprojwfc = .FALSE.
+  CONTAINS
+    SUBROUTINE fix_dependencies()
+    END SUBROUTINE fix_dependencies
+    SUBROUTINE check_flags()
+    END SUBROUTINE check_flags
+END MODULE control_flags
+
+!
+! Copyright (C) 2002 FPMD group
+! This file is distributed under the terms of the
+! GNU General Public License. See the file `License'
+! in the root directory of the present distribution,
+! or http://www.gnu.org/copyleft/gpl.txt .
+!
+
+!=----------------------------------------------------------------------------=!
+   MODULE gvecw
+!=----------------------------------------------------------------------------=!
+     USE kinds, ONLY: DP
+
+     IMPLICIT NONE
+     SAVE
+
+     ! ...   G vectors less than the wave function cut-off ( ecutwfc )
+     INTEGER :: ngw  = 0  ! local number of G vectors
+     INTEGER :: ngwt = 0  ! in parallel execution global number of G vectors,
+                       ! in serial execution this is equal to ngw
+     INTEGER :: ngwl = 0  ! number of G-vector shells up to ngw
+     INTEGER :: ngwx = 0  ! maximum local number of G vectors
+     INTEGER :: ng0  = 0  ! first G-vector with nonzero modulus
+                       ! needed in the parallel case (G=0 is on one node only!)
+
+     REAL(DP) :: ecutw = 0.0d0
+     REAL(DP) :: gcutw = 0.0d0
+
+     !   values for costant cut-off computations
+
+     REAL(DP) :: ecfix = 0.0d0     ! value of the constant cut-off
+     REAL(DP) :: ecutz = 0.0d0     ! height of the penalty function (above ecfix)
+     REAL(DP) :: ecsig = 0.0d0     ! spread of the penalty function around ecfix
+     LOGICAL   :: tecfix = .FALSE.  ! .TRUE. if constant cut-off is in use
+
+     ! augmented cut-off for k-point calculation
+
+     REAL(DP) :: ekcut = 0.0d0  
+     REAL(DP) :: gkcut = 0.0d0
+    
+     ! array of G vectors module plus penalty function for constant cut-off 
+     ! simulation.
+     !
+     ! ggp = g + ( agg / tpiba**2 ) * ( 1 + erf( ( tpiba2 * g - e0gg ) / sgg ) )
+
+     REAL(DP), ALLOCATABLE, TARGET :: ggp(:)
+
+   CONTAINS
+
+     SUBROUTINE deallocate_gvecw
+       IF( ALLOCATED( ggp ) ) DEALLOCATE( ggp )
+     END SUBROUTINE deallocate_gvecw
+
+!=----------------------------------------------------------------------------=!
+   END MODULE gvecw
+!=----------------------------------------------------------------------------=!
+
+!=----------------------------------------------------------------------------=!
+   MODULE gvecs
+!=----------------------------------------------------------------------------=!
+     USE kinds, ONLY: DP
+
+     IMPLICIT NONE
+     SAVE
+
+     ! ...   G vectors less than the smooth grid cut-off ( ? )
+     INTEGER :: ngs  = 0  ! local number of G vectors
+     INTEGER :: ngst = 0  ! in parallel execution global number of G vectors,
+                       ! in serial execution this is equal to ngw
+     INTEGER :: ngsl = 0  ! number of G-vector shells up to ngw
+     INTEGER :: ngsx = 0  ! maximum local number of G vectors
+
+     INTEGER, ALLOCATABLE :: nps(:), nms(:)
+
+     REAL(DP) :: ecuts = 0.0d0
+     REAL(DP) :: gcuts = 0.0d0
+
+     REAL(DP) :: dual = 0.0d0
+     LOGICAL   :: doublegrid = .FALSE.
+
+   CONTAINS
+
+     SUBROUTINE deallocate_gvecs()
+       IF( ALLOCATED( nps ) ) DEALLOCATE( nps )
+       IF( ALLOCATED( nms ) ) DEALLOCATE( nms )
+     END SUBROUTINE deallocate_gvecs
+
+!=----------------------------------------------------------------------------=!
+   END MODULE gvecs
+!=----------------------------------------------------------------------------=!
+
+  MODULE electrons_base
+      USE kinds, ONLY: DP
+      IMPLICIT NONE
+      SAVE
+
+      INTEGER :: nbnd       = 0    !  number electronic bands, each band contains
+                                   !  two spin states
+      INTEGER :: nbndx      = 0    !  array dimension nbndx >= nbnd
+      INTEGER :: nspin      = 0    !  nspin = number of spins (1=no spin, 2=LSDA)
+      INTEGER :: nel(2)     = 0    !  number of electrons (up, down)
+      INTEGER :: nelt       = 0    !  total number of electrons ( up + down )
+      INTEGER :: nupdwn(2)  = 0    !  number of states with spin up (1) and down (2)
+      INTEGER :: iupdwn(2)  = 0    !  first state with spin (1) and down (2)
+      INTEGER :: nudx       = 0    !  max (nupdw(1),nupdw(2))
+      INTEGER :: nbsp       = 0    !  total number of electronic states 
+                                   !  (nupdwn(1)+nupdwn(2))
+      INTEGER :: nbspx      = 0    !  array dimension nbspx >= nbsp
+
+      LOGICAL :: telectrons_base_initval = .FALSE.
+      LOGICAL :: keep_occ = .FALSE.  ! if .true. when reading restart file keep 
+                                     ! the occupations calculated in initval
+
+      REAL(DP), ALLOCATABLE :: f(:)   ! occupation numbers ( at gamma )
+      REAL(DP) :: qbac = 0.0d0        ! background neutralizing charge
+      INTEGER, ALLOCATABLE :: ispin(:) ! spin of each state
+!
+!------------------------------------------------------------------------------!
+  CONTAINS
+!------------------------------------------------------------------------------!
+
+
+    SUBROUTINE electrons_base_initval( zv_ , na_ , nsp_ , nelec_ , nelup_ , neldw_ , nbnd_ , &
+               nspin_ , occupations_ , f_inp, tot_charge_, multiplicity_, tot_magnetization_ )
+      REAL(DP),         INTENT(IN) :: zv_ (:), tot_charge_
+      REAL(DP),         INTENT(IN) :: nelec_ , nelup_ , neldw_
+      REAL(DP),         INTENT(IN) :: f_inp(:,:)
+      INTEGER,          INTENT(IN) :: na_ (:) , nsp_, multiplicity_, tot_magnetization_
+      INTEGER,          INTENT(IN) :: nbnd_ , nspin_
+      CHARACTER(LEN=*), INTENT(IN) :: occupations_
+    END SUBROUTINE electrons_base_initval
+
+
+    subroutine set_nelup_neldw ( nelec_, nelup_, neldw_, tot_magnetization_, &
+         multiplicity_)
+      !
+      REAL (KIND=DP), intent(IN)    :: nelec_
+      REAL (KIND=DP), intent(INOUT) :: nelup_, neldw_
+      INTEGER,        intent(IN)    :: tot_magnetization_, multiplicity_
+    end subroutine set_nelup_neldw
+
+!----------------------------------------------------------------------------
+
+
+    SUBROUTINE deallocate_elct()
+      IF( ALLOCATED( f ) ) DEALLOCATE( f )
+      IF( ALLOCATED( ispin ) ) DEALLOCATE( ispin )
+      telectrons_base_initval = .FALSE.
+      RETURN
+    END SUBROUTINE deallocate_elct
+
+
+!------------------------------------------------------------------------------!
+  END MODULE electrons_base
+!------------------------------------------------------------------------------!
+
+
+
+!------------------------------------------------------------------------------!
+  MODULE electrons_nose
+!------------------------------------------------------------------------------!
+
+      USE kinds, ONLY: DP
+!
+      IMPLICIT NONE
+      SAVE
+
+      REAL(DP) :: fnosee   = 0.0d0   !  frequency of the thermostat ( in THz )
+      REAL(DP) :: qne      = 0.0d0   !  mass of teh termostat
+      REAL(DP) :: ekincw   = 0.0d0   !  kinetic energy to be kept constant
+
+      REAL(DP) :: xnhe0   = 0.0d0   
+      REAL(DP) :: xnhep   = 0.0d0   
+      REAL(DP) :: xnhem   = 0.0d0   
+      REAL(DP) :: vnhe    = 0.0d0
+  CONTAINS
+  subroutine electrons_nose_init( ekincw_ , fnosee_ )
+     REAL(DP), INTENT(IN) :: ekincw_, fnosee_
+  end subroutine electrons_nose_init
+
+
+  function electrons_nose_nrg( xnhe0, vnhe, qne, ekincw )
+    real(8) :: electrons_nose_nrg
+    real(8), intent(in) :: xnhe0, vnhe, qne, ekincw
+    electrons_nose_nrg = 0.0
+  end function electrons_nose_nrg
+
+  subroutine electrons_nose_shiftvar( xnhep, xnhe0, xnhem )
+    implicit none
+    real(8), intent(out) :: xnhem
+    real(8), intent(inout) :: xnhe0
+    real(8), intent(in) :: xnhep
+  end subroutine electrons_nose_shiftvar
+
+  subroutine electrons_nosevel( vnhe, xnhe0, xnhem, delt )
+    implicit none
+    real(8), intent(inout) :: vnhe
+    real(8), intent(in) :: xnhe0, xnhem, delt 
+  end subroutine electrons_nosevel
+
+  subroutine electrons_noseupd( xnhep, xnhe0, xnhem, delt, qne, ekinc, ekincw, vnhe )
+    implicit none
+    real(8), intent(out) :: xnhep, vnhe
+    real(8), intent(in) :: xnhe0, xnhem, delt, qne, ekinc, ekincw
+  end subroutine electrons_noseupd
+
+
+  SUBROUTINE electrons_nose_info()
+  END SUBROUTINE electrons_nose_info
+  END MODULE electrons_nose
+
+module cvan
+  use parameters, only: nsx
+  implicit none
+  save
+  integer nvb, ish(nsx)
+  integer, allocatable:: indlm(:,:)
+contains
+  subroutine allocate_cvan( nind, ns )
+    integer, intent(in) :: nind, ns
+  end subroutine allocate_cvan
+
+  subroutine deallocate_cvan( )
+  end subroutine deallocate_cvan
+
+end module cvan
+
+  MODULE cell_base
+      USE kinds, ONLY : DP
+      IMPLICIT NONE
+      SAVE
+        REAL(DP) :: alat = 0.0d0
+        REAL(DP) :: celldm(6) = (/ 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0 /)
+        REAL(DP) :: a1(3) = (/ 0.0d0, 0.0d0, 0.0d0 /)
+        REAL(DP) :: a2(3) = (/ 0.0d0, 0.0d0, 0.0d0 /)
+        REAL(DP) :: a3(3) = (/ 0.0d0, 0.0d0, 0.0d0 /)
+        REAL(DP) :: b1(3) = (/ 0.0d0, 0.0d0, 0.0d0 /)
+        REAL(DP) :: b2(3) = (/ 0.0d0, 0.0d0, 0.0d0 /)
+        REAL(DP) :: b3(3) = (/ 0.0d0, 0.0d0, 0.0d0 /)
+        REAL(DP) :: ainv(3,3) = 0.0d0
+        REAl(DP) :: omega = 0.0d0  !  volume of the simulation cell
+        REAL(DP) :: tpiba  = 0.0d0   !  = 2 PI / alat
+        REAL(DP) :: tpiba2 = 0.0d0   !  = ( 2 PI / alat ) ** 2
+        REAL(DP) :: at(3,3) = RESHAPE( (/ 0.0d0 /), (/ 3, 3 /), (/ 0.0d0 /) )
+        REAL(DP) :: bg(3,3) = RESHAPE( (/ 0.0d0 /), (/ 3, 3 /), (/ 0.0d0 /) )
+        INTEGER          :: ibrav      ! index of the bravais lattice
+        CHARACTER(len=9) :: symm_type  ! 'cubic' or 'hexagonal' when ibrav=0
+        REAL(DP) :: h(3,3)    = 0.0d0 ! simulation cell at time t 
+        REAL(DP) :: hold(3,3) = 0.0d0 ! simulation cell at time t-delt
+        REAL(DP) :: hnew(3,3) = 0.0d0 ! simulation cell at time t+delt
+        REAL(DP) :: velh(3,3) = 0.0d0 ! simulation cell velocity
+        REAL(DP) :: deth      = 0.0d0 ! determinant of h ( cell volume )
+        INTEGER   :: iforceh(3,3) = 1  ! if iforceh( i, j ) = 0 then h( i, j ) 
+        LOGICAL   :: thdiag = .FALSE.  ! True if only cell diagonal elements 
+        REAL(DP) :: wmass = 0.0d0     ! cell fictitious mass
+        REAL(DP) :: press = 0.0d0     ! external pressure 
+        REAL(DP) :: frich  = 0.0d0    ! firction parameter for cell damped dynamics
+        REAL(DP) :: greash = 1.0d0    ! greas parameter for damped dynamics
+        LOGICAL :: tcell_base_init = .FALSE.
+  CONTAINS
+        SUBROUTINE updatecell(box_tm1, box_t0, box_tp1)
+          integer :: box_tm1, box_t0, box_tp1
+        END SUBROUTINE updatecell
+        SUBROUTINE dgcell( gcdot, box_tm1, box_t0, delt )
+          REAL(DP), INTENT(OUT) :: GCDOT(3,3)
+          REAL(DP), INTENT(IN) :: delt
+          integer, intent(in) :: box_tm1, box_t0
+        END SUBROUTINE dgcell
+
+        SUBROUTINE cell_init_ht( box, ht )
+          integer :: box
+          REAL(DP) :: ht(3,3)
+        END SUBROUTINE cell_init_ht
+
+        SUBROUTINE cell_init_a( box, a1, a2, a3 )
+          integer :: box
+          REAL(DP) :: a1(3), a2(3), a3(3)
+        END SUBROUTINE cell_init_a
+
+        SUBROUTINE r_to_s1 (r,s,box)
+          REAL(DP), intent(out) ::  S(3)
+          REAL(DP), intent(in) :: R(3)
+          integer, intent(in) :: box
+        END SUBROUTINE r_to_s1
+
+        SUBROUTINE r_to_s3 ( r, s, na, nsp, hinv )
+          REAL(DP), intent(out) ::  S(:,:)
+          INTEGER, intent(in) ::  na(:), nsp
+          REAL(DP), intent(in) :: R(:,:)
+          REAL(DP), intent(in) :: hinv(:,:)    ! hinv = TRANSPOSE( box%m1 )
+          integer :: i, j, ia, is, isa
+          isa = 0
+          DO is = 1, nsp
+            DO ia = 1, na(is)
+              isa = isa + 1
+              DO I=1,3
+                S(I,isa) = 0.D0
+                DO J=1,3
+                  S(I,isa) = S(I,isa) + R(J,isa)*hinv(i,j)
+                END DO
+              END DO
+            END DO
+          END DO
+          RETURN
+        END SUBROUTINE r_to_s3
+
+!------------------------------------------------------------------------------!
+
+        SUBROUTINE r_to_s1b ( r, s, hinv )
+          REAL(DP), intent(out) ::  S(:)
+          REAL(DP), intent(in) :: R(:)
+          REAL(DP), intent(in) :: hinv(:,:)    ! hinv = TRANSPOSE( box%m1 )
+          integer :: i, j
+          DO I=1,3
+            S(I) = 0.D0
+            DO J=1,3
+              S(I) = S(I) + R(J)*hinv(i,j)
+            END DO
+          END DO
+          RETURN
+        END SUBROUTINE r_to_s1b
+
+
+        SUBROUTINE s_to_r1 (S,R,box)
+          REAL(DP), intent(in) ::  S(3)
+          REAL(DP), intent(out) :: R(3)
+          integer, intent(in) :: box
+        END SUBROUTINE s_to_r1
+
+        SUBROUTINE s_to_r1b (S,R,h)
+          REAL(DP), intent(in) ::  S(3)
+          REAL(DP), intent(out) :: R(3)
+          REAL(DP), intent(in) :: h(:,:)    ! h = TRANSPOSE( box%a )
+        END SUBROUTINE s_to_r1b
+
+        SUBROUTINE s_to_r3 ( S, R, na, nsp, h )
+          REAL(DP), intent(in) ::  S(:,:)
+          INTEGER, intent(in) ::  na(:), nsp
+          REAL(DP), intent(out) :: R(:,:)
+          REAL(DP), intent(in) :: h(:,:)    ! h = TRANSPOSE( box%a )
+        END SUBROUTINE s_to_r3
+
+      SUBROUTINE gethinv(box)
+        IMPLICIT NONE
+        integer, INTENT (INOUT) :: box
+      END SUBROUTINE gethinv
+
+
+      FUNCTION get_volume( hmat )
+         IMPLICIT NONE
+         REAL(DP) :: get_volume
+         REAL(DP) :: hmat( 3, 3 )
+          get_volume = 4.4
+      END FUNCTION get_volume
+
+      FUNCTION pbc(rin,box,nl) RESULT (rout)
+        IMPLICIT NONE
+        integer :: box
+        REAL (DP) :: rin(3)
+        REAL (DP) :: rout(3), s(3)
+        INTEGER, OPTIONAL :: nl(3)
+        rout = 4.4
+      END FUNCTION pbc
+
+          SUBROUTINE get_cell_param(box,cell,ang)
+          IMPLICIT NONE
+          integer, INTENT(in) :: box
+          REAL(DP), INTENT(out), DIMENSION(3) :: cell
+          REAL(DP), INTENT(out), DIMENSION(3), OPTIONAL :: ang
+          END SUBROUTINE get_cell_param
+
+      SUBROUTINE pbcs_components(x1, y1, z1, x2, y2, z2, m)
+        USE kinds
+        INTEGER, INTENT(IN)  :: M
+        REAL(DP),  INTENT(IN)  :: X1,Y1,Z1
+        REAL(DP),  INTENT(OUT) :: X2,Y2,Z2
+        REAL(DP) MIC
+      END SUBROUTINE pbcs_components
+
+      SUBROUTINE pbcs_vectors(v, w, m)
+        USE kinds
+        INTEGER, INTENT(IN)  :: m
+        REAL(DP),  INTENT(IN)  :: v(3)
+        REAL(DP),  INTENT(OUT) :: w(3)
+        REAL(DP) :: MIC
+      END SUBROUTINE pbcs_vectors
+
+  SUBROUTINE cell_base_init( ibrav_ , celldm_ , trd_ht, cell_symmetry, rd_ht, cell_units, &
+               a_ , b_ , c_ , cosab, cosac, cosbc, wc_ , total_ions_mass , press_ ,  &
+               frich_ , greash_ , cell_dofree )
+
+    IMPLICIT NONE
+    INTEGER, INTENT(IN) :: ibrav_
+    REAL(DP), INTENT(IN) :: celldm_ (6)
+    LOGICAL, INTENT(IN) :: trd_ht
+    CHARACTER(LEN=*), INTENT(IN) :: cell_symmetry
+    REAL(DP), INTENT(IN) :: rd_ht (3,3)
+    CHARACTER(LEN=*), INTENT(IN) :: cell_units
+    REAL(DP), INTENT(IN) :: a_ , b_ , c_ , cosab, cosac, cosbc
+    CHARACTER(LEN=*), INTENT(IN) :: cell_dofree
+    REAL(DP),  INTENT(IN) :: wc_ , frich_ , greash_ , total_ions_mass
+    REAL(DP),  INTENT(IN) :: press_  ! external pressure from imput ( GPa )
+  END SUBROUTINE cell_base_init
+
+
+  SUBROUTINE cell_base_reinit( ht )
+    REAL(DP), INTENT(IN) :: ht (3,3)
+  END SUBROUTINE cell_base_reinit
+
+  SUBROUTINE cell_steepest( hnew, h, delt, iforceh, fcell )
+    REAL(DP), INTENT(OUT) :: hnew(3,3)
+    REAL(DP), INTENT(IN) :: h(3,3), fcell(3,3)
+    INTEGER,      INTENT(IN) :: iforceh(3,3)
+    REAL(DP), INTENT(IN) :: delt
+  END SUBROUTINE cell_steepest
+
+  SUBROUTINE cell_verlet( hnew, h, hold, delt, iforceh, fcell, frich, tnoseh, hnos )
+    REAL(DP), INTENT(OUT) :: hnew(3,3)
+    REAL(DP), INTENT(IN) :: h(3,3), hold(3,3), hnos(3,3), fcell(3,3)
+    INTEGER,      INTENT(IN) :: iforceh(3,3)
+    REAL(DP), INTENT(IN) :: frich, delt
+    LOGICAL,      INTENT(IN) :: tnoseh
+  END SUBROUTINE cell_verlet
+
+  subroutine cell_hmove( h, hold, delt, iforceh, fcell )
+    REAL(DP), intent(out) :: h(3,3)
+    REAL(DP), intent(in) :: hold(3,3), fcell(3,3)
+    REAL(DP), intent(in) :: delt
+    integer, intent(in) :: iforceh(3,3)
+  end subroutine cell_hmove
+
+  subroutine cell_force( fcell, ainv, stress, omega, press, wmass )
+    REAL(DP), intent(out) :: fcell(3,3)
+    REAL(DP), intent(in) :: stress(3,3), ainv(3,3)
+    REAL(DP), intent(in) :: omega, press, wmass
+  end subroutine cell_force
+
+  subroutine cell_move( hnew, h, hold, delt, iforceh, fcell, frich, tnoseh, vnhh, velh, tsdc )
+    REAL(DP), intent(out) :: hnew(3,3)
+    REAL(DP), intent(in) :: h(3,3), hold(3,3), fcell(3,3)
+    REAL(DP), intent(in) :: vnhh(3,3), velh(3,3)
+    integer,      intent(in) :: iforceh(3,3)
+    REAL(DP), intent(in) :: frich, delt
+    logical,      intent(in) :: tnoseh, tsdc
+  end subroutine cell_move
+
+  subroutine cell_gamma( hgamma, ainv, h, velh )
+    REAL(DP) :: hgamma(3,3)
+    REAL(DP), intent(in) :: ainv(3,3), h(3,3), velh(3,3)
+  end subroutine cell_gamma
+
+  subroutine cell_kinene( ekinh, temphh, velh )
+    REAL(DP), intent(out) :: ekinh, temphh(3,3)
+    REAL(DP), intent(in)  :: velh(3,3)
+  end subroutine cell_kinene
+
+  function cell_alat( )
+    real(DP) :: cell_alat
+    cell_alat = 4.4
+  end function cell_alat
+   END MODULE cell_base
+
+
+  MODULE ions_base
+      USE kinds,      ONLY : DP
+      USE parameters, ONLY : ntypx
+      IMPLICIT NONE
+      SAVE
+      INTEGER :: nsp     = 0
+      INTEGER :: na(5) = 0    
+      INTEGER :: nax     = 0
+      INTEGER :: nat     = 0
+      REAL(DP) :: zv(5)    = 0.0d0
+      REAL(DP) :: pmass(5) = 0.0d0
+      REAL(DP) :: amass(5) = 0.0d0
+      REAL(DP) :: rcmax(5) = 0.0d0
+      INTEGER,  ALLOCATABLE :: ityp(:)
+      REAL(DP), ALLOCATABLE :: tau(:,:)     !  initial positions read from stdin (in bohr)
+      REAL(DP), ALLOCATABLE :: vel(:,:)     !  initial velocities read from stdin (in bohr)
+      REAL(DP), ALLOCATABLE :: tau_srt(:,:) !  tau sorted by specie in bohr
+      REAL(DP), ALLOCATABLE :: vel_srt(:,:) !  vel sorted by specie in bohr
+      INTEGER,  ALLOCATABLE :: ind_srt(:)   !  index of tau sorted by specie
+      INTEGER,  ALLOCATABLE :: ind_bck(:)   !  reverse of ind_srt
+      CHARACTER(LEN=3)      :: atm( 5 ) 
+      CHARACTER(LEN=80)     :: tau_units
+
+
+      INTEGER, ALLOCATABLE :: if_pos(:,:)  ! if if_pos( x, i ) = 0 then  x coordinate of 
+                                           ! the i-th atom will be kept fixed
+      INTEGER, ALLOCATABLE :: iforce(:,:)  ! if_pos sorted by specie 
+      INTEGER :: fixatom   = -1            ! to be removed
+      INTEGER :: ndofp     = -1            ! ionic degree of freedom
+      INTEGER :: ndfrz     = 0             ! frozen degrees of freedom
+
+      REAL(DP) :: fricp   ! friction parameter for damped dynamics
+      REAL(DP) :: greasp  ! friction parameter for damped dynamics
+      REAL(DP), ALLOCATABLE :: taui(:,:)
+      REAL(DP) :: cdmi(3), cdm(3)
+      REAL(DP) :: cdms(3)
+      LOGICAL :: tions_base_init = .FALSE.
+  CONTAINS
+    SUBROUTINE packtau( taup, tau, na, nsp )
+      REAL(DP), INTENT(OUT) :: taup( :, : )
+      REAL(DP), INTENT(IN) :: tau( :, :, : )
+      INTEGER, INTENT(IN) :: na( : ), nsp
+    END SUBROUTINE packtau
+
+    SUBROUTINE unpacktau( tau, taup, na, nsp )
+      REAL(DP), INTENT(IN) :: taup( :, : )
+      REAL(DP), INTENT(OUT) :: tau( :, :, : )
+      INTEGER, INTENT(IN) :: na( : ), nsp
+    END SUBROUTINE unpacktau
+
+    SUBROUTINE sort_tau( tausrt, isrt, tau, isp, nat, nsp )
+      REAL(DP), INTENT(OUT) :: tausrt( :, : )
+      INTEGER, INTENT(OUT) :: isrt( : )
+      REAL(DP), INTENT(IN) :: tau( :, : )
+      INTEGER, INTENT(IN) :: nat, nsp, isp( : )
+      INTEGER :: ina( nsp ), na( nsp )
+    END SUBROUTINE sort_tau
+
+    SUBROUTINE unsort_tau( tau, tausrt, isrt, nat )
+      REAL(DP), INTENT(IN) :: tausrt( :, : )
+      INTEGER, INTENT(IN) :: isrt( : )
+      REAL(DP), INTENT(OUT) :: tau( :, : )
+      INTEGER, INTENT(IN) :: nat
+    END SUBROUTINE unsort_tau
+
+    SUBROUTINE ions_base_init( nsp_, nat_, na_, ityp_, tau_, vel_, amass_, &
+                               atm_, if_pos_, tau_units_, alat_, a1_, a2_, &
+                               a3_, rcmax_ )
+      INTEGER,          INTENT(IN) :: nsp_, nat_, na_(:), ityp_(:)
+      REAL(DP),         INTENT(IN) :: tau_(:,:)
+      REAL(DP),         INTENT(IN) :: vel_(:,:)
+      REAL(DP),         INTENT(IN) :: amass_(:)
+      CHARACTER(LEN=*), INTENT(IN) :: atm_(:)
+      CHARACTER(LEN=*), INTENT(IN) :: tau_units_
+      INTEGER,          INTENT(IN) :: if_pos_(:,:)
+      REAL(DP),         INTENT(IN) :: alat_, a1_(3), a2_(3), a3_(3)
+      REAL(DP),         INTENT(IN) :: rcmax_(:)
+    END SUBROUTINE ions_base_init
+
+    SUBROUTINE deallocate_ions_base()
+    END SUBROUTINE deallocate_ions_base
+
+    SUBROUTINE ions_vel3( vel, taup, taum, na, nsp, dt )
+      REAL(DP) :: vel(:,:), taup(:,:), taum(:,:)
+      INTEGER :: na(:), nsp
+      REAL(DP) :: dt
+    END SUBROUTINE ions_vel3
+
+    SUBROUTINE ions_vel2( vel, taup, taum, nat, dt )
+      REAL(DP) :: vel(:,:), taup(:,:), taum(:,:)
+      INTEGER :: nat
+      REAL(DP) :: dt
+    END SUBROUTINE ions_vel2
+
+    SUBROUTINE cofmass1( tau, pmass, na, nsp, cdm )
+      REAL(DP), INTENT(IN) :: tau(:,:,:), pmass(:)
+      REAL(DP), INTENT(OUT) :: cdm(3)
+      INTEGER, INTENT(IN) :: na(:), nsp
+    END SUBROUTINE cofmass1
+
+    SUBROUTINE cofmass2( tau, pmass, na, nsp, cdm )
+      REAL(DP), INTENT(IN) :: tau(:,:), pmass(:)
+      REAL(DP), INTENT(OUT) :: cdm(3)
+      INTEGER, INTENT(IN) :: na(:), nsp
+    END SUBROUTINE cofmass2
+
+      SUBROUTINE randpos(tau, na, nsp, tranp, amprp, hinv, ifor )
+         REAL(DP) :: hinv(3,3)
+         REAL(DP) :: tau(:,:)
+         INTEGER, INTENT(IN) :: ifor(:,:), na(:), nsp
+         LOGICAL, INTENT(IN) :: tranp(:)
+         REAL(DP), INTENT(IN) :: amprp(:)
+         REAL(DP) :: oldp(3), rand_disp(3), rdisp(3)
+
+       END SUBROUTINE randpos
+
+  SUBROUTINE ions_kinene( ekinp, vels, na, nsp, h, pmass )
+    REAL(DP), intent(out) :: ekinp     !  ionic kinetic energy
+    REAL(DP), intent(in) :: vels(:,:)  !  scaled ionic velocities
+    REAL(DP), intent(in) :: pmass(:)   !  ionic masses
+    REAL(DP), intent(in) :: h(:,:)     !  simulation cell
+    integer, intent(in) :: na(:), nsp
+    integer :: i, j, is, ia, ii, isa
+  END SUBROUTINE ions_kinene
+
+  subroutine ions_temp( tempp, temps, ekinpr, vels, na, nsp, h, pmass, ndega, nhpdim, atm2nhp, ekin2nhp )
+    REAL(DP), intent(out) :: ekinpr, tempp
+    REAL(DP), intent(out) :: temps(:)
+    REAL(DP), intent(out) :: ekin2nhp(:)
+    REAL(DP), intent(in)  :: vels(:,:)
+    REAL(DP), intent(in)  :: pmass(:)
+    REAL(DP), intent(in)  :: h(:,:)
+    integer,        intent(in)  :: na(:), nsp, ndega, nhpdim, atm2nhp(:)
+  end subroutine ions_temp
+
+  subroutine ions_thermal_stress( stress, pmass, omega, h, vels, nsp, na )
+    REAL(DP), intent(inout) :: stress(3,3)
+    REAL(DP), intent(in)  :: pmass(:), omega, h(3,3), vels(:,:)
+    integer, intent(in) :: nsp, na(:)
+    integer :: i, j, is, ia, isa
+  end subroutine ions_thermal_stress
+
+  subroutine ions_vrescal( tcap, tempw, tempp, taup, tau0, taum, na, nsp, fion, iforce, &
+                           pmass, delt )
+    logical, intent(in) :: tcap
+    REAL(DP), intent(inout) :: taup(:,:)
+    REAL(DP), intent(in) :: tau0(:,:), taum(:,:), fion(:,:)
+    REAL(DP), intent(in) :: delt, pmass(:), tempw, tempp
+    integer, intent(in) :: na(:), nsp
+    integer, intent(in) :: iforce(:,:)
+  end subroutine ions_vrescal
+  subroutine ions_shiftvar( varp, var0, varm )
+    REAL(DP), intent(in) :: varp
+    REAL(DP), intent(out) :: varm, var0
+  end subroutine ions_shiftvar
+   SUBROUTINE cdm_displacement( dis, tau )
+      REAL(DP) :: dis
+      REAL(DP) :: tau
+   END SUBROUTINE cdm_displacement
+   SUBROUTINE ions_displacement( dis, tau )
+      REAL (DP), INTENT(OUT) :: dis
+      REAL (DP), INTENT(IN)  :: tau
+   END SUBROUTINE ions_displacement
+  END MODULE ions_base
diff --git a/gcc/testsuite/gfortran.dg/use_only_4.f90 b/gcc/testsuite/gfortran.dg/use_only_4.f90
new file mode 100644
index 000000000..a37db45ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_only_4.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! Test the fix for PR41062, in which an ICE would ensue because
+! of confusion between the two 'one's in the creation of module
+! debug info.
+!
+! Reported by Norman S. Clerman <clerman@fuse.net>
+! Reduced testcase by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module m1
+   interface one  ! GENERIC "one"
+     module procedure one1
+   end interface
+contains
+  subroutine one1()
+    call abort
+  end subroutine one1
+end module m1
+
+module m2
+use m1, only : one  ! USE generic "one"
+contains
+  subroutine two()
+    call one()  ! Call internal "one"
+  contains
+    subroutine one() ! Internal "one"
+      print *, "m2"
+    end subroutine one
+  end subroutine two
+end module m2
+
+  use m2
+  call two
+end
+! { dg-final { cleanup-modules "m1 m2" } }
diff --git a/gcc/testsuite/gfortran.dg/use_rename_1.f90 b/gcc/testsuite/gfortran.dg/use_rename_1.f90
new file mode 100644
index 000000000..01645f678
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_rename_1.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! Tests the fix for PR34854, in which the second of the two subroutines would fail
+! because the the type declaration of nmoltype_phase would incorrectly conflict
+! with the type given to the module variable of the same name.
+!
+! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!
+module common_init_conf
+  integer, dimension(2) :: Nmoltype_phase
+end module common_init_conf
+
+subroutine read_initial_config_nml1()
+  use common_init_conf, nmoltype_phase_com => nmoltype_phase
+  use common_init_conf
+  implicit none
+  integer :: nmoltype_phase
+  namelist /confNmoltypePhase/ nmoltype_phase
+end subroutine read_initial_config_nml1
+
+subroutine read_initial_config_nml2()
+  use common_init_conf
+  use common_init_conf, nmoltype_phase_com => nmoltype_phase
+  implicit none
+  integer :: nmoltype_phase
+  namelist /confNmoltypePhase/ nmoltype_phase
+end subroutine read_initial_config_nml2
+! { dg-final { cleanup-modules "common_init_conf" } }
diff --git a/gcc/testsuite/gfortran.dg/use_rename_2.f90 b/gcc/testsuite/gfortran.dg/use_rename_2.f90
new file mode 100644
index 000000000..3ca6f698a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_rename_2.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! { dg-options "-O1" }
+! Checks the fix for PR34896 which was a regression that prevented max
+! and min from being interchanged by the USE statement below.  It is further
+! checked by libgomp/testsuite/libgomp.fortran/reduction5.f90
+!
+! Reported by H.J. Lu <hjl.tools@gmail.com>
+!
+module reduction5
+  intrinsic min, max
+end module reduction5
+
+program reduction_5_regression
+  call test2
+contains
+  subroutine test2
+    use reduction5, min => max, max => min
+    integer a, b
+    a = max (1,5)
+    b = min (1,5)
+    if (a .ne. 1) call abort ()
+    if (b .ne. 5) call abort ()
+  end subroutine test2
+end
+
+! { dg-final { cleanup-modules "reduction5" } }
diff --git a/gcc/testsuite/gfortran.dg/use_rename_3.f90 b/gcc/testsuite/gfortran.dg/use_rename_3.f90
new file mode 100644
index 000000000..9f28e2ee7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_rename_3.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! Tests the fix for PR35997, in which the use association of renamed
+! valid2 and flag2 was treated as if the renaming were done on use
+! association in the main program.  Thus, the following, direct use
+! association of valid and flag did not occur.
+!
+! Contributed by Drew McCormack <drewmccormack@mac.com>
+!
+module funcinterfacemod
+  interface
+    logical function valid ()
+    end function
+  end interface
+  logical :: flag = .true.
+end module
+
+module secondmod
+  use funcinterfacemod, valid2 => valid, flag2 => flag
+end module
+
+logical function valid ()
+  valid = .true.
+end function
+
+program main
+  use secondmod
+  use funcinterfacemod
+  if (valid ()) then
+    print *, 'Is Valid'
+  endif
+  if (flag) then
+    print *, 'Is flag'
+  endif
+end program
+! { dg-final { cleanup-modules "funcinterfacemod secondmod" } }
diff --git a/gcc/testsuite/gfortran.dg/use_rename_4.f90 b/gcc/testsuite/gfortran.dg/use_rename_4.f90
new file mode 100644
index 000000000..e0e83b891
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_rename_4.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+
+! PR fortran/37193
+! Check fix for problem with re-using the same symbol both renamed and
+! plain.
+
+MODULE m
+  IMPLICIT NONE
+  INTEGER :: i
+END MODULE m
+
+PROGRAM main
+  USE m, ONLY: i, j => i
+  IMPLICIT NONE
+
+  i = 4
+  j = 5
+
+  IF (i /= j) THEN
+    CALL abort ()
+  END IF
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/use_rename_5.f90 b/gcc/testsuite/gfortran.dg/use_rename_5.f90
new file mode 100644
index 000000000..3d7839a0d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_rename_5.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+
+! PR fortran/37193
+! Check that renamed symbols are not accessiable uner their target name.
+
+MODULE m
+  IMPLICIT NONE
+  INTEGER :: i
+END MODULE m
+
+PROGRAM main
+  USE m, ONLY: j => i
+  IMPLICIT NONE
+
+  i = 4 ! { dg-error "no IMPLICIT type" }
+  j = 5
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/use_rename_6.f90 b/gcc/testsuite/gfortran.dg/use_rename_6.f90
new file mode 100644
index 000000000..02f25c36e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_rename_6.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/44702
+!
+! Based on a test case by Joe Krahn.
+!
+! Multiple import of the same symbol was failing for
+! intrinsic modules.
+!
+subroutine one()
+  use iso_c_binding, only: a => c_ptr, b => c_ptr, c_ptr
+  implicit none
+  type(a) :: x
+  type(b) :: y
+  type(c_ptr) :: z
+end subroutine one
+
+subroutine two()
+  use iso_c_binding, a => c_ptr, b => c_ptr
+  implicit none
+  type(a) :: x
+  type(b) :: y
+end subroutine two
+
+subroutine three()
+  use iso_fortran_env, only: a => error_unit, b => error_unit, error_unit
+  implicit none
+  if(a /= b) call shall_not_be_there()
+  if(a /= error_unit) call shall_not_be_there()
+end subroutine three
+
+subroutine four()
+  use iso_fortran_env, a => error_unit, b => error_unit
+  implicit none
+  if(a /= b) call shall_not_be_there()
+end subroutine four
+
+! { dg-final { scan-tree-dump-times "shall_not_be_there" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/used_before_typed_1.f90 b/gcc/testsuite/gfortran.dg/used_before_typed_1.f90
new file mode 100644
index 000000000..972a16742
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_before_typed_1.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! PR fortran/32095
+! PR fortran/34228
+! Check that standards-conforming mode rejects uses of variables that
+! are used before they are typed.
+
+SUBROUTINE test1 (n, arr, m, arr2, k, arr3, a) ! { dg-error "has no IMPLICIT" }
+  IMPLICIT NONE
+
+  INTEGER :: arr(n) ! { dg-error "used before it is typed" }
+  INTEGER :: n
+  INTEGER :: m, arr2(m) ! { dg-bogus "used before it is typed" }
+  INTEGER, DIMENSION(k) :: arr3 ! { dg-error "used before it is typed" }
+  INTEGER :: k
+  CHARACTER(len=LEN(a)) :: a ! { dg-error "'a' is used before it is typed" }
+
+  REAL(KIND=l) :: x ! { dg-error "has no IMPLICIT type" }
+  REAL(KIND=KIND(y)) :: y ! { dg-error "has no IMPLICIT type" }
+
+  DATA str/'abc'/ ! { dg-error "used before it is typed" }
+  CHARACTER(len=3) :: str, str2
+  DATA str2/'abc'/ ! { dg-bogus "used before it is typed" }
+END SUBROUTINE test1
+
+SUBROUTINE test2 (n, arr, m, arr2)
+  IMPLICIT INTEGER(a-z)
+
+  INTEGER :: arr(n)
+  REAL :: n ! { dg-error "already has basic type" }
+  INTEGER :: m, arr2(m) ! { dg-bogus "already has an IMPLICIT type" }
+END SUBROUTINE test2
+
+SUBROUTINE test3 (n, arr, m, arr2)
+  IMPLICIT REAL(a-z)
+
+  INTEGER :: arr(n) ! { dg-error "must be of INTEGER type" }
+  INTEGER :: m, arr2(m) ! { dg-bogus "must be of INTEGER type" }
+END SUBROUTINE test3
diff --git a/gcc/testsuite/gfortran.dg/used_before_typed_2.f90 b/gcc/testsuite/gfortran.dg/used_before_typed_2.f90
new file mode 100644
index 000000000..6f3031fcd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_before_typed_2.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-std=gnu" }
+
+! PR fortran/32095
+! PR fortran/34228
+! This program used to segfault, check this is fixed.
+! Also check that -std=gnu behaves as expected.
+
+SUBROUTINE test1 (n, arr)
+  IMPLICIT NONE
+
+  INTEGER :: arr(n) ! { dg-bogus "used before it is typed" }
+  INTEGER :: n
+  CHARACTER(len=LEN(a)) :: a ! { dg-error "used before it is typed" }
+END SUBROUTINE test1
+
+SUBROUTINE test2 ()
+  IMPLICIT NONE
+
+  DATA str/'abc'/ ! { dg-bogus "used before it is typed" }
+  CHARACTER(len=3) :: str
+END SUBROUTINE test2
diff --git a/gcc/testsuite/gfortran.dg/used_before_typed_3.f90 b/gcc/testsuite/gfortran.dg/used_before_typed_3.f90
new file mode 100644
index 000000000..ab1b2a91f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_before_typed_3.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! PR fortran/32095
+! PR fortran/34228
+! Check for a special case when the return-type of a function is given outside
+! its "body" and contains symbols defined inside.
+
+MODULE testmod
+  IMPLICIT REAL(a-z)
+
+CONTAINS
+
+  CHARACTER(len=x) FUNCTION test1 (x) ! { dg-error "of INTEGER" }
+    IMPLICIT REAL(a-z)
+    INTEGER :: x ! { dg-error "already has basic type" }
+    test1 = "foobar"
+  END FUNCTION test1
+
+  CHARACTER(len=x) FUNCTION test2 (x) ! { dg-bogus "used before|of INTEGER" }
+    IMPLICIT INTEGER(a-z)
+    test2 = "foobar"
+  END FUNCTION test2
+
+END MODULE testmod
+  
+CHARACTER(len=i) FUNCTION test3 (i) ! { dg-bogus "used before|of INTEGER" }
+  ! i is IMPLICIT INTEGER by default
+  test3 = "foobar"
+END FUNCTION test3
+
+CHARACTER(len=g) FUNCTION test4 (g) ! { dg-error "of INTEGER" }
+  ! g is REAL, unless declared INTEGER.
+  test4 = "foobar"
+END FUNCTION test4
+
+! Test an empty function works, too.
+INTEGER FUNCTION test5 ()
+END FUNCTION test5
+
+! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/used_before_typed_4.f90 b/gcc/testsuite/gfortran.dg/used_before_typed_4.f90
new file mode 100644
index 000000000..ff8a1fc29
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_before_typed_4.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! Test for a special case of the used-before-typed errors, when the symbols
+! not-yet-typed are indices.
+
+SUBROUTINE test (n, arr1, m, arr2) ! { dg-error "has no IMPLICIT type" }
+  IMPLICIT NONE
+
+  INTEGER :: myarr(42)
+
+  INTEGER :: arr1(SIZE (myarr(1:n))) ! { dg-error "'n' is used before" }
+  INTEGER :: n
+
+  INTEGER :: arr2(LEN ("hello"(1:m))) ! { dg-error "'m' is used before" }
+  INTEGER :: m
+
+  WRITE (*,*) SIZE (arr1)
+  WRITE (*,*) SIZE (arr2)
+END SUBROUTINE test
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER :: arr1(42), arr2(42)
+  CALL test (3, arr1, 2, arr2) ! { dg-warning "Type mismatch in argument" }
+END PROGRAM main
diff --git a/gcc/testsuite/gfortran.dg/used_before_typed_5.f90 b/gcc/testsuite/gfortran.dg/used_before_typed_5.f90
new file mode 100644
index 000000000..9e78e681f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_before_typed_5.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-pedantic -std=f95" }
+
+! Check that DIMENSION/POINTER/ALLOCATABLE/INTENT statements *do* allow
+! symbols to be typed later.
+
+SUBROUTINE test (a)
+  IMPLICIT REAL (a-z)
+
+  ! Those should *not* IMPLICIT-type the symbols:
+  INTENT(IN) :: a
+  DIMENSION :: b(:)
+  POINTER :: c
+  ALLOCATABLE :: b
+
+  ! So this is ok:
+  INTEGER :: a, b, c
+
+END SUBROUTINE test
diff --git a/gcc/testsuite/gfortran.dg/used_before_typed_6.f90 b/gcc/testsuite/gfortran.dg/used_before_typed_6.f90
new file mode 100644
index 000000000..abcac8cf9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_before_typed_6.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-std=gnu" }
+
+! Allow legacy code to work even if not only a single symbol is used as
+! expression but a basic arithmetic expression.
+
+SUBROUTINE test (n, m)
+  IMPLICIT NONE
+
+  ! These should go fine.
+  INTEGER :: arr1(n + 1) ! { dg-bogus "used before it is typed" }
+  INTEGER :: arr2(n / (2 * m**5)) ! { dg-bogus "used before it is typed" }
+
+  ! These should fail for obvious reasons.
+  INTEGER :: arr3(n * 1.1) ! { dg-error "must be of INTEGER type" }
+  INTEGER :: arr4(REAL (m)) ! { dg-error "used before it is typed" }
+  INTEGER :: arr5(SIN (m)) ! { dg-error "used before it is typed" }
+
+  INTEGER :: n, m
+END SUBROUTINE test
diff --git a/gcc/testsuite/gfortran.dg/used_dummy_types_1.f90 b/gcc/testsuite/gfortran.dg/used_dummy_types_1.f90
new file mode 100644
index 000000000..0cf01bb50
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_dummy_types_1.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! This checks the fix for PR20244 in which USE association
+! of derived types would cause an ICE, if the derived type
+! was also available by host association. This occurred 
+! because the backend declarations were different. 
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!==============
+module mtyp
+  type t1
+     integer::a
+  end type t1
+end module mtyp
+!==============
+module atest
+  use mtyp
+  type(t1)::ze
+contains
+  subroutine test(ze_in )
+    use mtyp
+    implicit none
+    type(t1)::ze_in
+    ze_in = ze
+  end subroutine test
+  subroutine init( )
+    implicit none
+    ze = t1 (42)
+  end subroutine init
+end module atest
+!==============
+  use atest
+  type(t1) :: res = t1 (0)
+  call init ()
+  call test (res)
+  if (res%a.ne.42) call abort
+end  
+
+! { dg-final { cleanup-modules "mtyp atest" } }
diff --git a/gcc/testsuite/gfortran.dg/used_dummy_types_2.f90 b/gcc/testsuite/gfortran.dg/used_dummy_types_2.f90
new file mode 100644
index 000000000..a47cabc43
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_dummy_types_2.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! This tests that the fix for PR25391 also fixes PR20244. If
+! the USE mod1 in subroutine foo were deleted, the code would
+! compile fine.  With the USE statement, the compiler would
+! make new TYPEs for T1 and T2 and bomb out in fold-convert.
+! This is a slightly more elaborate test than
+! used_dummy_types_1.f90 and came from the PR.
+!
+! Contributed by Jakub Jelinek  <jakubcc.gnu.org>
+module mod1
+  type t1
+    real :: f1
+  end type t1
+  type t2
+    type(t1), pointer :: f2(:)
+    real, pointer :: f3(:,:)
+  end type t2
+end module mod1
+
+module mod2
+  use mod1
+  type(t1), pointer, save :: v(:)
+contains
+  subroutine foo (x)
+    use mod1
+    implicit none
+    type(t2) :: x
+    integer :: d
+    d = size (x%f3, 2)
+    v = x%f2(:)
+  end subroutine foo
+end module mod2
+
+! { dg-final { cleanup-modules "mod1 mod2" } }
diff --git a/gcc/testsuite/gfortran.dg/used_dummy_types_3.f90 b/gcc/testsuite/gfortran.dg/used_dummy_types_3.f90
new file mode 100644
index 000000000..a308c0e37
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_dummy_types_3.f90
@@ -0,0 +1,37 @@
+! { dg-do compile }
+! This checks the fix for PR20864 in which same name, USE associated
+! derived types from different modules, with private components were
+! not recognised to be different.
+!
+! Contributed by Joost VandVondele  <jv244@cam.ac.uk>
+!==============
+  MODULE T1
+    TYPE data_type
+      SEQUENCE
+  ! private causes the types in T1 and T2 to be different 4.4.2
+      PRIVATE
+      INTEGER :: I
+    END TYPE
+  END MODULE
+
+  MODULE T2
+    TYPE data_type
+      SEQUENCE
+      PRIVATE
+      INTEGER :: I
+    END TYPE
+
+  CONTAINS
+
+    SUBROUTINE TEST(x)
+      TYPE(data_type) :: x
+    END SUBROUTINE TEST
+  END MODULE
+
+    USE T1
+    USE T2 , ONLY : TEST
+    TYPE(data_type) :: x
+    CALL TEST(x)         ! { dg-error "Type mismatch in argument" }
+  END
+
+! { dg-final { cleanup-modules "T1 T2" } }
diff --git a/gcc/testsuite/gfortran.dg/used_dummy_types_4.f90 b/gcc/testsuite/gfortran.dg/used_dummy_types_4.f90
new file mode 100644
index 000000000..fb36fa7bf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_dummy_types_4.f90
@@ -0,0 +1,102 @@
+! { dg-do compile }
+! This checks the fix for PR19362 in which types from different scopes
+! that are the same, according to 4.4.2, would generate an ICE if one
+! were assigned to the other.  As well as the test itself, various
+! other requirements of 4.4.2 are tested here.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!==============
+module global
+
+  TYPE :: seq_type1
+    sequence
+    integer :: i
+  end type seq_type1
+
+  TYPE :: nonseq_type1
+    integer :: i
+  end type nonseq_type1
+  type (nonseq_type1) :: ns1
+
+end module global
+
+! Host types with local name != true name
+  use global, only: seq_type2=>seq_type1, nonseq_type2=>nonseq_type1, ns1
+  type (nonseq_type2) :: ns2
+
+! Host non-sequence types
+  type :: different_type
+    integer :: i
+  end type different_type
+  type (different_type)  :: dt1
+
+  type :: same_type
+    integer :: i
+  end type same_type
+  type (same_type)  :: st1
+
+  real :: seq_type1
+
+! Provide a reference to dt1.
+  dt1 = different_type (42)
+! These share a type declaration.
+  ns2 = ns1
+! USE associated seq_type1 is renamed.
+  seq_type1 = 1.0
+
+! These are different.
+  st1 = dt                ! { dg-error "convert REAL" }
+
+  call foo (st1)          ! { dg-error "Type mismatch in argument" }
+
+contains
+
+  subroutine foo (st2)
+
+! Contained type with local name != true name.
+! This is the same as seq_type2 in the host.
+    use global, only: seq_type3=>seq_type1
+
+! This local declaration is the same as seq_type3 and seq_type2.
+    TYPE :: seq_type1
+      sequence
+      integer :: i
+    end type seq_type1
+
+! Host association of renamed type.
+    type (seq_type2) :: x
+! Locally declared version of the same thing.
+    type (seq_type1) :: y
+! USE associated renamed type.
+    type (seq_type3) :: z
+
+! Contained type that is different to that in the host.
+    type :: different_type
+      complex :: z
+    end type different_type
+
+    type :: same_type
+      integer :: i
+    end type same_type
+
+    type (different_type)  :: b
+    type (same_type)  :: st2
+
+! Error because these are not the same.
+    b = dt1               ! { dg-error "convert TYPE" }
+
+! Error in spite of the name - these are non-sequence types and are NOT
+! the same.
+    st1 = st2             ! { dg-error "convert TYPE" }
+
+    b%z = (2.0,-1.0)
+
+! Check that the references that are correct actually work. These test the
+! fix for PR19362.
+    x = seq_type1 (1)
+    y = x
+    y = seq_type3 (99)
+  end subroutine foo
+END
+
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/used_dummy_types_5.f90 b/gcc/testsuite/gfortran.dg/used_dummy_types_5.f90
new file mode 100644
index 000000000..2000c3271
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_dummy_types_5.f90
@@ -0,0 +1,86 @@
+! { dg-do compile }
+! This checks that the fix for PR19362 has not broken gfortran
+! in respect of.references allowed by 4.4.2.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!==============
+module global
+
+  TYPE :: seq_type1
+    sequence
+    integer :: i
+  end type seq_type1
+
+  TYPE :: nonseq_type1
+    integer :: i = 44
+  end type nonseq_type1
+  type (nonseq_type1), save :: ns1
+
+end module global
+
+  use global, only: seq_type2=>seq_type1, nonseq_type1, ns1
+
+! Host non-sequence types
+  type :: different_type
+    integer :: i
+  end type different_type
+
+  type :: same_type
+    sequence
+    integer :: i
+  end type same_type
+
+  type (seq_type2)  :: t1
+  type (different_type)  :: dt1
+
+  type (nonseq_type1) :: ns2
+  type (same_type)  :: st1
+  real seq_type1
+
+  t1 = seq_type2 (42)
+  dt1 = different_type (43)
+  ns2 = ns1
+  seq_type1 =1.0e32
+  st1%i = 45
+
+  call foo (t1)
+
+contains
+
+  subroutine foo (x)
+
+    use global, only: seq_type3=>seq_type1
+
+    TYPE :: seq_type1
+      sequence
+      integer :: i
+    end type seq_type1
+
+    type :: different_type
+      complex :: z
+    end type different_type
+
+    type :: same_type
+      sequence
+      integer :: i
+    end type same_type
+! Host association of renamed type.
+    type (seq_type2) :: x
+! Locally declared version of the same thing.
+    type (seq_type1) :: y
+! USE associated renamed type.
+    type (seq_type3) :: z
+
+
+    type (different_type)  :: dt2
+    type (same_type)  :: st2
+
+    dt2%z = (2.0,-1.0)
+    y = seq_type2 (46)
+    z = seq_type3 (47)
+    st2 = st1
+    print *, x, y, z, dt2, st2, ns2, ns1
+  end subroutine foo
+END
+
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/used_dummy_types_6.f90 b/gcc/testsuite/gfortran.dg/used_dummy_types_6.f90
new file mode 100644
index 000000000..ea3905122
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_dummy_types_6.f90
@@ -0,0 +1,47 @@
+! { dg-do compile }
+! Tests the fix for PR30554, the USE statements in potential_energy
+! would cause a segfault because the pointer_info for nfree coming
+! from constraint would not find the existing symtree coming directly
+! from atom.
+!
+! The last two modules came up subsequently to the original fix.  The
+! PRIVATE statement caused a revival of the original problem.  This
+! was tracked down to an interaction between the symbols being set
+! referenced during module read and the application of the access
+! attribute.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+MODULE ATOMS
+INTEGER :: NFREE = 0
+END MODULE ATOMS
+
+MODULE CONSTRAINT
+USE ATOMS, ONLY: NFREE
+CONTAINS
+   SUBROUTINE ENERGY_CONSTRAINT ( HESSIAN )
+   REAL , DIMENSION(1:(3*NFREE*(3*NFREE+1))/2):: HESSIAN
+   END SUBROUTINE ENERGY_CONSTRAINT
+END MODULE CONSTRAINT
+
+MODULE POTENTIAL_ENERGY
+USE ATOMS
+USE CONSTRAINT,         ONLY : ENERGY_CONSTRAINT
+END MODULE POTENTIAL_ENERGY
+
+MODULE P_CONSTRAINT
+USE ATOMS, ONLY: NFREE
+PRIVATE
+PUBLIC :: ENERGY_CONSTRAINT
+CONTAINS
+   SUBROUTINE ENERGY_CONSTRAINT ( HESSIAN )
+   REAL , DIMENSION(1:(3*NFREE*(3*NFREE+1))/2):: HESSIAN
+   END SUBROUTINE ENERGY_CONSTRAINT
+END MODULE P_CONSTRAINT
+
+MODULE P_POTENTIAL_ENERGY
+USE ATOMS
+USE CONSTRAINT,         ONLY : ENERGY_CONSTRAINT
+END MODULE P_POTENTIAL_ENERGY
+
+! { dg-final { cleanup-modules "atoms constraint potential_energy p_constraint p_potential_energy" } }
diff --git a/gcc/testsuite/gfortran.dg/used_dummy_types_7.f90 b/gcc/testsuite/gfortran.dg/used_dummy_types_7.f90
new file mode 100644
index 000000000..b0acc5140
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_dummy_types_7.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! This tests a patch for a regression caused by the second part of
+! the fix for PR30554.  The linked derived types dummy_atom and
+! dummy_atom_list caused a segment fault because they do not have
+! a namespace.
+!
+! Contributed by Daniel Franke <franke.daniel@gmail.com>
+! 
+MODULE types
+TYPE :: dummy_atom_list
+  TYPE(dummy_atom), DIMENSION(:), POINTER :: table => null()
+END TYPE
+
+TYPE :: dummy_atom
+  TYPE(dummy_atom_private), POINTER :: p => null()
+END TYPE
+
+TYPE :: dummy_atom_private
+  INTEGER                     :: id
+END TYPE
+END MODULE
+
+MODULE atom
+USE types, ONLY: dummy_atom
+INTERFACE
+  SUBROUTINE dummy_atom_insert_symmetry_mate(this, other)
+    USE types, ONLY: dummy_atom
+    TYPE(dummy_atom), INTENT(inout) :: this
+    TYPE(dummy_atom), INTENT(in)    :: other
+  END SUBROUTINE
+END INTERFACE
+END MODULE
+
+MODULE list
+INTERFACE
+  SUBROUTINE dummy_atom_list_insert(this, atom2)
+    USE types, ONLY: dummy_atom_list
+    USE atom, ONLY: dummy_atom
+
+    TYPE(dummy_atom_list), INTENT(inout) :: this
+    TYPE(dummy_atom), INTENT(in)         :: atom2
+  END SUBROUTINE
+END INTERFACE
+END MODULE
+! { dg-final { cleanup-modules "atom types list" } }
diff --git a/gcc/testsuite/gfortran.dg/used_dummy_types_8.f90 b/gcc/testsuite/gfortran.dg/used_dummy_types_8.f90
new file mode 100644
index 000000000..8a966a80a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_dummy_types_8.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! Tests the fix for PR30880, in which the variable d1
+! in module m1 would cause an error in the main program
+! because it has an initializer and is a dummy.  This
+! came about because the function with multiple entries
+! assigns the initializer earlier than for other cases.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk> 
+!
+MODULE M1
+  TYPE T1
+  INTEGER :: i=7
+  END TYPE T1
+CONTAINS
+  FUNCTION F1(d1) RESULT(res)
+    INTEGER :: res
+    TYPE(T1), INTENT(OUT) :: d1
+    TYPE(T1), INTENT(INOUT) :: d2
+    res=d1%i
+    d1%i=0
+    RETURN
+  ENTRY E1(d2) RESULT(res)
+    res=d2%i
+    d2%i=0
+  END FUNCTION F1
+END MODULE M1
+
+  USE M1
+  TYPE(T1) :: D1
+  D1=T1(3)
+  write(6,*) F1(D1)
+  D1=T1(3)
+  write(6,*) E1(D1)
+END
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/used_interface_ref.f90 b/gcc/testsuite/gfortran.dg/used_interface_ref.f90
new file mode 100644
index 000000000..3e0290c97
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_interface_ref.f90
@@ -0,0 +1,47 @@
+! { dg-do run }
+! Tests the fix for PR26393, in which an ICE would occur in trans-decl.c
+! (gfc_get_symbol_decl) because anzKomponenten is not referenced in the
+! interface for solveCConvert. The solution was to assert that the symbol
+! is either referenced or in an interface body.
+!
+! Based on the testcase in the PR.
+!
+  MODULE MODULE_CONC
+    INTEGER, SAVE :: anzKomponenten = 2
+  END MODULE MODULE_CONC
+
+  MODULE MODULE_THERMOCALC
+    INTERFACE
+      FUNCTION solveCConvert ()
+        USE MODULE_CONC, ONLY: anzKomponenten
+        REAL :: solveCConvert(1:anzKomponenten)
+        END FUNCTION solveCConvert
+    END INTERFACE
+  END MODULE MODULE_THERMOCALC
+
+  SUBROUTINE outDiffKoeff
+    USE MODULE_CONC
+    USE MODULE_THERMOCALC
+    REAL :: buffer_conc(1:anzKomponenten)
+    buffer_conc = solveCConvert ()
+    if (any(buffer_conc .ne. (/(real(i), i = 1, anzKomponenten)/))) &
+          call abort ()
+  END SUBROUTINE outDiffKoeff
+
+  program missing_ref
+    USE MODULE_CONC
+    call outDiffKoeff
+! Now set anzKomponenten to a value that would cause a segfault if
+! buffer_conc and solveCConvert did not have the correct allocation
+! of memory.
+    anzKomponenten = 5000
+    call outDiffKoeff
+  end program missing_ref
+ 
+  FUNCTION solveCConvert ()
+    USE MODULE_CONC, ONLY: anzKomponenten
+    REAL :: solveCConvert(1:anzKomponenten)
+    solveCConvert = (/(real(i), i = 1, anzKomponenten)/)
+  END FUNCTION solveCConvert
+
+! { dg-final { cleanup-modules "MODULE_CONC MODULE_THERMOCALC" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_1.f90 b/gcc/testsuite/gfortran.dg/used_types_1.f90
new file mode 100644
index 000000000..4fbd32891
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_1.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! This checks that the fix for PR25730, which was a regression
+! caused by the fix for PR19362.
+!
+! Contributed by Andrea Bedini <andrea.bedini@gmail.com>
+!==============
+MODULE testcase
+  TYPE orbit_elem
+     CHARACTER(4) :: coo
+  END TYPE orbit_elem
+END MODULE
+MODULE tp_trace
+  USE testcase
+  TYPE(orbit_elem) :: tp_store
+CONTAINS
+  SUBROUTINE str_clan()
+    USE testcase
+    TYPE(orbit_elem) :: mtpcar
+    mtpcar%coo='a'             !ICE was here
+  END SUBROUTINE str_clan
+END MODULE
+
+! { dg-final { cleanup-modules "testcase tp_trace" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_10.f90 b/gcc/testsuite/gfortran.dg/used_types_10.f90
new file mode 100644
index 000000000..c35fb58e6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_10.f90
@@ -0,0 +1,72 @@
+! { dg-do compile }
+! Tests the fix for PR28959 in which interface derived types were
+! not always being associated.
+!
+! Contributed by Salvatore Filippone  <sfilippone@uniroma2.it>
+!
+module derived_type_mod
+
+  type foo_dtype
+    integer, pointer :: v1(:)=>null()
+  end type foo_dtype
+  
+
+end module derived_type_mod
+
+
+Module tools
+
+  interface foo_d_sub
+     subroutine cdalv(m, v, i, desc_a, info, flag)
+       use derived_type_mod
+       Integer, intent(in)               :: m,i, v(:)
+       integer, intent(in), optional     :: flag
+       integer, intent(out)              :: info
+       Type(foo_dtype), intent(out)  :: desc_a
+     end subroutine cdalv
+  end interface
+
+end module tools
+
+
+
+subroutine foo_bar(a,p,info)
+  use derived_type_mod
+  implicit none
+
+  type(foo_dtype), intent(in)            :: a
+  type(foo_dtype), intent(inout)         :: p
+  integer, intent(out)                   :: info
+
+  info=0
+
+  call inner_sub(info)
+    
+
+  return
+
+
+contains
+
+  subroutine inner_sub(info)
+    use tools
+    implicit none 
+
+    integer, intent(out)   :: info
+
+    integer :: i, nt,iv(10)
+    
+    i  = 0
+    nt = 1
+    
+    call foo_d_sub(nt,iv,i,p,info,flag=1)
+    
+    return
+
+
+  end subroutine inner_sub
+
+
+
+end subroutine foo_bar
+! { dg-final { cleanup-modules "derived_type_mod tools" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_11.f90 b/gcc/testsuite/gfortran.dg/used_types_11.f90
new file mode 100644
index 000000000..b820dc5e2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_11.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! Tests the patch for PR 29641, in which an ICE would occur with
+! the ordering of USE statements below.
+!
+! Contributed by Jakub Jelinek <jakub@gcc.gnu.org>
+!
+module A
+  type :: T
+    integer :: u
+  end type T
+end module A
+
+module B
+contains
+  function foo()
+    use A
+    type(T), pointer :: foo
+    nullify (foo)
+  end function foo
+end module B
+
+subroutine bar()
+  use B             ! The order here is important
+  use A             ! If use A comes before use B, it works
+  type(T), pointer :: x
+  x => foo()
+end subroutine bar
+
+  use B
+  use A
+  type(T), pointer :: x
+  type(T), target  :: y
+  x => y
+  print *, associated (x)
+  x => foo ()
+  print *, associated (x)
+end
+! { dg-final { cleanup-modules "A B" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_12.f90 b/gcc/testsuite/gfortran.dg/used_types_12.f90
new file mode 100644
index 000000000..21d0fe217
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_12.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! Tests the fix PR29744, which is really a repeat of PR19362.
+! The problem came about because the test for PR19362 shifted
+! the fix to a subroutine, rather than the main program that
+! it originally occurred in.  Fixes for subsequent PRs introduced
+! a difference between the main program and a contained procedure
+! that resulted in the compiler going into an infinite loop.
+!
+! Contributed by Harald Anlauf  <anlauf@gmx.de>
+! and originally by Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org> 
+!
+MODULE M
+  TYPE T0
+    SEQUENCE
+    INTEGER I
+  END TYPE
+END
+
+PROGRAM MAIN
+  USE M, T1 => T0
+  TYPE T0
+    SEQUENCE
+    INTEGER I
+  END TYPE
+  TYPE(T0) :: BAR
+  TYPE(T1) :: BAZ
+  BAZ = BAR
+END
+! { dg-final { cleanup-modules "m" } }
+
diff --git a/gcc/testsuite/gfortran.dg/used_types_13.f90 b/gcc/testsuite/gfortran.dg/used_types_13.f90
new file mode 100644
index 000000000..9208b5933
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_13.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! Tests the fix for PR29820, which was another problem with derived type
+! association.  Not all siblings were being searched for identical types.
+!
+! Contributed by Harald Anlauf  <anlauf@gmx.de>
+!
+module geo
+  type geodetic
+     real :: h
+  end type geodetic
+end module geo
+module gfcbug44
+  implicit none
+contains
+subroutine point ( gp)
+  use geo
+  type(geodetic),  intent(out) :: gp
+  type(geodetic) :: gpx(1)
+  gp = gpx(1)
+end subroutine point
+subroutine plane ()
+  use geo
+  type(geodetic)  :: gp
+  call point ( gp)
+end subroutine plane
+end module gfcbug44
+! { dg-final { cleanup-modules "geo gfcbug44" } }
+
diff --git a/gcc/testsuite/gfortran.dg/used_types_14.f90 b/gcc/testsuite/gfortran.dg/used_types_14.f90
new file mode 100644
index 000000000..3316b4ad0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_14.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! Tests the fix for PR30531 in which the interface derived types
+! was not being associated.
+!
+! Contributed by Salvatore Filippone  <sfilippone@uniroma2.it>
+!
+module foo_type_mod
+  type foo_type
+     integer, allocatable :: md(:)
+  end type foo_type
+end module foo_type_mod
+
+module foo_mod
+
+  interface
+    subroutine foo_initvg(foo_a)
+      use foo_type_mod
+      Type(foo_type), intent(out) :: foo_a
+    end subroutine foo_initvg
+  end interface
+
+contains
+
+  subroutine foo_ext(foo_a)
+    use foo_type_mod
+    Type(foo_type) :: foo_a
+
+    call foo_initvg(foo_a)
+  end subroutine foo_ext
+
+end module foo_mod
+! { dg-final { cleanup-modules "foo_type_mod foo_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_15.f90 b/gcc/testsuite/gfortran.dg/used_types_15.f90
new file mode 100644
index 000000000..7f7dbb8e1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_15.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! Tests the fix for PR31086 in which the chained derived types
+! was not being associated.
+!
+! Contributed by Daniel Franke <dfranke@gcc.gnu.org>
+!
+MODULE class_dummy_atom_types
+TYPE :: dummy_atom_list
+  TYPE(dummy_atom), DIMENSION(:), POINTER :: table
+END TYPE
+
+TYPE :: dummy_atom
+  TYPE(dummy_atom_list) :: neighbours
+END TYPE
+
+TYPE :: dummy_atom_model
+  TYPE(dummy_atom_list) :: atoms
+END TYPE
+END MODULE
+
+MODULE test_class_intensity_private
+CONTAINS
+  SUBROUTINE change_phase(atom)
+    USE class_dummy_atom_types
+    TYPE(dummy_atom), INTENT(inout) :: atom
+  END SUBROUTINE
+
+  SUBROUTINE simulate_cube()
+    USE class_dummy_atom_types
+    TYPE(dummy_atom)       :: atom
+    TYPE(dummy_atom_model) :: dam
+    atom = dam%atoms%table(1)
+  END SUBROUTINE
+END MODULE
+! { dg-final { cleanup-modules "class_dummy_atom_types test_class_intensity_private" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_16.f90 b/gcc/testsuite/gfortran.dg/used_types_16.f90
new file mode 100644
index 000000000..b1ad779cf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_16.f90
@@ -0,0 +1,51 @@
+! { dg-do compile }
+! Tests the fix for PR31550 in which pointers to derived type components
+! were being TREE-SSA declared in the wrong order and so in the incorrect
+! context.
+!
+! Contributed by Daniel Franke <dfranke@gcc.gnu.org>
+!
+MODULE class_dummy_atom_types

+TYPE :: dummy_atom_list

+  TYPE(dummy_atom), DIMENSION(:), POINTER :: table

+  INTEGER                                 :: nused

+END TYPE

+

+TYPE :: dummy_atom

+  TYPE(dummy_atom_private), POINTER :: p

+END TYPE

+

+TYPE :: dummy_atom_private

+  TYPE(dummy_atom_list)       :: neighbours

+END TYPE

+END MODULE

+

+MODULE class_dummy_atom_list

+USE class_dummy_atom_types, ONLY: dummy_atom_list

+

+INTERFACE 

+  SUBROUTINE dummy_atom_list_init_copy(this, other)

+    USE class_dummy_atom_types, ONLY: dummy_atom_list

+    TYPE(dummy_atom_list), INTENT(out) :: this

+    TYPE(dummy_atom_list), INTENT(in)  :: other

+  END SUBROUTINE

+END INTERFACE

+

+INTERFACE

+  SUBROUTINE dummy_atom_list_merge(this, other)

+    USE class_dummy_atom_types, ONLY: dummy_atom_list

+    TYPE(dummy_atom_list), INTENT(inout) :: this

+    TYPE(dummy_atom_list), INTENT(in)    :: other

+  END SUBROUTINE

+END INTERFACE

+END MODULE

+

+SUBROUTINE dummy_atom_list_init_copy(this, other)

+  USE class_dummy_atom_list, ONLY: dummy_atom_list, dummy_atom_list_merge

+

+  TYPE(dummy_atom_list), INTENT(out) :: this

+  TYPE(dummy_atom_list), INTENT(in)  :: other

+

+  this%table(1:this%nused) = other%table(1:other%nused)

+END SUBROUTINE

+! { dg-final { cleanup-modules "class_dummy_atom_types class_dummy_atom_list" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_17.f90 b/gcc/testsuite/gfortran.dg/used_types_17.f90
new file mode 100644
index 000000000..964f37187
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_17.f90
@@ -0,0 +1,50 @@
+! { dg do-compile }
+! Tests the fix for PR31630, in which the association of the argument
+! of 'cmp' did not work.
+!
+! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!
+module box_module
+  type box
+    integer :: m = 0
+  end type box
+end module box_module
+
+module sort_box_module
+contains
+
+  subroutine heapsort_box(cmp)
+    interface
+       subroutine cmp(a)
+         use box_module
+         type(box) :: a
+       end subroutine cmp
+    end interface
+    optional :: cmp
+  end subroutine heapsort_box
+
+end module sort_box_module
+
+
+module boxarray_module
+  use box_module
+  implicit none
+
+  type boxarray
+    type(box), allocatable :: bxs(:)
+  end type boxarray
+contains
+
+  subroutine boxarray_build_l(ba)
+    type(boxarray) :: ba
+    allocate(ba%bxs(1))
+  end subroutine boxarray_build_l
+
+  subroutine boxarray_sort()
+    use sort_box_module
+    call heapsort_box
+  end subroutine boxarray_sort
+
+end module boxarray_module
+
+! { dg-final { cleanup-modules "box_module sort_box_module boxarray_module" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_18.f90 b/gcc/testsuite/gfortran.dg/used_types_18.f90
new file mode 100644
index 000000000..0acebc4c8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_18.f90
@@ -0,0 +1,15 @@
+! { dg do-compile }
+! { dg-options "-std=f2003" }
+!
+! Fortran 2003 allowes TYPE without components
+! The error message for -std=f95 is tested in
+! gfortran.dg/access_spec_2.f90
+!
+! PR fortran/33188
+!
+type t
+end type
+
+type(t) :: a
+print *, a
+end
diff --git a/gcc/testsuite/gfortran.dg/used_types_19.f90 b/gcc/testsuite/gfortran.dg/used_types_19.f90
new file mode 100644
index 000000000..dbec8dc1c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_19.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! Tests the fix for PR34335 a regression in which the PRIVATE attribute
+! of type(a) in module b would be ignored and would prevent it being
+! loaded in the main program.
+!
+! Contributed by Janus Weil <jaydub66@gmail.com>
+!
+module A
+  type A_type
+    real comp
+  end type
+end module A
+
+module B
+  use A
+  private
+  type(A_type) :: B_var
+  public:: B_var
+end module B
+
+program C
+  use B
+  use A
+  type(A_type):: A_var
+end program C
+! { dg-final { cleanup-modules "a b" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_2.f90 b/gcc/testsuite/gfortran.dg/used_types_2.f90
new file mode 100644
index 000000000..b1870d12b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_2.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! Tests the fix for PR28630, in which a contained,
+! derived type function caused an ICE if its definition
+! was both host and use associated.
+!
+! Contributed by Mark Hesselink <mhesseli@alumni.caltech.edu>
+!
+MODULE types
+   TYPE :: t
+      INTEGER :: i
+   END TYPE
+END MODULE types
+
+MODULE foo
+   USE types
+CONTAINS
+   FUNCTION bar (x) RESULT(r)
+      USE types
+      REAL, INTENT(IN) :: x
+      TYPE(t) :: r
+      r = t(0)
+   END FUNCTION bar
+END MODULE
+
+
+LOGICAL FUNCTION foobar (x)
+   USE foo
+   REAL, INTENT(IN) :: x
+   TYPE(t) :: c
+   foobar = .FALSE.
+   c = bar (x)
+END FUNCTION foobar
+! { dg-final { cleanup-modules "types foo" } }
+
diff --git a/gcc/testsuite/gfortran.dg/used_types_20.f90 b/gcc/testsuite/gfortran.dg/used_types_20.f90
new file mode 100644
index 000000000..c08235c67
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_20.f90
@@ -0,0 +1,49 @@
+! { dg-do compile }
+! Tests the fix for PR36366 a regression in which the order of USE statements
+! in 'test2' would cause the result of 'test1' not to have a reference to
+! the derived type 'inner'.
+!
+! Contributed by Jakub Jelinek <jakub@gcc.gnu.org>
+!
+MODULE types
+  IMPLICIT NONE
+  TYPE :: inner
+    INTEGER, POINTER :: i(:)
+  END TYPE inner
+
+  TYPE :: outer
+    TYPE(inner), POINTER :: inr(:)
+  END TYPE outer
+END MODULE types
+
+MODULE mymod
+  IMPLICIT NONE
+CONTAINS
+  FUNCTION test1()
+    USE types
+    IMPLICIT NONE
+    TYPE(outer), POINTER :: test1
+    NULLIFY(test1)
+  END FUNCTION test1
+END MODULE mymod
+
+MODULE test
+  IMPLICIT NONE
+CONTAINS
+
+  SUBROUTINE test2(a)
+    USE mymod
+    USE types
+    IMPLICIT NONE
+    TYPE(outer), INTENT(INOUT) :: a
+    INTEGER :: i
+    i = a%inr(1)%i(1)
+  END SUBROUTINE test2
+
+  SUBROUTINE test3(a)
+    USE types
+    IMPLICIT NONE
+    TYPE(outer), INTENT(IN) :: a
+  END SUBROUTINE test3
+END MODULE test
+! { dg-final { cleanup-modules "types mymod test" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_21.f90 b/gcc/testsuite/gfortran.dg/used_types_21.f90
new file mode 100644
index 000000000..04b109f13
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_21.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! Check that pointer components are allowed to empty types.
+
+TYPE :: empty_t
+END TYPE empty_t
+
+TYPE :: comp_t
+  TYPE(empty_t), POINTER :: ptr
+END TYPE comp_t
+
+END
diff --git a/gcc/testsuite/gfortran.dg/used_types_22.f90 b/gcc/testsuite/gfortran.dg/used_types_22.f90
new file mode 100644
index 000000000..2a5ae451a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_22.f90
@@ -0,0 +1,294 @@
+! { dg-do compile }
+! Tests the fix for PR37274 a regression in which the derived type,
+! 'vector' of the function results contained in 'class_motion' is
+! private and is incorrectly detected to be ambiguous in 'smooth_mesh'.
+!
+! Contributed by Salvatore Filippone  <sfilippone@uniroma2.it>
+!
+module class_vector

+

+  implicit none

+

+  private ! Default

+  public :: vector                                  

+  public :: vector_ 

+

+  type vector

+     private

+     real(kind(1.d0)) :: x

+     real(kind(1.d0)) :: y

+     real(kind(1.d0)) :: z

+  end type vector

+

+contains

+  ! ----- Constructors -----

+

+  ! Public default constructor

+  elemental function vector_(x,y,z)

+    type(vector) :: vector_

+    real(kind(1.d0)), intent(in) :: x, y, z

+

+    vector_ = vector(x,y,z)

+

+  end function vector_

+

+end module class_vector

+

+module class_dimensions

+

+  implicit none

+

+  private ! Default

+  public :: dimensions

+

+  type dimensions

+     private

+     integer :: l

+     integer :: m

+     integer :: t

+     integer :: theta

+  end type dimensions

+

+

+end module class_dimensions

+

+module tools_math

+

+  implicit none

+

+

+  interface lin_interp

+     function lin_interp_s(f1,f2,fac)

+       real(kind(1.d0)) :: lin_interp_s

+       real(kind(1.d0)), intent(in) :: f1, f2

+       real(kind(1.d0)), intent(in) :: fac

+     end function lin_interp_s

+

+     function lin_interp_v(f1,f2,fac)

+       use class_vector

+       type(vector) :: lin_interp_v

+       type(vector),     intent(in) :: f1, f2

+       real(kind(1.d0)), intent(in) :: fac

+     end function lin_interp_v

+  end interface

+

+

+  interface pwl_deriv

+     subroutine pwl_deriv_x_s(dydx,x,y_data,x_data)

+       real(kind(1.d0)), intent(out) :: dydx

+       real(kind(1.d0)), intent(in) :: x

+       real(kind(1.d0)), intent(in) :: y_data(:)

+       real(kind(1.d0)), intent(in) :: x_data(:)

+     end subroutine pwl_deriv_x_s

+

+     subroutine pwl_deriv_x_v(dydx,x,y_data,x_data)

+       real(kind(1.d0)), intent(out) :: dydx(:)

+       real(kind(1.d0)), intent(in) :: x

+       real(kind(1.d0)), intent(in) :: y_data(:,:)

+       real(kind(1.d0)), intent(in) :: x_data(:)

+     end subroutine pwl_deriv_x_v

+

+     subroutine pwl_deriv_x_vec(dydx,x,y_data,x_data)

+       use class_vector

+       type(vector), intent(out) :: dydx

+       real(kind(1.d0)), intent(in) :: x

+       type(vector), intent(in) :: y_data(:)

+       real(kind(1.d0)), intent(in) :: x_data(:)

+     end subroutine pwl_deriv_x_vec

+  end interface

+

+end module tools_math

+

+module class_motion

+

+  use class_vector

+ 

+  implicit none

+  

+  private 

+  public :: motion 

+  public :: get_displacement, get_velocity

+

+  type motion

+     private

+     integer :: surface_motion

+     integer :: vertex_motion

+     !

+     integer :: iml

+     real(kind(1.d0)), allocatable :: law_x(:) 

+     type(vector), allocatable :: law_y(:)  

+  end type motion

+

+contains

+

+

+  function get_displacement(mot,x1,x2)

+    use tools_math

+

+    type(vector) :: get_displacement

+    type(motion), intent(in) :: mot

+    real(kind(1.d0)), intent(in) :: x1, x2

+    !

+    integer :: i1, i2, i3, i4

+    type(vector) :: p1, p2, v_A, v_B, v_C, v_D

+    type(vector) :: i_trap_1, i_trap_2, i_trap_3

+

+    get_displacement = vector_(0.d0,0.d0,0.d0)

+    

+  end function get_displacement

+

+

+  function get_velocity(mot,x)

+    use tools_math

+

+    type(vector) :: get_velocity

+    type(motion), intent(in) :: mot

+    real(kind(1.d0)), intent(in) :: x

+    !

+    type(vector) :: v

+    

+    get_velocity = vector_(0.d0,0.d0,0.d0)

+    

+  end function get_velocity

+  

+  

+

+end module class_motion

+

+module class_bc_math

+  

+  implicit none

+

+  private 

+  public :: bc_math                           

+

+  type bc_math

+     private

+     integer :: id

+     integer :: nbf

+     real(kind(1.d0)), allocatable :: a(:) 

+     real(kind(1.d0)), allocatable :: b(:) 

+     real(kind(1.d0)), allocatable :: c(:) 

+  end type bc_math

+

+  

+end module class_bc_math

+

+module class_bc

+

+  use class_bc_math

+  use class_motion

+

+  implicit none

+

+  private 

+  public :: bc_poly                          

+  public :: get_abc, &

+       &    get_displacement, get_velocity  

+

+  type bc_poly

+     private

+     integer :: id

+     type(motion) :: mot

+     type(bc_math), pointer :: math => null()

+  end type bc_poly

+

+

+  interface get_displacement

+     module procedure get_displacement, get_bc_motion_displacement

+  end interface

+

+  interface get_velocity

+     module procedure get_velocity, get_bc_motion_velocity

+  end interface

+

+  interface get_abc

+     module procedure get_abc_s, get_abc_v

+  end interface

+  

+contains

+

+

+  subroutine get_abc_s(bc,dim,id,a,b,c)

+    use class_dimensions

+    

+    type(bc_poly), intent(in) :: bc

+    type(dimensions), intent(in) :: dim

+    integer, intent(out) :: id

+    real(kind(1.d0)), intent(inout) :: a(:)

+    real(kind(1.d0)), intent(inout) :: b(:)

+    real(kind(1.d0)), intent(inout) :: c(:)

+    

+    

+  end subroutine get_abc_s

+

+

+  subroutine get_abc_v(bc,dim,id,a,b,c)

+    use class_dimensions

+    use class_vector

+

+    type(bc_poly), intent(in) :: bc

+    type(dimensions), intent(in) :: dim

+    integer, intent(out) :: id

+    real(kind(1.d0)), intent(inout) :: a(:)

+    real(kind(1.d0)), intent(inout) :: b(:)

+    type(vector),     intent(inout) :: c(:)

+

+    

+  end subroutine get_abc_v

+

+

+

+  function get_bc_motion_displacement(bc,x1,x2)result(res)

+    use class_vector

+    type(vector) :: res

+    type(bc_poly), intent(in) :: bc

+    real(kind(1.d0)), intent(in) :: x1, x2

+    

+    res = get_displacement(bc%mot,x1,x2)

+

+  end function get_bc_motion_displacement

+

+

+  function get_bc_motion_velocity(bc,x)result(res)

+    use class_vector

+    type(vector) :: res

+    type(bc_poly), intent(in) :: bc

+    real(kind(1.d0)), intent(in) :: x

+

+    res = get_velocity(bc%mot,x)

+

+  end function get_bc_motion_velocity

+

+

+end module class_bc

+

+module tools_mesh_basics

+  

+  implicit none

+  

+  interface

+     function geom_tet_center(v1,v2,v3,v4)

+       use class_vector

+       type(vector) :: geom_tet_center

+       type(vector), intent(in) :: v1, v2, v3, v4

+     end function geom_tet_center

+  end interface

+

+

+end module tools_mesh_basics

+

+

+subroutine smooth_mesh

+

+  use class_bc

+  use class_vector

+  use tools_mesh_basics

+

+  implicit none

+

+  type(vector) :: new_pos  ! the new vertex position, after smoothing

+

+end subroutine smooth_mesh

+! { dg-final { cleanup-modules "class_vector class_dimensions tools_math" } }
+! { dg-final { cleanup-modules "class_motion class_bc_math class_bc tools_mesh_basics" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_23.f90 b/gcc/testsuite/gfortran.dg/used_types_23.f90
new file mode 100644
index 000000000..737422369
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_23.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! Tests the fix for PR37274 comment 4 in which the use associated 'vector' was

+! passed up from the interface to the module 'tools_math'.
+!
+! Contributed by Mikael Morin  <mikael.morin@tele2.fr>
+!
+module class_vector

+  implicit none

+  type vector

+  end type vector

+end module class_vector

+

+module tools_math

+  implicit none

+  interface lin_interp

+     function lin_interp_v()

+       use class_vector

+       type(vector) :: lin_interp_v

+     end function lin_interp_v

+  end interface

+end module tools_math

+

+module smooth_mesh

+  use tools_math

+  implicit none

+  type(vector ) :: new_pos  ! { dg-error "used before it is defined" }

+end module smooth_mesh

+

+! { dg-final { cleanup-modules "class_vector tools_math smooth_mesh" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_24.f90 b/gcc/testsuite/gfortran.dg/used_types_24.f90
new file mode 100644
index 000000000..44d2f5ec1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_24.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! Tests the fix for PR37794 a regression where a bit of redundant code caused an ICE.
+!
+! Contributed by Jonathan Hogg  <J.Hogg@rl.ac.uk>
+!
+module m1
+  implicit none
+
+  type of01_data_private
+    real :: foo
+  end type of01_data_private
+
+  type of01_data
+    type (of01_data_private) :: private
+  end type of01_data
+end module m1
+
+module m2
+  implicit none
+
+  type of01_data_private
+    integer :: youngest
+  end type of01_data_private
+end module m2
+
+module test_mod
+  use m1, of01_rdata => of01_data
+  use m2, of01_idata => of01_data ! { dg-error "not found in module" }
+
+  implicit none
+end module test_mod
+
+! { dg-final { cleanup-modules "m1 m2 test_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_3.f90 b/gcc/testsuite/gfortran.dg/used_types_3.f90
new file mode 100644
index 000000000..68d112bd2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_3.f90
@@ -0,0 +1,58 @@
+! { dg-do compile }
+! Test the fix for PR28601 in which line 55 would produce an ICE
+! because the rhs and lhs derived times were not identically
+! associated and so could not be cast.
+!
+! Contributed by Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+!
+module modA
+implicit none
+save
+private
+
+type, public :: typA
+integer :: i
+end type typA
+
+type, public :: atom
+type(typA), pointer :: ofTypA(:,:)
+end type atom
+end module modA
+
+!!! re-name and re-export typA as typB:
+module modB
+use modA, only: typB => typA
+implicit none
+save
+private
+
+public typB
+end module modB
+
+!!! mixed used of typA and typeB:
+module modC
+use modB
+implicit none
+save
+private
+contains
+
+subroutine buggy(a)
+use modA, only: atom
+! use modB, only: typB
+! use modA, only: typA
+implicit none
+type(atom),intent(inout) :: a
+target :: a
+! *** end of interface ***
+
+type(typB), pointer :: ofTypB(:,:)
+! type(typA), pointer :: ofTypB(:,:)
+integer :: i,j,k
+
+ofTypB => a%ofTypA
+
+a%ofTypA(i,j) = ofTypB(k,j)
+end subroutine buggy
+end module modC
+! { dg-final { cleanup-modules "modA modB modC" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_4.f90 b/gcc/testsuite/gfortran.dg/used_types_4.f90
new file mode 100644
index 000000000..a08fd0f73
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_4.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }

+! Tests the fix for PR28788, a regression in which an ICE was caused

+! by the failure of derived type association for the arguments of

+! InitRECFAST because the formal namespace derived types references

+! were not being reassociated to the module.

+!

+! Contributed by Martin Reinecke  <martin@mpa-garching.mpg.de>  

+! 

+module Precision

+  integer, parameter :: dl = KIND(1.d0)

+end module Precision

+

+module ModelParams

+  use precision

+  type CAMBparams

+    real(dl)::omegab,h0,tcmb,yhe

+  end type

+  type (CAMBparams) :: CP

+contains

+  subroutine CAMBParams_Set(P)

+    type(CAMBparams), intent(in) :: P

+  end subroutine CAMBParams_Set

+end module ModelParams

+

+module TimeSteps

+  use precision

+  use ModelParams

+end module TimeSteps

+

+module ThermoData

+  use TimeSteps

+contains

+  subroutine inithermo(taumin,taumax)

+    use precision

+    use ModelParams  ! Would ICE here

+    real(dl) taumin,taumax

+    call InitRECFAST(CP%omegab,CP%h0,CP%tcmb,CP%yhe)

+  end subroutine inithermo

+end module ThermoData

+! { dg-final { cleanup-modules "PRECISION ModelParams TimeSteps ThermoData" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_5.f90 b/gcc/testsuite/gfortran.dg/used_types_5.f90
new file mode 100644
index 000000000..427ede1ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_5.f90
@@ -0,0 +1,59 @@
+! { dg-do compile }
+! Tests the fix for a further regression caused by the
+! fix for PR28788, as noted in reply #9 in the Bugzilla
+! entry by Martin Reinecke <martin@mpa-garching.mpg.de>.
+! The problem was caused by certain types of references
+! that point to a deleted derived type symbol, after the
+! type has been associated to another namespace. An
+! example of this is the specification expression for x
+! in subroutine foo below.  At the same time, this tests
+! the correct association of typeaa between a module
+! procedure and a new definition of the type in MAIN.
+!
+module types
+
+  type :: typea
+    sequence
+    integer :: i
+  end type typea
+
+  type :: typeaa
+    sequence
+    integer :: i
+  end type typeaa
+
+  type(typea) :: it = typea(2)
+
+end module types
+!------------------------------
+module global
+
+  use types, only: typea, it
+
+contains
+
+  subroutine foo (x)
+    use types
+    type(typeaa) :: ca
+    real :: x(it%i)
+    common /c/ ca
+    x = 42.0
+    ca%i = 99
+  end subroutine foo
+
+end module global
+!------------------------------
+  use global, only: typea, foo
+  type :: typeaa
+    sequence
+    integer :: i
+  end type typeaa
+  type(typeaa) :: cam
+  real :: x(4)
+  common /c/ cam
+  x = -42.0
+  call foo(x)
+  if (any (x .ne. (/42.0, 42.0, -42.0, -42.0/))) call abort ()
+  if (cam%i .ne. 99) call abort ()
+end
+! { dg-final { cleanup-modules "types global" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_6.f90 b/gcc/testsuite/gfortran.dg/used_types_6.f90
new file mode 100644
index 000000000..52fa55460
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_6.f90
@@ -0,0 +1,37 @@
+! { dg-do compile }
+! Tests the fix for a further regression caused by the
+! fix for PR28788, as noted in reply #13 in the Bugzilla
+! entry by Martin Tee  <aovb94@dsl.pipex.com>.
+! The problem was caused by contained, use associated
+! derived types with pointer components of a derived type
+! use associated in a sibling procedure, where both are
+! associated by an ONLY clause. This is the reporter's
+! test case.
+!
+MODULE type_mod
+  TYPE a
+    INTEGER  :: n(10)
+  END TYPE a
+
+  TYPE b
+    TYPE (a), POINTER :: m(:) => NULL ()
+  END TYPE b
+END MODULE type_mod
+
+MODULE seg_mod
+CONTAINS
+  SUBROUTINE foo (x)
+    USE type_mod, ONLY : a     ! failed
+    IMPLICIT NONE
+    TYPE (a)  :: x
+    RETURN
+  END SUBROUTINE foo
+
+  SUBROUTINE bar (x)
+    USE type_mod, ONLY : b     ! failed
+    IMPLICIT NONE
+    TYPE (b)  :: x
+    RETURN
+  END SUBROUTINE bar
+END MODULE seg_mod
+! { dg-final { cleanup-modules "type_mod seg_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_7.f90 b/gcc/testsuite/gfortran.dg/used_types_7.f90
new file mode 100644
index 000000000..91354005d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_7.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! Tests the fix for a further regression caused by the
+! fix for PR28788 and posted as PR28908. The problem was
+! caused by the patch preventing interface derived types
+! from associating with identical derived types in the
+! containing namespaces.
+!
+! Contributed by HJ Lu  <hjl@lucon.org>
+!
+module bar
+  implicit none
+  public
+  type ESMF_Time
+    integer :: DD
+  end type
+end module bar
+
+module foo
+  use bar
+  implicit none
+  private
+  type ESMF_Clock
+    type(ESMF_Time)  :: CurrTime
+  end type
+  interface operator (+)
+    function add (x, y)
+      use bar
+      type(ESMF_Time) :: add
+      type(ESMF_Time), intent(in) :: x
+      type(ESMF_Time), intent(in) :: y
+    end function add
+  end interface
+contains
+  subroutine ESMF_ClockAdvance(clock)
+    type(ESMF_Clock), intent(inout) :: clock
+    clock%CurrTime = clock%CurrTime + clock%CurrTime
+  end subroutine ESMF_ClockAdvance
+end module foo
+! { dg-final { cleanup-modules "foo bar" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_8.f90 b/gcc/testsuite/gfortran.dg/used_types_8.f90
new file mode 100644
index 000000000..58d2084f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_8.f90
@@ -0,0 +1,46 @@
+! { dg-do compile }
+! Tests the fix for a further regression caused by the
+! fix for PR28788 and posted as PR28908. The problem was
+! caused by the patch preventing interface derived types
+! from associating with identical derived types in the
+! containing namespaces.
+!
+! Contributed by HJ Lu  <hjl@lucon.org>
+!
+module bar
+  implicit none
+  public
+  type ESMF_Time
+  sequence
+    integer :: MM
+  end type
+  public operator (+)
+  private add
+  interface operator (+)
+  module procedure add
+  end interface
+contains
+    function add (x, y)
+      type(ESMF_Time) :: add
+      type(ESMF_Time), intent(in) :: x
+      type(ESMF_Time), intent(in) :: y
+      add = x
+    end function add
+end module bar
+
+module foo
+  use bar
+  implicit none
+  private
+  type ESMF_Clock
+  sequence
+    type(ESMF_Time)  :: CurrTime
+  end type
+contains
+  subroutine ESMF_ClockAdvance(clock)
+  use bar
+    type(ESMF_Clock), intent(inout) :: clock
+    clock%CurrTime = clock%CurrTime + clock%CurrTime
+  end subroutine ESMF_ClockAdvance
+end module foo
+! { dg-final { cleanup-modules "foo bar" } }
diff --git a/gcc/testsuite/gfortran.dg/used_types_9.f90 b/gcc/testsuite/gfortran.dg/used_types_9.f90
new file mode 100644
index 000000000..fc09d155c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_9.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }

+! Tests the fix for a further regression caused by the

+! fix for PR28788 and posted as PR28908. The problem was

+! caused by the patch preventing interface derived types

+! from associating with identical derived types in the

+! containing namespaces.

+!

+! Contributed by HJ Lu  <hjl@lucon.org>

+!

+module bar

+  implicit none

+  public

+  type domain_ptr

+    type(domain), POINTER  :: ptr

+  end type domain_ptr

+  type domain

+    TYPE(domain_ptr) , DIMENSION( : ) , POINTER         :: parents

+    TYPE(domain_ptr) , DIMENSION( : ) , POINTER         :: nests

+  end type domain

+end module bar

+

+module foo

+contains

+  recursive subroutine integrate (grid)

+    use bar

+    implicit none

+    type(domain), POINTER  :: grid

+    interface

+      subroutine solve_interface (grid)

+        use bar

+        TYPE (domain) grid

+      end subroutine solve_interface

+    end interface

+  end subroutine integrate

+end module foo

+! { dg-final { cleanup-modules "foo bar" } }

diff --git a/gcc/testsuite/gfortran.dg/userdef_operator_1.f90 b/gcc/testsuite/gfortran.dg/userdef_operator_1.f90
new file mode 100644
index 000000000..e8af3720a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/userdef_operator_1.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! Testcase from PR 25396: User defined operators returning arrays.
+module geometry
+
+  implicit none
+
+  interface operator(.cross.)
+     module procedure cross
+  end interface
+
+contains
+
+    ! Cross product between two 3d vectors.
+    pure function cross(a, b)
+      real, dimension(3), intent(in) :: a,b
+      real, dimension(3) :: cross
+
+     cross = (/ a(2) * b(3) - a(3) * b(2), &
+           a(3) * b(1) - a(1) * b(3), &
+           a(1) * b(2) - a(2) * b(1) /)
+    end function cross
+
+end module geometry
+
+program opshape
+  use geometry
+
+  implicit none
+
+  real :: t(3,3), a
+
+  a = dot_product (t(:,1), t(:,2) .cross. t(:,3))
+
+end program opshape
+
+! { dg-final { cleanup-modules "geometry" } }
diff --git a/gcc/testsuite/gfortran.dg/userdef_operator_2.f90 b/gcc/testsuite/gfortran.dg/userdef_operator_2.f90
new file mode 100644
index 000000000..83392c6b6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/userdef_operator_2.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! PR 45338 - no ICE when cmp is not used explicitly.
+! Test case by Simon Smart 
+module test_mod
+  implicit none
+contains
+  subroutine test_fn (cmp)
+    interface operator(.myop.)
+       pure function cmp (a, b) result(ret)
+         integer, intent(in) :: a, b
+         logical ret
+       end function cmp
+    end interface
+    integer :: a, b
+    print*, a .myop. b
+  end subroutine test_fn
+end module test_mod
diff --git a/gcc/testsuite/gfortran.dg/utf8_1.f03 b/gcc/testsuite/gfortran.dg/utf8_1.f03
new file mode 100644
index 000000000..c07a6b85a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/utf8_1.f03
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program test1
+  implicit none
+  integer, parameter :: k4 = 4
+  character(kind=4, len=30) :: string1, string2
+  character(kind=1, len=30) :: string3
+  string1 = k4_"This is Greek:  \u039f\u03cd\u03c7\u03af"
+  string2 = k4_"Jerry in Japanese is:    \u30b8\u30a8\u30ea\u30fc"
+  open(10, encoding="utf-8", status="scratch")
+  write(10,'(a)') trim(string1)
+  write(10,*) string2
+  rewind(10)
+  string1 = k4_""
+  string2 = k4_""
+  string3 = "abcdefghijklmnopqrstuvwxyz"
+  read(10,'(a)') string1
+  read(10,'(a)') string2
+  if (string1 /= k4_"This is Greek:  \u039f\u03cd\u03c7\u03af") call abort
+  if (len(trim(string1)) /= 20) call abort
+  if (string2 /= k4_" Jerry in Japanese is:    \u30b8\u30a8\u30ea\u30fc")&
+  &  call abort
+  if (len(string2) /= 30) call abort
+  rewind(10)
+  read(10,'(a)') string3
+  if (string3 /= "This is Greek:  ????") call abort
+end program test1
+! The following examples require UTF-8 enabled editor to see correctly.
+! ジエリー  Sample of Japanese characters.
+! Ο�χὶ    Sample of Greek characters.
diff --git a/gcc/testsuite/gfortran.dg/utf8_2.f03 b/gcc/testsuite/gfortran.dg/utf8_2.f03
new file mode 100644
index 000000000..0146a2e28
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/utf8_2.f03
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+! Contributed by Tobias Burnus
+program test2
+  integer,parameter :: ucs4 = selected_char_kind("iso_10646")
+  character(1,ucs4),parameter :: nen=char(int(z'5e74'),ucs4), & !year
+    gatsu=char(int(z'6708'),kind=ucs4), & !month
+    nichi=char(int(z'65e5'),kind=ucs4) !day
+  character(25,ucs4) :: string
+  open(10, encoding="utf-8", status="scratch")
+  write(10,1) 2008,nen,8,gatsu,10,nichi
+1 format(i0,a,i0,a,i0,a)
+  rewind(10)
+  read(10,'(a)') string
+  if (string /= ucs4_"2008\u5e748\u670810\u65e5") call abort
+end program test2
diff --git a/gcc/testsuite/gfortran.dg/value_1.f90 b/gcc/testsuite/gfortran.dg/value_1.f90
new file mode 100644
index 000000000..526a028ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_1.f90
@@ -0,0 +1,84 @@
+! { dg-do run }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+! Tests the functionality of the patch for PR29642, which requested the
+! implementation of the F2003 VALUE attribute for gfortran.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org> 
+!
+module global
+  type :: mytype
+    real(4) :: x
+    character(4) :: c
+  end type mytype
+contains
+  subroutine typhoo (dt)
+    type(mytype), value :: dt
+    if (dtne (dt, mytype (42.0, "lmno"))) call abort ()
+    dt = mytype (21.0, "wxyz")
+    if (dtne (dt, mytype (21.0, "wxyz"))) call abort ()
+  end subroutine typhoo
+
+  logical function dtne (a, b)
+    type(mytype) :: a, b
+    dtne = .FALSE.
+    if ((a%x /= b%x) .or. (a%c /= b%c)) dtne = .TRUE.
+  end function dtne
+end module global
+
+program test_value
+  use global
+  integer(8) :: i = 42
+  real(8) :: r = 42.0
+  character(2) ::   c = "ab"
+  complex(8) :: z = (-99.0, 199.0)
+  type(mytype) :: dt = mytype (42.0, "lmno")
+
+  call foo (c)
+  if (c /= "ab") call abort ()
+
+  call bar (i)
+  if (i /= 42) call abort ()
+
+  call foobar (r)
+  if (r /= 42.0) call abort ()
+
+  call complex_foo (z)
+  if (z /= (-99.0, 199.0)) call abort ()
+
+  call typhoo (dt)
+  if (dtne (dt, mytype (42.0, "lmno"))) call abort ()
+
+  r = 20.0
+  call foobar (r*2.0 + 2.0)
+
+contains
+  subroutine foo (c)
+    character(2), value :: c
+    if (c /= "ab") call abort ()
+    c = "cd"
+    if (c /= "cd") call abort ()
+  end subroutine foo
+
+  subroutine bar (i)
+    integer(8), value :: i
+    if (i /= 42) call abort ()
+    i = 99
+    if (i /= 99) call abort ()
+  end subroutine bar
+
+  subroutine foobar (r)
+    real(8), value :: r
+    if (r /= 42.0) call abort ()
+    r = 99.0
+    if (r /= 99.0) call abort ()
+  end subroutine foobar
+
+  subroutine complex_foo (z)
+    COMPLEX(8), value :: z
+    if (z /= (-99.0, 199.0)) call abort ()
+    z = (77.0, -42.0)
+    if (z /= (77.0, -42.0)) call abort ()
+  end subroutine complex_foo
+
+end program test_value
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/value_2.f90 b/gcc/testsuite/gfortran.dg/value_2.f90
new file mode 100644
index 000000000..d25683c2e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_2.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+! Tests the standard check in the patch for PR29642, which requested the
+! implementation of the F2003 VALUE attribute for gfortran.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org> 
+!
+program test_value
+  integer(8) :: i = 42
+
+  call bar (i)
+  if (i /= 42) call abort ()
+contains
+  subroutine bar (i)
+    integer(8) :: i
+    value :: i      ! { dg-error "Fortran 2003: VALUE" }
+    if (i /= 42) call abort ()
+    i = 99
+    if (i /= 99) call abort ()
+  end subroutine bar
+end program test_value
diff --git a/gcc/testsuite/gfortran.dg/value_3.f90 b/gcc/testsuite/gfortran.dg/value_3.f90
new file mode 100644
index 000000000..c5d2d1f27
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_3.f90
@@ -0,0 +1,53 @@
+! { dg-do compile }
+! Tests the constraints in the patch for PR29642, which requested the
+! implementation of the F2003 VALUE attribute for gfortran.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org> 
+!
+program test_value
+  integer(8) :: i = 42, j   ! { dg-error "not a dummy" }
+  integer(8), value :: k    ! { dg-error "not a dummy" }
+  value :: j
+
+contains
+  subroutine bar_1 (i)
+    integer(8) :: i
+    dimension i(8)
+    value :: i  ! { dg-error "conflicts with DIMENSION" }
+    i = 0
+  end subroutine bar_1
+
+  subroutine bar_2 (i)
+    integer(8) :: i
+    pointer :: i
+    value :: i  ! { dg-error "conflicts with POINTER" }
+    i = 0
+  end subroutine bar_2
+
+  integer function bar_3 (i)
+    integer(8) :: i
+    dimension i(8)
+    value :: bar_3  ! { dg-error "conflicts with FUNCTION" }
+    i = 0
+    bar_3 = 0
+  end function bar_3
+
+  subroutine bar_4 (i, j)
+    integer(8), intent(inout) :: i
+    integer(8), intent(out) :: j
+    value :: i  ! { dg-error "conflicts with INTENT" }
+    value :: j  ! { dg-error "conflicts with INTENT" }
+    i = 0
+    j = 0
+  end subroutine bar_4
+
+  integer function bar_5 ()
+    integer(8) :: i
+    external :: i
+    integer, parameter :: j = 99
+    value :: i  ! { dg-error "conflicts with EXTERNAL" }
+    value :: j  ! { dg-error "PARAMETER attribute conflicts with" }
+    bar_5 = 0
+  end function bar_5
+
+end program test_value
diff --git a/gcc/testsuite/gfortran.dg/value_4.c b/gcc/testsuite/gfortran.dg/value_4.c
new file mode 100644
index 000000000..a9f9aae23
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_4.c
@@ -0,0 +1,49 @@
+/*  Passing from fortran to C by value, using VALUE.  This is identical
+    to c_by_val_1.c, which performs the same function for %VAL.
+
+    Contributed by Paul Thomas <pault@gcc.gnu.org>  */
+
+/* We used to #include <complex.h>, but this fails for some platforms
+   (like cygwin) who don't have it yet.  */
+#define complex __complex__
+#define _Complex_I (1.0iF)
+
+extern float *f_to_f__ (float, float*);
+extern int *i_to_i__ (int, int*);
+extern void c_to_c__ (complex float*, complex float, complex float*);
+extern void abort (void);
+
+/* In f_to_f and i_to_i we return the second argument, so that we do
+   not have to worry about keeping track of memory allocation between
+   fortran and C.  All three functions check that the argument passed
+   by value is the same as that passed by reference.  Then the passed
+   by value argument is modified so that the caller can check that
+   its version has not changed.*/
+
+float *
+f_to_f__(float a1, float *a2)
+{
+  if ( a1 != *a2 ) abort();
+  *a2 = a1 * 2.0;
+  a1 = 0.0;
+  return a2;
+}
+
+int *
+i_to_i__(int i1, int *i2)
+{
+  if ( i1 != *i2 ) abort();
+  *i2 = i1 * 3;
+  i1 = 0;
+  return i2;
+}
+
+void
+c_to_c__(complex float *retval, complex float c1, complex float *c2)
+{
+  if ( c1 != *c2 ) abort();
+  c1 = 0.0 + 0.0 * _Complex_I;
+  *retval = *c2 * 4.0;
+  return;
+}
+
diff --git a/gcc/testsuite/gfortran.dg/value_4.f90 b/gcc/testsuite/gfortran.dg/value_4.f90
new file mode 100644
index 000000000..718f9ae5c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_4.f90
@@ -0,0 +1,84 @@
+! { dg-do run }
+! { dg-additional-sources value_4.c }
+! { dg-options "-ff2c -w -O0" }
+!
+! Tests the functionality of the patch for PR29642, which requested the
+! implementation of the F2003 VALUE attribute for gfortran, by calling
+! external C functions by value and by reference.  This is effectively
+! identical to c_by_val_1.f, which does the same for %VAL.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org> 
+!
+module global
+  interface delta
+    module procedure deltai, deltar, deltac
+  end interface delta
+  real(4) :: epsi = epsilon (1.0_4)
+contains
+  function deltai (a, b) result (c)
+    integer(4) :: a, b
+    logical :: c
+    c = (a /= b)
+  end function deltai
+
+  function deltar (a, b) result (c)
+    real(4) :: a, b
+    logical :: c
+    c = (abs (a-b) > epsi)
+  end function deltar
+
+  function deltac (a, b) result (c)
+    complex(4) :: a, b
+    logical :: c
+    c = ((abs (real (a-b)) > epsi).or.(abs (aimag (a-b)) > epsi))
+  end function deltac
+end module global  
+
+program value_4
+  use global
+  interface
+    function f_to_f (x, y)
+      real(4), pointer :: f_to_f
+      real(4) :: x, y
+      value :: x
+    end function f_to_f
+  end interface
+
+  interface
+    function i_to_i (x, y)
+      integer(4), pointer :: i_to_i
+      integer(4) :: x, y
+      value :: x
+    end function i_to_i
+  end interface
+
+  interface
+    complex(4) function c_to_c (x, y)
+      complex(4) :: x, y
+      value :: x
+    end function c_to_c
+  end interface
+
+  real(4)       a, b, c
+  integer(4)    i, j, k
+  complex(4)    u, v, w
+
+  a = 42.0
+  b = 0.0
+  c = a
+  b = f_to_f (a, c)
+  if (delta ((2.0 * a), b)) call abort ()
+
+  i = 99
+  j = 0
+  k = i
+  j = i_to_i (i, k)
+  if (delta ((3_4 * i), j)) call abort ()
+
+  u = (-1.0, 2.0)
+  v = (1.0, -2.0)
+  w = u
+  v = c_to_c (u, w)
+  if (delta ((4.0 * u), v)) call abort ()
+end program value_4
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/value_5.f90 b/gcc/testsuite/gfortran.dg/value_5.f90
new file mode 100644
index 000000000..4b0dcefb3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_5.f90
@@ -0,0 +1,68 @@
+! { dg-do compile }
+! Length of character dummy variable with VALUE attribute:
+! - must be initialization expression or omitted
+! - C interoperable: must be initialization expression of length one
+!   or omitted
+!
+! Contributed by Tobias Burnus
+program x
+  implicit none
+  character(10) :: c1,c10
+  c1  = 'H'
+  c10 = 'Main'
+  call foo1(c1)
+  call foo2(c1)
+  call foo3(c10)
+  call foo4(c10)
+  call bar1(c1)
+  call bar2(c1)
+  call bar3(c10)
+  call bar4(c10)
+
+contains
+
+  subroutine foo1(a)
+    character :: a
+    value :: a
+  end subroutine foo1
+
+  subroutine foo2(a)
+    character(1) :: a
+    value :: a
+  end subroutine foo2
+
+  subroutine foo3(a)
+    character(10) :: a
+    value :: a
+  end subroutine foo3
+
+  subroutine foo4(a) ! { dg-error "VALUE attribute must have constant length" }
+    character(*) :: a
+    value :: a
+  end subroutine foo4
+
+  subroutine bar1(a)
+    use iso_c_binding, only: c_char
+    character(kind=c_char) :: a
+    value :: a
+  end subroutine bar1
+
+  subroutine bar2(a)
+    use iso_c_binding, only: c_char
+    !character(kind=c_char,len=1) :: a
+    character(1,kind=c_char) :: a
+    value :: a
+  end subroutine bar2
+
+  subroutine bar3(a) ! { dg-error "VALUE attribute must have length one" }
+    use iso_c_binding, only: c_char
+    character(kind=c_char,len=10) :: a
+    value :: a
+  end subroutine bar3
+
+  subroutine bar4(a) ! { dg-error "VALUE attribute must have constant length" }
+    use iso_c_binding, only: c_char
+    character(kind=c_char,len=*) :: a
+    value :: a
+  end subroutine bar4
+end program x
diff --git a/gcc/testsuite/gfortran.dg/value_6.f03 b/gcc/testsuite/gfortran.dg/value_6.f03
new file mode 100644
index 000000000..0650d3295
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_6.f03
@@ -0,0 +1,25 @@
+! { dg-do run }
+! Verify by-value passing of character arguments w/in Fortran to a bind(c) 
+! procedure.  
+! PR fortran/32732
+module pr32732
+  use, intrinsic :: iso_c_binding, only: c_char
+  implicit none
+contains
+  subroutine test(a) bind(c)
+    character(kind=c_char), value :: a
+    call test2(a)
+  end subroutine test
+  subroutine test2(a) bind(c)
+    character(kind=c_char), value :: a
+    if(a /= c_char_'a') call abort ()
+    print *, 'a=',a
+  end subroutine test2
+end module pr32732
+
+program main
+  use pr32732
+  implicit none
+  call test('a')
+end program main
+! { dg-final { cleanup-modules "pr32732" } }
diff --git a/gcc/testsuite/gfortran.dg/value_7.f03 b/gcc/testsuite/gfortran.dg/value_7.f03
new file mode 100644
index 000000000..24395778e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_7.f03
@@ -0,0 +1,22 @@
+! { dg-do run }
+! Test passing character strings by-value.
+! PR fortran/32732
+program test
+  implicit none
+  character(len=13) :: chr
+  chr =  'Fortran       '
+  call sub1(chr)
+  if(chr /= 'Fortran       ') call abort()
+contains
+  subroutine sub1(a)
+    character(len=13), VALUE :: a
+    a = trim(a)//" rules"
+    call sub2(a)        
+  end subroutine sub1
+  subroutine sub2(a)
+    character(len=13), VALUE :: a
+    print *, a          
+    if(a /= 'Fortran rules') call abort()
+  end subroutine sub2
+end program test
+
diff --git a/gcc/testsuite/gfortran.dg/value_test.f90 b/gcc/testsuite/gfortran.dg/value_test.f90
new file mode 100644
index 000000000..12313324c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_test.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+program valueTests
+  integer :: myInt
+  interface
+     subroutine mySub(myInt)
+       integer, value :: myInt
+     end subroutine mySub
+  end interface
+
+  myInt = 10
+
+  call mySub(myInt)
+  ! myInt should be unchanged since pass-by-value
+  if(myInt .ne. 10) then
+     call abort ()
+  endif
+end program valueTests
+
+subroutine mySub(myInt)
+  integer, value :: myInt
+  myInt = 11
+end subroutine mySub
+  
diff --git a/gcc/testsuite/gfortran.dg/value_tests_f03.f90 b/gcc/testsuite/gfortran.dg/value_tests_f03.f90
new file mode 100644
index 000000000..652517361
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/value_tests_f03.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+program value_tests_f03
+  use, intrinsic :: iso_c_binding
+  real(c_double) :: myDouble
+  interface
+     subroutine value_test(myDouble) bind(c)
+       use, intrinsic :: iso_c_binding
+       real(c_double), value :: myDouble
+     end subroutine value_test
+  end interface
+
+  myDouble = 9.0d0
+  call value_test(myDouble)
+end program value_tests_f03
+
+subroutine value_test(myDouble) bind(c)
+  use, intrinsic :: iso_c_binding
+  real(c_double), value :: myDouble
+  interface
+     subroutine mySub(myDouble)
+       use, intrinsic :: iso_c_binding
+       real(c_double), value :: myDouble
+     end subroutine mySub
+  end interface
+
+  myDouble = 10.0d0
+
+  call mySub(myDouble)
+end subroutine value_test
+
+subroutine mySub(myDouble)
+  use, intrinsic :: iso_c_binding
+  real(c_double), value :: myDouble
+  
+  myDouble = 11.0d0
+end subroutine mySub
+  
diff --git a/gcc/testsuite/gfortran.dg/vect/O3-pr36119.f90 b/gcc/testsuite/gfortran.dg/vect/O3-pr36119.f90
new file mode 100644
index 000000000..432e8485a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/O3-pr36119.f90
@@ -0,0 +1,28 @@
+! { dg-do compile } 
+
+SUBROUTINE check_dnucint_ana (dcore)
+  IMPLICIT NONE
+  INTEGER, PARAMETER :: dp=8
+  REAL(dp), DIMENSION(10, 2), INTENT(IN),&
+       OPTIONAL                            :: dcore
+  INTEGER                                  :: i, j
+  REAL(dp)                                 :: delta, nssss, od, rn, ssssm, &
+       ssssp
+  REAL(dp), DIMENSION(10, 2)               :: corem, corep, ncore
+  LOGICAL                                  :: check_value
+
+  delta = 1.0E-8_dp
+  od = 0.5_dp/delta
+  ncore = od * (corep - corem)
+  nssss = od * (ssssp - ssssm)
+  IF (PRESENT(dcore)) THEN
+     DO i = 1, 2
+        DO j = 1, 10
+           IF (.NOT.check_value(ncore(j,i), dcore(j,i), delta, 0.1_dp)) THEN
+           END IF
+        END DO
+     END DO
+  END IF
+END SUBROUTINE check_dnucint_ana
+
+! { dg-final { cleanup-tree-dump "vect" } } 
diff --git a/gcc/testsuite/gfortran.dg/vect/O3-pr39595.f b/gcc/testsuite/gfortran.dg/vect/O3-pr39595.f
new file mode 100644
index 000000000..021d35b90
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/O3-pr39595.f
@@ -0,0 +1,17 @@
+! { dg-do compile }
+      subroutine foo(a,c,i,m)
+      real a(4,*),b(3,64),c(3,200),d(64)
+      integer*8 i,j,k,l,m
+      do j=1,m,64
+        do k=1,m-j+1
+          d(k)=a(4,j-1+k)
+          do l=1,3
+            b(l,k)=c(l,i)+a(l,j-1+k)
+          end do
+        end do
+        call bar(b,d,i)
+      end do
+      end
+
+! { dg-final { cleanup-tree-dump "vect" } }
+
diff --git a/gcc/testsuite/gfortran.dg/vect/cost-model-pr34445.f b/gcc/testsuite/gfortran.dg/vect/cost-model-pr34445.f
new file mode 100644
index 000000000..6e4a26248
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/cost-model-pr34445.f
@@ -0,0 +1,9 @@
+c { dg-do compile }
+      Subroutine FndSph(Alpha,Rad)
+      Dimension Rad(100),RadInp(100)
+      Do I = 1, NSphInp
+        Rad(I) = RadInp(I)
+        Alpha = 1.2
+      End Do
+      End
+c { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/cost-model-pr34445a.f b/gcc/testsuite/gfortran.dg/vect/cost-model-pr34445a.f
new file mode 100644
index 000000000..aca68bb20
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/cost-model-pr34445a.f
@@ -0,0 +1,29 @@
+c { dg-do compile }
+      subroutine derv (xx,b,bv,det,r,s,t,ndopt,cosxy,thick,edis,
+     1                  vni,vnt)
+      implicit real*8 (a-h,o-z)
+      save
+c
+      common /shell1/ disd(9),ield,ielp,npt,idw,ndrot
+      common /shell4/xji(3,3),p(3,32),h(32)
+c
+      dimension xx(3,*),ndopt(*),bv(*),vni(*),cosxy(6,*),vnt(*),
+     1          edis(*),thick(*),b(*)
+c
+      kk=0
+      k2=0
+      do 130 k=1,ield
+      k2=k2 + 3
+      if (ndopt(k)) 127,127,130
+  127 kk=kk + 1
+      do 125 i=1,3
+      b(k2+i)=b(k2+i) + (xji(i,1)*p(1,k) + xji(i,2)*p(2,k))*t
+     1         + xji(i,3)*h(k)
+      th=0.5*thick(kk)
+      b(k2+i+3)=b(k2+i+3) - th*cosxy(i+3,kk)
+  125 b(k2+i+6)=b(k2+i+6) + th*cosxy(i,kk)
+      k2=k2 + 9
+  130 continue
+      return
+      end
+c { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/fast-math-mgrid-resid.f b/gcc/testsuite/gfortran.dg/vect/fast-math-mgrid-resid.f
new file mode 100644
index 000000000..8f196a69a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/fast-math-mgrid-resid.f
@@ -0,0 +1,46 @@
+! { dg-do compile { target i?86-*-* x86_64-*-* } }
+! { dg-require-effective-target vect_double }
+! { dg-require-effective-target sse2 }
+! { dg-options "-O3 -ffast-math -msse2 -fpredictive-commoning -ftree-vectorize -fdump-tree-optimized" }
+
+
+******* RESID COMPUTES THE RESIDUAL:  R = V - AU
+*
+*      THIS SIMPLE IMPLEMENTATION COSTS  27A + 4M PER RESULT, WHERE
+*      A AND M DENOTE THE COSTS OF ADDITION (OR SUBTRACTION) AND 
+*      MULTIPLICATION, RESPECTIVELY.  BY USING SEVERAL TWO-DIMENSIONAL 
+*      BUFFERS ONE CAN REDUCE THIS COST TO  13A + 4M IN THE GENERAL 
+*      CASE, OR  10A + 3M WHEN THE COEFFICIENT A(1) IS ZERO.
+*
+      SUBROUTINE RESID(U,V,R,N,A)
+      INTEGER N
+      REAL*8 U(N,N,N),V(N,N,N),R(N,N,N),A(0:3)
+      INTEGER I3, I2, I1
+C
+      DO 600 I3=2,N-1
+      DO 600 I2=2,N-1
+      DO 600 I1=2,N-1
+ 600  R(I1,I2,I3)=V(I1,I2,I3)
+     >      -A(0)*( U(I1,  I2,  I3  ) )
+     >      -A(1)*( U(I1-1,I2,  I3  ) + U(I1+1,I2,  I3  )
+     >                 +  U(I1,  I2-1,I3  ) + U(I1,  I2+1,I3  )
+     >                 +  U(I1,  I2,  I3-1) + U(I1,  I2,  I3+1) )
+     >      -A(2)*( U(I1-1,I2-1,I3  ) + U(I1+1,I2-1,I3  )
+     >                 +  U(I1-1,I2+1,I3  ) + U(I1+1,I2+1,I3  )
+     >                 +  U(I1,  I2-1,I3-1) + U(I1,  I2+1,I3-1)
+     >                 +  U(I1,  I2-1,I3+1) + U(I1,  I2+1,I3+1)
+     >                 +  U(I1-1,I2,  I3-1) + U(I1-1,I2,  I3+1)
+     >                 +  U(I1+1,I2,  I3-1) + U(I1+1,I2,  I3+1) )
+     >      -A(3)*( U(I1-1,I2-1,I3-1) + U(I1+1,I2-1,I3-1)
+     >                 +  U(I1-1,I2+1,I3-1) + U(I1+1,I2+1,I3-1)
+     >                 +  U(I1-1,I2-1,I3+1) + U(I1+1,I2-1,I3+1)
+     >                 +  U(I1-1,I2+1,I3+1) + U(I1+1,I2+1,I3+1) )
+C
+      RETURN
+      END
+! we want to check that predictive commoning did something on the
+! vectorized loop, which means we have to have exactly 13 vector
+! additions.
+! { dg-final { scan-tree-dump-times "vect_var\[^\\n\]*\\+ " 13 "optimized" } }
+! { dg-final { cleanup-tree-dump "vect" } }
+! { dg-final { cleanup-tree-dump "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/fast-math-pr33299.f90 b/gcc/testsuite/gfortran.dg/vect/fast-math-pr33299.f90
new file mode 100644
index 000000000..1de184dba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/fast-math-pr33299.f90
@@ -0,0 +1,17 @@
+! { dg-require-effective-target vect_double }
+
+PROGRAM test
+  REAL(8) :: f,dist(2)
+  dist = [1.0_8, 0.5_8]
+  if( f(1.0_8, dist) /= MINVAL(dist)) then
+    call abort ()
+  endif
+END PROGRAM test
+
+FUNCTION f( x, dist ) RESULT(s)
+  REAL(8) :: dist(2), x, s
+  s = MINVAL(dist)
+  IF( x < 0 ) s = -s
+END FUNCTION f
+
+! { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/fast-math-pr38968.f90 b/gcc/testsuite/gfortran.dg/vect/fast-math-pr38968.f90
new file mode 100644
index 000000000..bfad470f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/fast-math-pr38968.f90
@@ -0,0 +1,28 @@
+! Skip this on platforms that don't have the vectorization instructions
+! to handle complex types.  This test is very slow on these platforms so
+! skipping is better then running it unvectorized.
+! { dg-skip-if "" { ia64-*-* sparc*-*-* } { "*" } { "" } }
+! It can be slow on some x86 CPUs.
+! { dg-timeout-factor 2 }
+program mymatmul
+  implicit none
+  integer, parameter :: kp = 4
+  integer, parameter :: n = 2000
+  real(kp), dimension(n,n) :: rr, ri
+  complex(kp), dimension(n,n) :: a,b,c
+  real :: t1, t2
+  integer :: i, j, k
+  common // a,b,c
+
+  do j = 1, n
+     do k = 1, n
+        do i = 1, n
+           c(i,j) = c(i,j) + a(i,k) * b(k,j)
+        end do
+     end do
+  end do
+
+end program mymatmul
+
+! { dg-final { scan-tree-dump "vectorized 1 loops" "vect" } }
+! { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/fast-math-real8-pr40801.f90 b/gcc/testsuite/gfortran.dg/vect/fast-math-real8-pr40801.f90
new file mode 100644
index 000000000..2d4018049
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/fast-math-real8-pr40801.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+
+MODULE YOMPHY0
+REAL :: ECMNP
+REAL :: SCO
+REAL :: USDMLT
+END MODULE YOMPHY0
+SUBROUTINE ACCONV ( KIDIA,KFDIA,KLON,KTDIA,KLEV,&
+                    &CDLOCK)
+USE YOMPHY0  , ONLY : ECMNP    ,SCO      ,USDMLT
+REAL :: PAPHIF(KLON,KLEV),PCVGQ(KLON,KLEV)&
+    &,PFPLCL(KLON,0:KLEV),PFPLCN(KLON,0:KLEV),PSTRCU(KLON,0:KLEV)&
+    &,PSTRCV(KLON,0:KLEV)
+INTEGER :: KNLAB(KLON,KLEV),KNND(KLON)
+REAL :: ZCP(KLON,KLEV),ZLHE(KLON,KLEV),ZDSE(KLON,KLEV)&
+    &,ZPOII(KLON),ZALF(KLON),ZLN(KLON),ZUN(KLON),ZVN(KLON)&
+    &,ZPOIL(KLON)
+DO JLEV=KLEV-1,KTDIA,-1
+  DO JIT=1,NBITER
+    ZLN(JLON)=MAX(0.,ZLN(JLON)&
+     &-(ZQW(JLON,JLEV)-ZQN(JLON)&
+     &*(PQ(JLON,JLEV+1)-ZQN(JLON))))*KNLAB(JLON,JLEV)
+  ENDDO
+ENDDO
+IF (ITOP < KLEV+1) THEN
+  DO JLON=KIDIA,KFDIA
+    ZZVAL=PFPLCL(JLON,KLEV)+PFPLCN(JLON,KLEV)-SCO
+    KNND(JLON)=KNND(JLON)*MAX(0.,-SIGN(1.,0.-ZZVAL))
+  ENDDO
+  DO JLEV=ITOP,KLEV
+    DO JLON=KIDIA,KFDIA
+    ENDDO
+  ENDDO
+ENDIF
+END SUBROUTINE ACCONV
+
+! { dg-final { cleanup-tree-dump "vect" } }
+! { dg-final { cleanup-modules "yomphy0" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/fast-math-vect-8.f90 b/gcc/testsuite/gfortran.dg/vect/fast-math-vect-8.f90
new file mode 100644
index 000000000..26d850de9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/fast-math-vect-8.f90
@@ -0,0 +1,94 @@
+! { dg-do compile } 
+! { dg-require-effective-target vect_float } 
+
+module solv_cap
+
+  implicit none
+
+  public  :: init_solve
+
+  integer, parameter, public :: dp = 4
+
+  real(kind=dp), private :: Pi, Mu0, c0, eps0
+  logical,       private :: UseFFT, UsePreco
+  real(kind=dp), private :: D1, D2
+  integer,       private, save :: Ng1=0, Ng2=0
+  integer,       private, pointer,     dimension(:,:)  :: Grid
+  real(kind=dp), private, allocatable, dimension(:,:)  :: G
+
+contains
+
+  subroutine init_solve(Grid_in, GrSize1, GrSize2, UseFFT_in, UsePreco_in)
+    integer, intent(in), target, dimension(:,:) :: Grid_in
+    real(kind=dp), intent(in)  :: GrSize1, GrSize2
+    logical,       intent(in)  :: UseFFT_in, UsePreco_in
+    integer                    :: i, j
+
+    Pi = acos(-1.0_dp)
+    Mu0 = 4e-7_dp * Pi
+    c0 = 299792458
+    eps0 = 1 / (Mu0 * c0**2)
+
+    UseFFT = UseFFT_in
+    UsePreco = UsePreco_in
+
+    if(Ng1 /= 0 .and. allocated(G) ) then
+      deallocate( G )
+    end if
+
+    Grid => Grid_in
+    Ng1 = size(Grid, 1)
+    Ng2 = size(Grid, 2)
+    D1 = GrSize1/Ng1
+    D2 = GrSize2/Ng2
+
+    allocate( G(0:Ng1,0:Ng2) )
+
+    write(unit=*, fmt=*) "Calculating G"
+    do i=0,Ng1
+      do j=0,Ng2
+        G(j,i) = Ginteg( -D1/2,-D2/2, D1/2,D2/2, i*D1,j*D2 )
+      end do
+    end do
+
+    if(UseFFT) then
+      write(unit=*, fmt=*) "Transforming G"
+      call FourirG(G,1)
+    end if
+
+    return
+
+
+  contains
+  function Ginteg(xq1,yq1, xq2,yq2, xp,yp)  result(G)
+    real(kind=dp), intent(in) :: xq1,yq1, xq2,yq2, xp,yp
+    real(kind=dp)             :: G
+    real(kind=dp)             :: x1,x2,y1,y2,t
+    x1 = xq1-xp
+    x2 = xq2-xp
+    y1 = yq1-yp
+    y2 = yq2-yp
+
+    if (x1+x2 < 0) then
+      t = -x1
+      x1 = -x2
+      x2 = t
+    end if
+    if (y1+y2 < 0) then
+      t = -y1
+      y1 = -y2
+      y2 = t
+    end if
+
+    G = (x2*y2)-(x1*y2)-(x2*y1)+(x1*y1)
+
+    return
+  end function Ginteg
+
+  end subroutine init_solve
+
+end module solv_cap
+
+
+! { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target vect_intfloat_cvt } } }
+! { dg-final { cleanup-tree-dump "vect" } } 
diff --git a/gcc/testsuite/gfortran.dg/vect/no-vfa-pr32377.f90 b/gcc/testsuite/gfortran.dg/vect/no-vfa-pr32377.f90
new file mode 100644
index 000000000..ce4a47afd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/no-vfa-pr32377.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-require-effective-target vect_float }
+
+subroutine s243(ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc)
+      
+integer ntimes,ld,n,i,nl
+real a(n),b(n),c(n),d(n),e(n),aa(ld,n),bb(ld,n),cc(ld,n)
+real t1,t2,chksum,ctime,dtime,cs1d
+  b(:n-1)= b(:n-1)+(c(:n-1)+e(:n-1))*d(:n-1)
+  a(:n-1)= b(:n-1)+a(2:n)*d(:n-1)
+  return
+end
+
+! { dg-final { scan-tree-dump-times "vectorized 2 loops" 1 "vect"   } }
+! { dg-final { cleanup-tree-dump "vect" } }
+
diff --git a/gcc/testsuite/gfortran.dg/vect/no-vfa-pr32457.f90 b/gcc/testsuite/gfortran.dg/vect/no-vfa-pr32457.f90
new file mode 100644
index 000000000..07a2b6056
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/no-vfa-pr32457.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-require-effective-target vect_float }
+
+SUBROUTINE KEEL(RBOUND)
+  REAL, DIMENSION(0:100) :: RBOUND
+  DO N = 1, NP1
+     RBOUND(N) = RBOUND(N-1) + 1
+  END DO
+  DO N = 1, NS
+     WRITE (16,'(I5)') SRAD(N)
+  END DO
+END SUBROUTINE KEEL
+
+! { dg-final { scan-tree-dump-times "vectorized 0 loops" 1 "vect" } }
+! { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/pr19049.f90 b/gcc/testsuite/gfortran.dg/vect/pr19049.f90
new file mode 100644
index 000000000..6c8030cce
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/pr19049.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-require-effective-target vect_float }
+
+subroutine s111 (ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc) 
+!     linear dependence testing
+!     no dependence - vectorizable
+!     but not consecutive access
+
+      integer ntimes, ld, n, i, nl
+      real a(n), b(n), c(n), d(n), e(n), aa(ld,n), bb(ld,n), cc(ld,n)
+      real t1, t2, second, chksum, ctime, dtime, cs1d
+      do 1 nl = 1,2*ntimes
+      do 10 i = 2,n,2
+         a(i) = a(i-1) + b(i)
+  10  continue
+      call dummy(ld,n,a,b,c,d,e,aa,bb,cc,1.)
+  1   continue
+      return
+      end
+
+! { dg-final { scan-tree-dump-times "vectorized 1 loops" 0 "vect" } }
+! { dg-final { scan-tree-dump-times "complicated access pattern" 1 "vect" } }
+! { dg-final { cleanup-tree-dump "vect" } }
+
diff --git a/gcc/testsuite/gfortran.dg/vect/pr32377.f90 b/gcc/testsuite/gfortran.dg/vect/pr32377.f90
new file mode 100644
index 000000000..624a9ae7e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/pr32377.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-require-effective-target vect_float }
+
+subroutine s243(ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc)
+
+  integer ntimes,ld,n,i,nl
+  real a(n),b(n),c(n),d(n),e(n),aa(ld,n),bb(ld,n),cc(ld,n)
+  real t1,t2,chksum,ctime,dtime,cs1d
+  b(:n-1)= b(:n-1)+(c(:n-1)+e(:n-1))*d(:n-1)
+  a(:n-1)= b(:n-1)+a(2:n)*d(:n-1)
+  return
+end subroutine s243
+
+! { dg-final { scan-tree-dump-times "vectorized 2 loops" 1 "vect" } }
+! { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/pr33301.f b/gcc/testsuite/gfortran.dg/vect/pr33301.f
new file mode 100644
index 000000000..0713f3e75
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/pr33301.f
@@ -0,0 +1,14 @@
+c { dg-do compile }
+C Derived from lapack
+      SUBROUTINE ZGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
+     $                   WORK, RWORK, INFO )
+      COMPLEX(kind=8)         WORK( * )
+c     Following declaration added on transfer to gfortran testsuite.
+c     It is present in original lapack source
+      integer rank
+            DO 20 I = 1, RANK
+               WORK( ISMAX+I-1 ) = S2*WORK( ISMAX+I-1 )
+   20       CONTINUE
+      END
+
+c { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/pr39318.f90 b/gcc/testsuite/gfortran.dg/vect/pr39318.f90
new file mode 100644
index 000000000..c22e558e2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/pr39318.f90
@@ -0,0 +1,21 @@
+! { dg-do compile { target fopenmp } } 
+! { dg-options "-c -fopenmp -fexceptions -O2 -ftree-vectorize" } 
+
+      subroutine adw_trajsp (F_u,i0,in,j0,jn)
+      implicit none
+      real F_u(*)
+      integer i0,in,j0,jn
+      integer n,i,j
+      real*8 xsin(i0:in,j0:jn)
+!$omp parallel do private(xsin)
+         do j=j0,jn
+         do i=i0,in
+            xsin(i,j) = sqrt(F_u(n))
+         end do
+         end do
+!$omp end parallel do
+      return
+      end
+
+! { dg-final { cleanup-tree-dump "vect" } }
+
diff --git a/gcc/testsuite/gfortran.dg/vect/pr45714-a.f b/gcc/testsuite/gfortran.dg/vect/pr45714-a.f
new file mode 100644
index 000000000..dd99d1fe5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/pr45714-a.f
@@ -0,0 +1,27 @@
+! { dg-do compile { target x86_64-*-* } }
+! { dg-options "-O3 -march=core2 -mavx -ffast-math -mveclibabi=svml" }
+
+      integer index(18),i,j,k,l,ipiv(18),info,ichange,neq,lda,ldb,
+     &  nrhs,iplas
+      real*8 ep0(6),al10(18),al20(18),dg0(18),ep(6),al1(18),
+     &  al2(18),dg(18),ddg(18),xm(6,18),h(18,18),ck(18),cn(18),
+     &  c(18),d(18),phi(18),delta(18),r0(18),q(18),b(18),cphi(18),
+     &  q1(18),q2(18),stri(6),htri(18),sg(18),r(42),xmc(6,18),aux(18),
+     &  t(42),gl(18,18),gr(18,18),ee(6),c1111,c1122,c1212,dd,
+     &  skl(3,3),xmtran(3,3),ddsdde(6,6),xx(6,18)
+      do
+         do i=1,18
+            htri(i)=dabs(sg(i))-r0(i)-ck(i)*(dg(i)/dtime)**(1.d0/cn(i))
+            do j=1,18
+            enddo
+         enddo
+         do
+                  if(i.ne.j) then
+                  gr(index(i),1)=htri(i)
+               endif
+            call dgesv(neq,nrhs,gl,lda,ipiv,gr,ldb,info)
+         enddo
+      enddo
+      end
+
+! { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/pr45714-b.f b/gcc/testsuite/gfortran.dg/vect/pr45714-b.f
new file mode 100644
index 000000000..a536e1f59
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/pr45714-b.f
@@ -0,0 +1,27 @@
+! { dg-do compile { target powerpc*-*-* } }
+! { dg-options "-O3 -mcpu=power7 -ffast-math -mveclibabi=mass" }
+
+      integer index(18),i,j,k,l,ipiv(18),info,ichange,neq,lda,ldb,
+     &  nrhs,iplas
+      real*8 ep0(6),al10(18),al20(18),dg0(18),ep(6),al1(18),
+     &  al2(18),dg(18),ddg(18),xm(6,18),h(18,18),ck(18),cn(18),
+     &  c(18),d(18),phi(18),delta(18),r0(18),q(18),b(18),cphi(18),
+     &  q1(18),q2(18),stri(6),htri(18),sg(18),r(42),xmc(6,18),aux(18),
+     &  t(42),gl(18,18),gr(18,18),ee(6),c1111,c1122,c1212,dd,
+     &  skl(3,3),xmtran(3,3),ddsdde(6,6),xx(6,18)
+      do
+         do i=1,18
+            htri(i)=dabs(sg(i))-r0(i)-ck(i)*(dg(i)/dtime)**(1.d0/cn(i))
+            do j=1,18
+            enddo
+         enddo
+         do
+                  if(i.ne.j) then
+                  gr(index(i),1)=htri(i)
+               endif
+            call dgesv(neq,nrhs,gl,lda,ipiv,gr,ldb,info)
+         enddo
+      enddo
+      end
+
+! { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/pr46213.f90 b/gcc/testsuite/gfortran.dg/vect/pr46213.f90
new file mode 100644
index 000000000..504d1a3cf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/pr46213.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-O -fno-tree-loop-ivcanon -ftree-vectorize -fno-tree-ccp -fno-tree-ch -finline-small-functions" }
+
+module foo
+  INTEGER, PARAMETER :: ONE = 1
+end module foo
+program test
+  use foo
+  integer :: a(ONE), b(ONE), c(ONE), d(ONE)
+  interface
+    function h_ext()
+    end function h_ext
+  end interface
+  c = j()
+  if (any (c .ne. check)) call myabort (7)
+contains
+  function j()
+     integer :: j(ONE), cc(ONE)
+     j = cc - j
+  end function j
+  function get_d()
+  end function get_d
+end program test
+
+! { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/pr50178.f90 b/gcc/testsuite/gfortran.dg/vect/pr50178.f90
new file mode 100644
index 000000000..e24ce5b15
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/pr50178.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+
+module yemdyn
+   implicit none
+   integer, parameter :: jpim = selected_int_kind(9)
+   integer, parameter :: jprb = selected_real_kind(13,300)
+   real(kind=jprb) :: elx
+   real(kind=jprb), allocatable :: xkcoef(:)
+   integer(kind=jpim),allocatable :: ncpln(:), npne(:)
+end module yemdyn
+
+subroutine suedyn
+
+   use yemdyn
+
+   implicit none
+
+   integer(kind=jpim) :: jm, jn
+   real(kind=jprb) :: zjm, zjn, zxxx
+
+   jn=0
+   do jm=0,ncpln(jn)
+      zjm=real(jm,jprb) / elx
+      xkcoef(npne(jn)+jm) = - zxxx*(zjm**2)**0.5_jprb
+   end do
+
+end subroutine suedyn
+
+! { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/pr50412.f90 b/gcc/testsuite/gfortran.dg/vect/pr50412.f90
new file mode 100644
index 000000000..4f95741f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/pr50412.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+
+      DOUBLE PRECISION AK,AI,AAE
+      COMMON/com/AK(36),AI(4,4),AAE(8,4),ii,jj
+      DO 20 II=1,4
+        DO 21 JJ=1,4
+          AK(n)=AK(n)-AAE(I,II)*AI(II,JJ)
+   21   CONTINUE
+   20 CONTINUE
+      END
+
+! { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/vect-1.f90 b/gcc/testsuite/gfortran.dg/vect/vect-1.f90
new file mode 100644
index 000000000..cafcec7d0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/vect-1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-require-effective-target vect_float }
+
+DIMENSION A(1000000), B(1000000), C(1000000)
+READ*, X, Y
+A = LOG(X); B = LOG(Y); C = A + B
+PRINT*, C(500000)
+END
+
+! { dg-final { scan-tree-dump-times "vectorized 3 loops" 1 "vect" } }
+! { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/vect-2.f90 b/gcc/testsuite/gfortran.dg/vect/vect-2.f90
new file mode 100644
index 000000000..0f45a70c5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/vect-2.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-require-effective-target vect_float }
+
+SUBROUTINE FOO(A, B, C)
+DIMENSION A(1000000), B(1000000), C(1000000)
+READ*, X, Y
+A = LOG(X); B = LOG(Y); C = A + B
+PRINT*, C(500000)
+END
+
+! First loop (A=LOG(X)) is vectorized using peeling to align the store.
+! Same for the second loop (B=LOG(Y)).
+! Third loop (C = A + B) is vectorized using versioning (for targets that don't
+! support unaligned loads) or using peeling to align the store (on targets that 
+! support unaligned loads).
+
+! { dg-final { scan-tree-dump-times "vectorized 3 loops" 1 "vect" } }
+! { dg-final { scan-tree-dump-times "Alignment of access forced using peeling" 3 "vect" { xfail { vect_no_align || { ! vector_alignment_reachable } } } } }
+! { dg-final { scan-tree-dump-times "Alignment of access forced using peeling" 2 "vect" { target { vect_no_align && { ! vector_alignment_reachable } } } } }
+! { dg-final { scan-tree-dump-times "Vectorizing an unaligned access" 2 "vect" { xfail { vect_no_align } } } }
+! { dg-final { scan-tree-dump-times "Alignment of access forced using versioning." 3 "vect" {target { vect_no_align || { { ! vector_alignment_reachable  } && { ! vect_hw_misalign } } } } } } 
+! { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/vect-3.f90 b/gcc/testsuite/gfortran.dg/vect/vect-3.f90
new file mode 100644
index 000000000..5fc4fbf49
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/vect-3.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-require-effective-target vect_float }
+
+SUBROUTINE SAXPY(X, Y, A, N)
+DIMENSION X(N), Y(N)
+Y = Y + A * X
+END
+
+! { dg-final { scan-tree-dump-times "Alignment of access forced using versioning" 3 "vect" { target vect_no_align } } }
+! { dg-final { scan-tree-dump-times "Alignment of access forced using versioning" 1 "vect" { target { {! vect_no_align} && { {! vector_alignment_reachable} && {! vect_hw_misalign} } } } } }
+! { dg-final { scan-tree-dump-times "Vectorizing an unaligned access" 2 "vect" { target { {! vect_no_align} && { {! vector_alignment_reachable} && {! vect_hw_misalign} } } } } }
+! { dg-final { scan-tree-dump-times "Alignment of access forced using peeling" 1 "vect" { xfail { vect_no_align || {! vector_alignment_reachable}} } } }
+! { dg-final { scan-tree-dump-times "Vectorizing an unaligned access" 1 "vect" { xfail { { vect_no_align } || { ! vector_alignment_reachable} } } } }
+
+! { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/vect-4.f90 b/gcc/testsuite/gfortran.dg/vect/vect-4.f90
new file mode 100644
index 000000000..592282fb0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/vect-4.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-require-effective-target vect_float }
+
+! Peeling to align the store to Y will also align the load from Y.
+! The load from X may still be misaligned.
+
+SUBROUTINE SAXPY(X, Y, A)
+DIMENSION X(64), Y(64)
+Y = Y + A * X
+END
+
+! { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" } } 
+! { dg-final { scan-tree-dump-times "Alignment of access forced using peeling" 1 "vect" { xfail { { vect_no_align } || {! vector_alignment_reachable} } } } }
+! { dg-final { scan-tree-dump-times "Vectorizing an unaligned access" 1 "vect" { xfail { { vect_no_align } || {! vector_alignment_reachable} } } } }
+! { dg-final { scan-tree-dump-times "Vectorizing an unaligned access" 2 "vect" { target { {! vector_alignment_reachable} && {! vect_hw_misalign} } } } }
+! { dg-final { scan-tree-dump-times "accesses have the same alignment." 1 "vect" } }
+! { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/vect-5.f90 b/gcc/testsuite/gfortran.dg/vect/vect-5.f90
new file mode 100644
index 000000000..72776a6fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/vect-5.f90
@@ -0,0 +1,43 @@
+! { dg-require-effective-target vect_int }
+
+        Subroutine foo (N, M)
+        Integer N
+        Integer M
+        integer A(8,16)
+        integer B(8)
+
+        B = (/ 2, 3, 5, 7, 11, 13, 17, 23 /)
+
+        ! Unknown loop bound. J depends on I.
+
+        do I = 1, N
+          do J = I, M
+            A(J,2) = B(J)
+          end do
+        end do
+
+        do I = 1, N
+          do J = I, M
+            if (A(J,2) /= B(J)) then
+              call abort ()
+              endif
+          end do
+        end do
+
+        Return
+        end
+
+
+        program main
+
+        Call foo (16, 8)
+
+        stop
+        end
+
+! { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect"  } }
+! { dg-final { scan-tree-dump-times "Alignment of access forced using peeling" 1 "vect" { xfail { vect_no_align || {! vector_alignment_reachable} } } } }
+! { dg-final { scan-tree-dump-times "Vectorizing an unaligned access" 1 "vect" { xfail { vect_no_align } } } }
+! { dg-final { scan-tree-dump-times "Alignment of access forced using versioning." 2 "vect" { target { vect_no_align } } } }
+! { dg-final { scan-tree-dump-times "Alignment of access forced using versioning." 1 "vect" { target { {! vector_alignment_reachable} && {! vect_hw_misalign} } } } }
+! { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/vect-6.f b/gcc/testsuite/gfortran.dg/vect/vect-6.f
new file mode 100644
index 000000000..f232dcb82
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/vect-6.f
@@ -0,0 +1,25 @@
+! { dg-do compile }
+
+      SUBROUTINE PROPAGATE(ICI1,ICI2,I,J,J1,ELEM,NHSO,HSO
+     *                    ,MULST,IROOTS)
+      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
+      COMPLEX*16 HSO,ELEM
+      DIMENSION HSO(NHSO,NHSO),MULST(*),IROOTS(*)
+      ISHIFT=MULST(ICI1)*(I-1)+1
+      JSHIFT=MULST(ICI2)*(J-1)+1
+      DO 200 ICI=1,ICI1-1
+         ISHIFT=ISHIFT+MULST(ICI)*IROOTS(ICI)
+  200 CONTINUE
+      DO 220 ICI=1,ICI2-1
+         JSHIFT=JSHIFT+MULST(ICI)*IROOTS(ICI)
+  220 CONTINUE
+         DO 150 MSS=MS,-MS,-2
+           IND1=ISHIFT+K
+           IND2=JSHIFT+K
+           HSO(IND1,IND2)=ELEM
+           HSO(IND2,IND1)=DCONJG(ELEM)
+  150    CONTINUE
+      END
+
+! { dg-final { cleanup-tree-dump "vect" } }
+
diff --git a/gcc/testsuite/gfortran.dg/vect/vect-7.f90 b/gcc/testsuite/gfortran.dg/vect/vect-7.f90
new file mode 100644
index 000000000..b82bb95e8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/vect-7.f90
@@ -0,0 +1,16 @@
+! { dg-do compile } 
+! { dg-require-effective-target vect_double } 
+
+subroutine foo (x,nnd)
+  dimension x(nnd) 
+  integer i
+  
+  do i=1,nnd
+    x(i) = 1.d0 + (1.d0*i)/nnd
+  end do
+
+end subroutine foo 
+
+! { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target { vect_unpack  && vect_intfloat_cvt } } } } 
+! { dg-final { cleanup-tree-dump "vect" } } 
+
diff --git a/gcc/testsuite/gfortran.dg/vect/vect-gems.f90 b/gcc/testsuite/gfortran.dg/vect/vect-gems.f90
new file mode 100644
index 000000000..66e878d3d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/vect-gems.f90
@@ -0,0 +1,58 @@
+! { dg-do compile }
+! { dg-require-effective-target vect_double }
+
+MODULE UPML_mod
+
+IMPLICIT NONE
+
+PUBLIC UPMLupdateE
+
+PRIVATE
+
+real(kind=8), dimension(:,:,:), allocatable :: Dx_ilow
+
+real(kind=8), dimension(:), allocatable :: aye, aze
+real(kind=8), dimension(:), allocatable :: bye, bze
+real(kind=8), dimension(:), allocatable :: fxh, cxh
+
+real(kind=8) :: epsinv
+real(kind=8) :: dxinv, dyinv, dzinv
+
+integer :: xstart, ystart, zstart, xstop, ystop, zstop
+
+CONTAINS
+
+SUBROUTINE UPMLupdateE(nx,ny,nz,Hx,Hy,Hz,Ex,Ey,Ez)
+
+integer, intent(in) :: nx, ny, nz
+real(kind=8), intent(inout),                                                &
+         dimension(xstart:xstop+1,ystart:ystop+1,zstart:zstop+1) :: Ex, Ey, Ez
+real(kind=8), intent(inout),                                                &
+         allocatable :: Hx(:,:,:), Hy(:,:,:), Hz(:,:,:)
+
+integer :: i, j, k
+real(kind=8) :: Dxold, Dyold, Dzold
+
+do k=zstart+1,zstop
+  do j=ystart+1,ystop
+    do i=xstart+1,0
+
+      Dxold = Dx_ilow(i,j,k)
+
+      Dx_ilow(i,j,k) = aye(j) * Dx_ilow(i,j,k) +                              &
+                       bye(j) * ((Hz(i,j,k  )-Hz(i,j-1,k))*dyinv +            &
+                                 (Hy(i,j,k-1)-Hy(i,j,k  ))*dzinv)
+
+      Ex(i,j,k) = aze(k) * Ex(i,j,k) +                                        &
+                  bze(k) * (cxh(i)*Dx_ilow(i,j,k) - fxh(i)*Dxold) * epsinv
+    end do
+  end do
+end do
+
+END SUBROUTINE UPMLupdateE
+
+END MODULE UPML_mod
+
+! { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect"  } }
+! { dg-final { cleanup-tree-dump "vect" } }
+! { dg-final { cleanup-modules "upml_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/vect/vect.exp b/gcc/testsuite/gfortran.dg/vect/vect.exp
new file mode 100644
index 000000000..11bcecd7c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vect/vect.exp
@@ -0,0 +1,91 @@
+# Copyright (C) 1997, 2004, 2007, 2008, 2010 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# GCC testsuite that uses the `dg.exp' driver.
+
+# Load support procs.
+load_lib gfortran-dg.exp
+load_lib target-supports.exp
+
+# Set up flags used for tests that don't specify options.
+global DEFAULT_VECTCFLAGS
+set DEFAULT_VECTCFLAGS ""
+
+# These flags are used for all targets.
+lappend DEFAULT_VECTCFLAGS "-O2" "-ftree-vectorize" "-fno-vect-cost-model" \
+  "-ftree-vectorizer-verbose=4" "-fdump-tree-vect-stats"
+
+# If the target system supports vector instructions, the default action
+# for a test is 'run', otherwise it's 'compile'.  Save current default.
+# Executing vector instructions on a system without hardware vector support
+# is also disabled by a call to check_vect, but disabling execution here is
+# more efficient.
+global dg-do-what-default
+set save-dg-do-what-default ${dg-do-what-default}
+
+# Skip these tests for targets that do not support generating vector
+# code.  Set additional target-dependent vector flags, which can be
+# overridden by using dg-options in individual tests.
+if ![check_vect_support_and_set_flags] {
+    return
+}
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+gfortran-dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/vect-*.\[fF\]{,90,95,03,08} ]] $DEFAULT_VECTCFLAGS
+gfortran-dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/pr*.\[fF\]{,90,95,03,08} ]] $DEFAULT_VECTCFLAGS
+
+#### Tests with special options
+global SAVED_DEFAULT_VECTCFLAGS
+set SAVED_DEFAULT_VECTCFLAGS $DEFAULT_VECTCFLAGS
+
+# -ffast-math tests
+set DEFAULT_VECTCFLAGS $SAVED_DEFAULT_VECTCFLAGS
+lappend DEFAULT_VECTCFLAGS "-ffast-math"
+dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/fast-math-*.\[fF\]{,90,95,03,08} ]]  \
+        "" $DEFAULT_VECTCFLAGS
+
+# -ffast-math tests
+set DEFAULT_VECTCFLAGS $SAVED_DEFAULT_VECTCFLAGS
+lappend DEFAULT_VECTCFLAGS "-ffast-math" "-fdefault-real-8"
+dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/fast-math-real8*.\[fF\]{,90,95,03,08} ]]  \
+        "" $DEFAULT_VECTCFLAGS
+
+# -fvect-cost-model tests
+set DEFAULT_VECTCFLAGS $SAVED_DEFAULT_VECTCFLAGS
+lappend DEFAULT_VECTCFLAGS "-fvect-cost-model"
+dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/cost-model-*.\[fF\]{,90,95,03,08} ]]  \
+        "" $DEFAULT_VECTCFLAGS
+
+# --param vect-max-version-for-alias-checks=0 tests
+set DEFAULT_VECTCFLAGS $SAVED_DEFAULT_VECTCFLAGS
+lappend DEFAULT_VECTCFLAGS "--param" "vect-max-version-for-alias-checks=0"
+dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/no-vfa-*.\[fF\]{,90,95,03,08} ]]  \
+        "" $DEFAULT_VECTCFLAGS
+
+# With -O3
+set DEFAULT_VECTCFLAGS $SAVED_DEFAULT_VECTCFLAGS
+lappend DEFAULT_VECTCFLAGS "-O3"
+dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/O3-*.\[fF\]{,90,95,03,08} ]]  \
+        "" $DEFAULT_VECTCFLAGS
+
+# Clean up.
+set dg-do-what-default ${save-dg-do-what-default}
+
+# All done.
+dg-finish
diff --git a/gcc/testsuite/gfortran.dg/vector_subscript_1.f90 b/gcc/testsuite/gfortran.dg/vector_subscript_1.f90
new file mode 100644
index 000000000..dd09fbb0b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vector_subscript_1.f90
@@ -0,0 +1,174 @@
+! PR 19239.  Check for various kinds of vector subscript.  In this test,
+! all vector subscripts are indexing single-dimensional arrays.
+! { dg-do run }
+program main
+  implicit none
+  integer, parameter :: n = 10
+  integer :: i, j, calls
+  integer, dimension (n) :: a, b, idx, id
+
+  idx = (/ 3, 1, 5, 2, 4, 10, 8, 7, 6, 9 /)
+  id = (/ (i, i = 1, n) /)
+  b = (/ (i * 100, i = 1, n) /)
+
+  !------------------------------------------------------------------
+  ! Tests for a simple variable subscript
+  !------------------------------------------------------------------
+
+  a (idx) = b
+  call test (idx, id)
+
+  a = b (idx)
+  call test (id, idx)
+
+  a (idx) = b (idx)
+  call test (idx, idx)
+
+  !------------------------------------------------------------------
+  ! Tests for constant ranges with non-default stride
+  !------------------------------------------------------------------
+
+  a (idx (1:7:3)) = b (10:6:-2)
+  call test (idx (1:7:3), id (10:6:-2))
+
+  a (10:6:-2) = b (idx (1:7:3))
+  call test (id (10:6:-2), idx (1:7:3))
+
+  a (idx (1:7:3)) = b (idx (1:7:3))
+  call test (idx (1:7:3), idx (1:7:3))
+
+  a (idx (1:7:3)) = b (idx (10:6:-2))
+  call test (idx (1:7:3), idx (10:6:-2))
+
+  a (idx (10:6:-2)) = b (idx (10:6:-2))
+  call test (idx (10:6:-2), idx (10:6:-2))
+
+  a (idx (10:6:-2)) = b (idx (1:7:3))
+  call test (idx (10:6:-2), idx (1:7:3))
+
+  !------------------------------------------------------------------
+  ! Tests for subscripts of the form CONSTRANGE + CONST
+  !------------------------------------------------------------------
+
+  a (idx (1:5) + 1) = b (1:5)
+  call test (idx (1:5) + 1, id (1:5))
+
+  a (1:5) = b (idx (1:5) + 1)
+  call test (id (1:5), idx (1:5) + 1)
+
+  a (idx (6:10) - 1) = b (idx (1:5) + 1)
+  call test (idx (6:10) - 1, idx (1:5) + 1)
+
+  !------------------------------------------------------------------
+  ! Tests for variable subranges
+  !------------------------------------------------------------------
+
+  do j = 5, 10
+    a (idx (2:j:2)) = b (3:2+j/2)
+    call test (idx (2:j:2), id (3:2+j/2))
+
+    a (3:2+j/2) = b (idx (2:j:2))
+    call test (id (3:2+j/2), idx (2:j:2))
+
+    a (idx (2:j:2)) = b (idx (2:j:2))
+    call test (idx (2:j:2), idx (2:j:2))
+  end do
+
+  !------------------------------------------------------------------
+  ! Tests for function vectors
+  !------------------------------------------------------------------
+
+  calls = 0
+
+  a (foo (5, calls)) = b (2:10:2)
+  call test (foo (5, calls), id (2:10:2))
+
+  a (2:10:2) = b (foo (5, calls))
+  call test (id (2:10:2), foo (5, calls))
+
+  a (foo (5, calls)) = b (foo (5, calls))
+  call test (foo (5, calls), foo (5, calls))
+
+  if (calls .ne. 8) call abort
+
+  !------------------------------------------------------------------
+  ! Tests for constant vector constructors
+  !------------------------------------------------------------------
+
+  a ((/ 1, 5, 3, 9 /)) = b (1:4)
+  call test ((/ 1, 5, 3, 9 /), id (1:4))
+
+  a (1:4) = b ((/ 1, 5, 3, 9 /))
+  call test (id (1:4), (/ 1, 5, 3, 9 /))
+
+  a ((/ 1, 5, 3, 9 /)) = b ((/ 2, 5, 3, 7 /))
+  call test ((/ 1, 5, 3, 9 /), (/ 2, 5, 3, 7 /))
+
+  !------------------------------------------------------------------
+  ! Tests for variable vector constructors
+  !------------------------------------------------------------------
+
+  do j = 1, 5
+    a ((/ 1, (i + 3, i = 2, j) /)) = b (1:j)
+    call test ((/ 1, (i + 3, i = 2, j) /), id (1:j))
+
+    a (1:j) = b ((/ 1, (i + 3, i = 2, j) /))
+    call test (id (1:j), (/ 1, (i + 3, i = 2, j) /))
+
+    a ((/ 1, (i + 3, i = 2, j) /)) = b ((/ 8, (i + 2, i = 2, j) /))
+    call test ((/ 1, (i + 3, i = 2, j) /), (/ 8, (i + 2, i = 2, j) /))
+  end do
+
+  !------------------------------------------------------------------
+  ! Tests in which the vector dimension is partnered by a temporary
+  !------------------------------------------------------------------
+
+  calls = 0
+  a (idx (1:6)) = foo (6, calls)
+  if (calls .ne. 1) call abort
+  do i = 1, 6
+    if (a (idx (i)) .ne. i + 3) call abort
+  end do
+  a = 0
+
+  calls = 0
+  a (idx (1:6)) = foo (6, calls) * 100
+  if (calls .ne. 1) call abort
+  do i = 1, 6
+    if (a (idx (i)) .ne. (i + 3) * 100) call abort
+  end do
+  a = 0
+
+  a (idx) = id + 100
+  do i = 1, n
+    if (a (idx (i)) .ne. i + 100) call abort
+  end do
+  a = 0
+
+  a (idx (1:10:3)) = (/ 20, 10, 9, 11 /)
+  if (a (idx (1)) .ne. 20) call abort
+  if (a (idx (4)) .ne. 10) call abort
+  if (a (idx (7)) .ne. 9) call abort
+  if (a (idx (10)) .ne. 11) call abort
+  a = 0
+
+contains
+  subroutine test (lhs, rhs)
+    integer, dimension (:) :: lhs, rhs
+    integer :: i
+
+    if (size (lhs, 1) .ne. size (rhs, 1)) call abort
+    do i = 1, size (lhs, 1)
+      if (a (lhs (i)) .ne. b (rhs (i))) call abort
+    end do
+    a = 0
+  end subroutine test
+
+  function foo (n, calls)
+    integer :: i, n, calls
+    integer, dimension (n) :: foo
+
+    calls = calls + 1
+    foo = (/ (i + 3, i = 1, n) /)
+  end function foo
+end program main
diff --git a/gcc/testsuite/gfortran.dg/vector_subscript_2.f90 b/gcc/testsuite/gfortran.dg/vector_subscript_2.f90
new file mode 100644
index 000000000..a5c024a28
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vector_subscript_2.f90
@@ -0,0 +1,39 @@
+! Like vector_subscript_1.f90, but check subscripts in multi-dimensional
+! arrays.
+! { dg-do run }
+program main
+  implicit none
+  integer, parameter :: n = 5
+  integer :: i1, i2, i3
+  integer, dimension (n, n, n) :: a, b
+  integer, dimension (n) :: idx, id
+
+  idx = (/ 3, 1, 5, 2, 4 /)
+  id = (/ (i1, i1 = 1, n) /)
+  forall (i1 = 1:n, i2 = 1:n, i3 = 1:n)
+    b (i1, i2, i3) = i1 + i2 * 10 + i3 * 100
+  end forall
+
+  i1 = 5
+  a (foo (i1), 1, :) = b (2, :, foo (i1))
+  do i1 = 1, 5
+    do i2 = 1, 5
+      if (a (idx (i1), 1, i2) .ne. b (2, i1, idx (i2))) call abort
+    end do
+  end do
+  a = 0
+
+  a (1, idx (1:4), 2:4) = b (2:5, idx (3:5), 2)
+  do i1 = 1, 4
+    do i2 = 1, 3
+      if (a (1, idx (i1), 1 + i2) .ne. b (1 + i1, idx (i2 + 2), 2)) call abort
+    end do
+  end do
+  a = 0
+contains
+  function foo (n)
+    integer :: n
+    integer, dimension (n) :: foo
+    foo = idx (1:n)
+  end function foo
+end program main
diff --git a/gcc/testsuite/gfortran.dg/vector_subscript_3.f90 b/gcc/testsuite/gfortran.dg/vector_subscript_3.f90
new file mode 100644
index 000000000..3fa306e16
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vector_subscript_3.f90
@@ -0,0 +1,45 @@
+! { dg-do run { target fd_truncate } }
+!
+! Test the fix for PR34875, in which the read with a vector index
+! used to do nothing.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+Program QH0008
+
+  REAL(4) QDA(10)
+  REAL(4) QDA1(10)
+! Scramble the vector up a bit to make the test more interesting
+  integer, dimension(10) ::  nfv1 = (/9,2,1,3,5,4,6,8,7,10/)
+! Set qda1 in ordinal order
+  qda1(nfv1) = nfv1
+  qda = -100
+  OPEN (UNIT = 47,                &
+        STATUS = 'SCRATCH',       &
+        FORM = 'UNFORMATTED',     &
+        ACTION = 'READWRITE')
+  ISTAT = -314
+  REWIND (47, IOSTAT = ISTAT)
+  IF (ISTAT .NE. 0) call abort ()
+  ISTAT = -314
+! write qda1
+  WRITE (47,IOSTAT = ISTAT) QDA1
+  IF (ISTAT .NE. 0) call abort ()
+  ISTAT = -314
+  REWIND (47, IOSTAT = ISTAT)
+  IF (ISTAT .NE. 0) call abort ()
+! Do the vector index read that used to fail
+  READ (47,IOSTAT = ISTAT) QDA(NFV1)
+  IF (ISTAT .NE. 0) call abort ()
+! Unscramble qda using the vector index
+  IF (ANY (QDA(nfv1) .ne. QDA1) ) print *, qda, qda1
+  ISTAT = -314
+  REWIND (47, IOSTAT = ISTAT)
+  IF (ISTAT .NE. 0) call abort ()
+  qda = -200
+! Do the subscript read that was OK
+  READ (47,IOSTAT = ISTAT) QDA(1:10)
+  IF (ISTAT .NE. 0) call abort ()
+  IF (ANY (QDA .ne. QDA1) ) call abort ()
+END
+
diff --git a/gcc/testsuite/gfortran.dg/vector_subscript_4.f90 b/gcc/testsuite/gfortran.dg/vector_subscript_4.f90
new file mode 100644
index 000000000..5c341dab4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vector_subscript_4.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for PR37903, in which the temporary for the vector index
+! got the wrong size.
+!
+! Contributed by Mikael Morin <mikael.morin@tele2.fr>
+!
+     integer :: i(-1:1) = 1, j(3) = 1, k(3)
+      k = j((/1,1,1/)+i)
+      end
+! { dg-final { scan-tree-dump-times "A\.2\\\[3\\\]" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/vector_subscript_5.f90 b/gcc/testsuite/gfortran.dg/vector_subscript_5.f90
new file mode 100644
index 000000000..88eb358e6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vector_subscript_5.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+!
+! Test the fix for PR37749 in which the expression in line 13 would cause an ICE
+! because the upper value of the loop range was not set.
+!
+! Contributed by Jakub Jelinek <jakub@gcc.gnu.org>
+!
+subroutine subr (m, n, a, b, c, d, p)
+  implicit none
+  integer m, n
+  real a(m,n), b(m,n), c(n,n), d(m,n)
+  integer p(n)
+  d = a(:,p) - matmul(b, c)
+end subroutine
+
+  implicit none
+  integer i
+  real a(3,2), b(3,2), c(2,2), d(3,2)
+  integer p(2)
+  a = reshape ((/(i, i = 1, 6)/), (/3, 2/))
+  b = 1
+  c = 2
+  p = 2
+  call subr (3, 2, a, b, c, d, p)
+  if (any (d .ne. reshape ((/(mod (i + 2, 3), i = 1, 6)/), (/3, 2/)))) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/vector_subscript_6.f90 b/gcc/testsuite/gfortran.dg/vector_subscript_6.f90
new file mode 100644
index 000000000..51613d113
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vector_subscript_6.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+
+subroutine test0(esss,Ix, e_x)
+  real(kind=kind(1.0d0)), dimension(:), intent(out) :: esss
+  real(kind=kind(1.0d0)), dimension(:), intent(in) :: Ix
+  integer(kind=kind(1)), dimension(:), intent(in) :: e_x
+  esss = Ix(e_x)
+end subroutine
+
+subroutine test1(esss,Ix, e_x)
+  real(kind=kind(1.0d0)), dimension(:), intent(out) :: esss
+  real(kind=kind(1.0d0)), dimension(:), intent(in) :: Ix
+  integer(kind=4), dimension(:), intent(in) :: e_x
+  esss = Ix(e_x)
+end subroutine
+
+subroutine test2(esss,Ix, e_x)
+  real(kind=kind(1.0d0)), dimension(:), intent(out) :: esss
+  real(kind=kind(1.0d0)), dimension(:), intent(in) :: Ix
+  integer(kind=8), dimension(:), intent(in) :: e_x
+  esss = Ix(e_x)
+end subroutine
+
+subroutine test3(esss,Ix,Iyz, e_x, ii_ivec)
+  real(kind=kind(1.0d0)), dimension(:), intent(out) :: esss
+  real(kind=kind(1.0d0)), dimension(:), intent(in) :: Ix,Iyz
+  integer(kind=kind(1)), dimension(:), intent(in) :: e_x,ii_ivec
+  esss = esss + Ix(e_x) * Iyz(ii_ivec)
+end subroutine
+
+! { dg-final { scan-tree-dump-not "malloc" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/vector_subscript_bound_1.f90 b/gcc/testsuite/gfortran.dg/vector_subscript_bound_1.f90
new file mode 100644
index 000000000..f4328504f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vector_subscript_bound_1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! PR fortran/45745
+! ICE with {L,U}BOUND intrinsic function as vector subscript on derived
+! type component. 
+!
+! Original test by Joost Van de Vondele <Joost.VandeVondele@pci.uzh.ch>
+
+MODULE pw_types
+  TYPE pw_type
+     REAL, DIMENSION ( : ), POINTER :: cr
+  END TYPE pw_type
+CONTAINS
+  SUBROUTINE pw_write(pw)
+    TYPE(pw_type), INTENT(in) :: pw
+    PRINT *, pw%cr(LBOUND(pw%cr))
+    PRINT *, pw%cr(UBOUND(pw%cr))
+  END SUBROUTINE pw_write
+END MODULE
diff --git a/gcc/testsuite/gfortran.dg/verify_2.f90 b/gcc/testsuite/gfortran.dg/verify_2.f90
new file mode 100644
index 000000000..705d77504
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/verify_2.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+program verify_2
+  character(len=3) s1, s2
+  s1 = 'abc'
+  s2 = ''
+  if (verify('ab', '') /= 1) call abort
+  if (verify(s1, s2)   /= 1) call abort
+  if (verify('abc', '', .true.) /= 3) call abort
+  if (verify(s1, s2, .true.) /= 3) call abort
+end program verify_2
+
diff --git a/gcc/testsuite/gfortran.dg/volatile.f90 b/gcc/testsuite/gfortran.dg/volatile.f90
new file mode 100644
index 000000000..73184250c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! Test whether volatile statements and attributes are accepted
+! PR fortran/29601
+program volatile_test
+  implicit none
+  real :: l,m
+  real, volatile :: r = 3.
+  volatile :: l
+  l = 4.0
+  m = 3.0
+end program volatile_test
diff --git a/gcc/testsuite/gfortran.dg/volatile10.f90 b/gcc/testsuite/gfortran.dg/volatile10.f90
new file mode 100644
index 000000000..2065b164c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile10.f90
@@ -0,0 +1,149 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-optimized -O3" }
+! Test setting host-/use-associated variables as VOLATILE
+! PR fortran/30522
+
+module impl
+  implicit REAL (A-Z)
+  volatile :: x
+end module impl
+
+module one
+  implicit none
+  logical :: l, lv
+  volatile :: lv
+contains
+  subroutine test1(cmp)
+    logical  :: cmp
+    volatile :: l, lv
+    if (l  .neqv. cmp) call abort()
+    if (lv .neqv. cmp) call abort()
+    l = .false.
+    lv = .false.
+    if(l .or. lv) print *, 'one_test1' ! not optimized away
+  end subroutine test1
+  subroutine test2(cmp)
+    logical  :: cmp
+    if (l  .neqv. cmp) call abort()
+    if (lv .neqv. cmp) call abort()
+    l = .false.
+    if(l)  print *, 'one_test2_1' ! optimized away
+    lv = .false.
+    if(lv) print *, 'one_test2_2' ! not optimized away
+  end subroutine test2
+end module one
+
+module two
+  use :: one
+  implicit none
+  volatile :: lv,l
+contains
+  subroutine test1t(cmp)
+    logical  :: cmp
+    volatile :: l, lv
+    if (l  .neqv. cmp) call abort()
+    if (lv .neqv. cmp) call abort()
+    l = .false.
+    if(l)  print *, 'two_test1_1' ! not optimized away
+    lv = .false.
+    if(lv) print *, 'two_test1_2' ! not optimized away
+  end subroutine test1t
+  subroutine test2t(cmp)
+    logical  :: cmp
+    if (l  .neqv. cmp) call abort()
+    if (lv .neqv. cmp) call abort()
+    l = .false.
+    if(l)  print *, 'two_test2_1' ! not optimized away
+    lv = .false.
+    if(lv) print *, 'two_test2_2' ! not optimized away
+  end subroutine test2t
+end module two
+
+program main
+  use :: two, only: test1t, test2t
+  implicit none
+  logical :: lm, lmv
+  volatile :: lmv
+  lm = .true.
+  lmv = .true.
+  call test1m(.true.)
+  lm = .true.
+  lmv = .true.
+  call test2m(.true.)
+  lm = .false.
+  lmv = .false.
+  call test1m(.false.)
+  lm = .false.
+  lmv = .false.
+  call test2m(.false.)
+contains
+  subroutine test1m(cmp)
+    use :: one
+    logical  :: cmp
+    volatile :: lm,lmv
+    if(lm  .neqv. cmp) call abort()
+    if(lmv .neqv. cmp) call abort()
+    l  = .false.
+    lv = .false.
+    call test1(.false.)
+    l  = .true.
+    lv = .true.
+    call test1(.true.)
+    lm  = .false.
+    lmv = .false.
+    if(lm .or. lmv) print *, 'main_test1_1' ! not optimized away
+    l   = .false.
+    if(l)  print *, 'main_test1_2'          ! optimized away
+    lv  = .false.
+    if(lv) print *, 'main_test1_3'          ! not optimized away
+    l  = .false.
+    lv = .false.
+    call test2(.false.)
+    l  = .true.
+    lv = .true.
+    call test2(.true.)
+  end subroutine test1m
+  subroutine test2m(cmp)
+    use :: one
+    logical  :: cmp
+    volatile :: lv
+    if(lm .neqv. cmp) call abort
+    if(lmv .neqv. cmp) call abort()
+    l  = .false.
+    lv = .false.
+    call test1(.false.)
+    l  = .true.
+    lv = .true.
+    call test1(.true.)
+    lm  = .false.
+    if(lm) print *, 'main_test2_1' ! not optimized away
+    lmv = .false.
+    if(lmv)print *, 'main_test2_2' ! not optimized away
+    l   = .false.
+    if(l)  print *, 'main_test2_3' ! optimized away
+    lv  = .false.
+    if(lv) print *, 'main_test2_4' ! not optimized away
+    l  = .false.
+    lv = .false.
+    call test2(.false.)
+    l  = .true.
+    lv = .true.
+    call test2(.true.)
+  end subroutine test2m
+end program main
+
+! { dg-final { scan-tree-dump      "one_test1"   "optimized" } }
+! TODO: dg-final { scan-tree-dump-not  "one_test2_1" "optimized" } 
+! { dg-final { scan-tree-dump      "one_test2_2" "optimized" } }
+! { dg-final { scan-tree-dump      "one_test2_2" "optimized" } }
+! { dg-final { scan-tree-dump      "two_test2_1" "optimized" } }
+! { dg-final { scan-tree-dump      "two_test2_2" "optimized" } }
+! { dg-final { scan-tree-dump      "main_test1_1" "optimized" } }
+! TODO: dg-final { scan-tree-dump-not  "main_test1_2" "optimized" } 
+! { dg-final { scan-tree-dump      "main_test1_3" "optimized" } }
+! { dg-final { scan-tree-dump      "main_test2_1" "optimized" } }
+! { dg-final { scan-tree-dump      "main_test2_2" "optimized" } }
+! TODO: dg-final { scan-tree-dump-not  "main_test2_3" "optimized" } 
+! { dg-final { scan-tree-dump      "main_test2_4" "optimized" } }
+! { dg-final { cleanup-tree-dump  "optimized" } }
+! { dg-final { cleanup-modules "impl one two" } }
diff --git a/gcc/testsuite/gfortran.dg/volatile11.f90 b/gcc/testsuite/gfortran.dg/volatile11.f90
new file mode 100644
index 000000000..5742915ab
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile11.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-optimized" }
+! Tests that volatile can be applied to members of common blocks or
+! equivalence groups (PR fortran/35037)
+!
+subroutine wait1
+  logical event
+  volatile event
+  common /dd/ event
+  event = .false.
+  do
+    if (event) print *, 'NotOptimizedAway1'
+  end do
+end subroutine
+
+subroutine wait2
+  logical event, foo
+  volatile event
+  equivalence (event, foo)
+  event = .false.
+  do
+    if (event) print *, 'NotOptimizedAway2'
+  end do
+end subroutine
+
+subroutine wait3
+  logical event
+  integer foo
+  volatile foo
+  equivalence (event, foo)
+  event = .false.
+  do
+    if (event) print *, 'IsOptimizedAway'
+  end do
+end subroutine
+
+! { dg-final { scan-tree-dump "NotOptimizedAway1" "optimized" } } */
+! { dg-final { scan-tree-dump "NotOptimizedAway2" "optimized" } } */
+! { dg-final { scan-tree-dump-not "IsOptimizedAway" "optimized" } } */
+! { dg-final { cleanup-tree-dump "optimized" } } */
diff --git a/gcc/testsuite/gfortran.dg/volatile12.f90 b/gcc/testsuite/gfortran.dg/volatile12.f90
new file mode 100644
index 000000000..1e85a2b8e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile12.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-optimized -O3" }
+!
+! PR fortran/45742
+!
+
+subroutine sub(arg)
+  integer, volatile :: arg
+  if (arg /= arg) call I_dont_exist()
+end
+
+! { dg-final { scan-tree-dump "integer.kind=.. . volatile arg" "optimized" } }
+! { dg-final { scan-tree-dump-times " =.v. arg;" 2 "optimized" } }
+! { dg-final { scan-tree-dump "i_dont_exist" "optimized" } }
+! { dg-final { cleanup-tree-dump "optimized" } }
+
diff --git a/gcc/testsuite/gfortran.dg/volatile2.f90 b/gcc/testsuite/gfortran.dg/volatile2.f90
new file mode 100644
index 000000000..60655df42
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile2.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-shouldfail "VOLATILE not part of F95" }
+! { dg-options "-std=f95" }
+! Test whether volatile statements and attributes are rejected
+! with -std=f95.
+! PR fortran/29601
+program volatile_test
+  implicit none
+  real, volatile :: foo ! { dg-error "VOLATILE attribute" }
+  real :: l
+  volatile :: l         ! { dg-error "VOLATILE statement" }
+  l   = 4.0
+  foo = 3.0             ! { dg-error "no IMPLICIT type" }   
+end program volatile_test
diff --git a/gcc/testsuite/gfortran.dg/volatile3.f90 b/gcc/testsuite/gfortran.dg/volatile3.f90
new file mode 100644
index 000000000..f9f720262
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile3.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-shouldfail "Invalid use of VOLATILE" }
+! Test whether volatile statements and attributes are
+! properly error checked.
+! PR fortran/29601
+program volatile_test
+  implicit none
+  real, external,  volatile :: foo ! { dg-error "VOLATILE attribute conflicts with EXTERNAL attribute" }
+  real, intrinsic, volatile :: sin ! { dg-error "VOLATILE attribute conflicts with INTRINSIC attribute" }
+  real, parameter, volatile :: r = 5.5 ! { dg-error "PARAMETER attribute conflicts with VOLATILE attribute" }
+  real :: l,m
+  real,volatile :: n
+  real, volatile,volatile :: r = 3. ! { dg-error "Duplicate VOLATILE attribute" }
+  volatile :: l,n ! { dg-warning "Duplicate VOLATILE attribute" }
+  volatile ! { dg-error "Syntax error in VOLATILE statement" }
+  volatile :: volatile_test ! { dg-error "PROGRAM attribute conflicts with VOLATILE attribute" }
+  l = 4.0
+  m = 3.0
+contains
+  subroutine foo(a) ! { dg-error "has no IMPLICIT type" } ! due to error below
+    integer, intent(in), volatile :: a ! { dg-error "VOLATILE attribute conflicts with INTENT\\(IN\\)" }
+  end subroutine
+end program volatile_test
diff --git a/gcc/testsuite/gfortran.dg/volatile4.f90 b/gcc/testsuite/gfortran.dg/volatile4.f90
new file mode 100644
index 000000000..f58a873df
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile4.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-optimized" }
+! Tests whether volatile really works
+! PR fortran/29601
+logical, volatile :: t1
+logical :: t2
+integer :: i
+
+t2 = .false.
+t1 = .false.
+do i = 1, 2
+  if(t1) print *, 'VolatileNotOptimizedAway'
+  if(t2) print *, 'NonVolatileNotOptimizedAway'
+end do
+end
+! { dg-final { scan-tree-dump "VolatileNotOptimizedAway" "optimized" } } */
+! { dg-final { scan-tree-dump-not "NonVolatileNotOptimizedAway" "optimized" } } */
+! { dg-final { cleanup-tree-dump "optimized" } } */
diff --git a/gcc/testsuite/gfortran.dg/volatile5.f90 b/gcc/testsuite/gfortran.dg/volatile5.f90
new file mode 100644
index 000000000..42607a1e6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile5.f90
@@ -0,0 +1,43 @@
+! { dg-do compile }
+! { dg-options "-O3 -fdump-tree-optimized" }
+! Tests whether volatile really works with modules
+! PR fortran/29601
+module volmod
+  implicit none
+  integer, volatile :: a
+  logical :: b,c
+  volatile :: b
+contains
+  subroutine sample
+    a = 33.
+    if(a /= 432) print *,'aPresent'
+
+    b = .false.
+    if(b) print *,'bPresent'
+
+    c = .false.
+    if(c) print *,'cPresent'
+  end subroutine sample
+end module volmod
+
+program main
+  use volmod
+  implicit none
+
+  a = 432
+  if(a /= 432) print *,'aStillPresent'
+
+  b = .false.
+  if(b)        print *,'bStillPresent'
+
+  c = .false.
+  if(c)        print *,'cStillPresent'
+end program main
+! { dg-final { scan-tree-dump "aPresent" "optimized" } }
+! { dg-final { scan-tree-dump "bPresent" "optimized" } }
+! { dg-final { scan-tree-dump "aStillPresent" "optimized" } }
+! { dg-final { scan-tree-dump "bStillPresent" "optimized" } }
+! { dg-final { scan-tree-dump-not "cPresent" "optimized" } }
+! { dg-final { scan-tree-dump-not "cStillPresent" "optimized" } }
+! { dg-final { cleanup-tree-dump "optimized" } }
+! { dg-final { cleanup-modules "volmod" } }
diff --git a/gcc/testsuite/gfortran.dg/volatile6.f90 b/gcc/testsuite/gfortran.dg/volatile6.f90
new file mode 100644
index 000000000..e42e3de3a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile6.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-optimized" }
+! Tests whether volatile really works for arrays
+! PR fortran/29601
+logical, allocatable, volatile :: t1(:)
+logical, allocatable :: t2(:)
+integer :: i
+
+allocate(t1(1),t2(1))
+t1 = .false.
+t2 = .false.
+do i = 1, 2
+  if(ubound(t1,1) /= 1) print *, 'VolatileNotOptimizedAway1'
+  if(ubound(t2,1) /= 1) print *, 'NonVolatileNotOptimizedAway1'
+end do
+
+t1 = .false.
+if(t1(1)) print *, 'VolatileNotOptimizedAway2'
+t2 = .false.
+if(t2(1)) print *, 'NonVolatileNotOptimizedAway2'
+end
+! { dg-final { scan-tree-dump "VolatileNotOptimizedAway1" "optimized" } }
+! { dg-final { scan-tree-dump "VolatileNotOptimizedAway2" "optimized" } }
+! { dg-final { scan-tree-dump-not "NonVolatileNotOptimizedAway1" "optimized" } }
+! { dg-final { scan-tree-dump-not "NonVolatileNotOptimizedAway2" "optimized" } }
+! { dg-final { cleanup-tree-dump "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/volatile7.f90 b/gcc/testsuite/gfortran.dg/volatile7.f90
new file mode 100644
index 000000000..237a08c07
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile7.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-optimized" }
+! Tests whether volatile really works for pointers
+! PR fortran/29601
+logical, pointer, volatile :: t1
+logical, pointer :: t2
+integer :: i
+
+t1 => NULL(t1)
+if(associated(t1)) print *, 'VolatileNotOptimizedAway'
+t2 => NULL(t2)
+if(associated(t2)) print *, 'NonVolatileNotOptimizedAway'
+end
+! { dg-final { scan-tree-dump "VolatileNotOptimizedAway" "optimized" } }
+! { dg-final { scan-tree-dump-not "NonVolatileNotOptimizedAway" "optimized" } } 
+! { dg-final { cleanup-tree-dump "optimized" } } 
diff --git a/gcc/testsuite/gfortran.dg/volatile8.f90 b/gcc/testsuite/gfortran.dg/volatile8.f90
new file mode 100644
index 000000000..b97b8519b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile8.f90
@@ -0,0 +1,58 @@
+! Check for compatibily of actual arguments
+! with dummy arguments marked as volatile
+! 
+! Contributed by Steven Correll.
+!
+! PR fortran/30520
+
+! { dg-do compile }
+
+   subroutine s8()
+    implicit none
+    interface
+      subroutine sub8(dummy8)
+        integer, volatile, dimension(3) :: dummy8
+      end subroutine sub8
+      subroutine sub8a(dummy8a)
+        integer, volatile, dimension(:) :: dummy8a
+      end subroutine sub8a
+    end interface
+    integer, dimension(8) :: a
+    call sub8 (a(1:5:2)) ! { dg-error "Array-section actual argument" }
+    call sub8a(a(1:5:2))
+  end subroutine s8 
+
+  subroutine s9(s9dummy)
+    implicit none
+    integer, dimension(:) :: s9dummy
+    interface
+      subroutine sub9(dummy9)
+        integer, volatile, dimension(3) :: dummy9
+      end subroutine sub9
+      subroutine sub9a(dummy9a)
+        integer, volatile, dimension(:) :: dummy9a
+      end subroutine sub9a
+    end interface
+    integer, dimension(9) :: a
+    call sub9 (s9dummy) ! { dg-error "Assumed-shape actual argument" }
+    call sub9a(s9dummy)
+  end subroutine s9 
+
+  subroutine s10()
+    implicit none
+    interface
+      subroutine sub10(dummy10)
+        integer, volatile, dimension(3) :: dummy10
+      end subroutine sub10
+      subroutine sub10a(dummy10a)
+        integer, volatile, dimension(:) :: dummy10a
+      end subroutine sub10a
+      subroutine sub10b(dummy10b)
+        integer, volatile, dimension(:), pointer :: dummy10b
+      end subroutine sub10b
+    end interface
+    integer, dimension(:), pointer :: a
+    call sub10 (a) ! { dg-error "Pointer-array actual argument" }
+    call sub10a(a)
+    call sub10b(a)
+  end subroutine s10 
diff --git a/gcc/testsuite/gfortran.dg/volatile9.f90 b/gcc/testsuite/gfortran.dg/volatile9.f90
new file mode 100644
index 000000000..e7cba6b07
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/volatile9.f90
@@ -0,0 +1,44 @@
+! Check for valid VOLATILE uses
+!
+! Contributed by Steven Correll.
+!
+! PR fortran/30520
+
+! { dg-do compile }
+ 
+  function f() result(fr)
+    integer, volatile :: fr
+    fr = 5
+  end function f 
+
+  module mod13
+    implicit none
+    integer :: v13
+  end module mod13 
+
+  module mod13a
+   use mod13
+   implicit none
+   volatile :: v13
+   real :: v14
+  contains
+   subroutine s13()
+     volatile :: v13
+     volatile :: v14
+   end subroutine s13 
+  end module mod13a 
+
+  module mod13b
+   use mod13a
+   implicit none
+   volatile :: v13
+  end module mod13b 
+
+
+  subroutine s14()
+    use mod13a
+    implicit none
+    volatile :: v13
+  end subroutine s14 
+
+! { dg-final { cleanup-modules "mod13 mod13a mod13b" } }
diff --git a/gcc/testsuite/gfortran.dg/warn_align_commons.f90 b/gcc/testsuite/gfortran.dg/warn_align_commons.f90
new file mode 100644
index 000000000..d20b71021
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_align_commons.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-Wno-align-commons" }
+
+! PR fortran/37486
+!
+! Test for -Wno-align-commons.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>.
+
+implicit none
+integer(kind=4) :: n
+real(kind=8) :: p
+common /foo/ n,p   ! { dg-bogus "padding" }
+end  
diff --git a/gcc/testsuite/gfortran.dg/warn_conversion.f90 b/gcc/testsuite/gfortran.dg/warn_conversion.f90
new file mode 100644
index 000000000..e9b7e396e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_conversion.f90
@@ -0,0 +1,61 @@
+! { dg-do compile }
+! { dg-options "-Wconversion" }
+
+!
+! PR fortran/27866 -improve -Wconversion
+!
+SUBROUTINE pr27866
+  double precision :: d
+  real   :: r
+  d = 4d99
+  r = d                 ! { dg-warning "conversion" }
+END SUBROUTINE
+
+SUBROUTINE pr27866c4
+  real(kind=4)    :: a
+  real(kind=8)    :: b
+  integer(kind=1) :: i1
+  integer(kind=4) :: i4
+  i4 = 2.3              ! { dg-warning "conversion" }
+  i1 = 500              ! { dg-error "overflow" }
+  a = 2**26-1           ! assignment INTEGER(4) to REAL(4) - no warning
+  b = 1d999             ! { dg-error "overflow" }
+
+  a = i4                ! assignment INTEGER(4) to REAL(4) - no warning
+  b = i4                ! assignment INTEGER(4) to REAL(8) - no warning
+  i1 = i4               ! { dg-warning "conversion" }
+  a = b                 ! { dg-warning "conversion" }
+END SUBROUTINE
+
+
+!
+! PR fortran/35003 - spurious warning with -Wconversion
+! Contributed by Brian Barnes <bcbarnes AT gmail DOT com>
+!
+SUBROUTINE pr35003
+  IMPLICIT NONE
+  integer(8) :: i, n
+  n = 1_8
+
+  do i = 1_8,n
+  enddo
+END SUBROUTINE
+
+
+!
+! PR fortran/42809 - Too much noise with -Wconversion
+! Contributed by Harald Anlauf <anlauf AT gmx DOT de>
+!
+SUBROUTINE pr42809
+  implicit none
+  integer, parameter :: sp = kind (1.0)
+  integer, parameter :: dp = kind (1.d0)
+  real(sp)     :: s
+  real(dp)     :: d
+  complex(dp)  :: z
+
+  s = 0                 ! assignment INTEGER(4) to REAL(4) - no warning
+  d = s                 ! assignment REAL((8)) to REAL(4) - no warning
+  z = (0, 1)            ! conversion INTEGER(4) to REAL(4),
+                        ! assignment COMPLEX(4) to COMPLEX(8) - no warning
+END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/warn_conversion_2.f90 b/gcc/testsuite/gfortran.dg/warn_conversion_2.f90
new file mode 100644
index 000000000..d2b4eec60
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_conversion_2.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-Wconversion-extra" }
+
+  real(8) :: sqrt2
+  real x
+
+  x = 2.0
+  sqrt2 = sqrt(x)      ! { dg-warning "Conversion" }
+
+  sqrt2 = sqrt(2.0)    ! no warning; simplified to a constant and range checked
+end
diff --git a/gcc/testsuite/gfortran.dg/warn_function_without_result.f90 b/gcc/testsuite/gfortran.dg/warn_function_without_result.f90
new file mode 100644
index 000000000..43af9c9ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_function_without_result.f90
@@ -0,0 +1,57 @@
+! { dg-do compile }
+! { dg-options "-Wreturn-type" }
+!
+! PR fortran/31463 - inconsistent warnings if function return value is not set
+! PR fortran/33950 - Warning missing for function result not set
+! PR fortran/34296 - Intent(out) and character functions with RESULT: Value-not-set warning
+!
+FUNCTION f1()            ! { dg-warning "not set" }
+REAL :: f1
+END FUNCTION
+
+FUNCTION f2()            ! { dg-warning "not set" }
+REAL, DIMENSION(1) :: f2
+END FUNCTION
+
+FUNCTION f3()            ! { dg-warning "not set" }
+REAL, POINTER :: f3
+END FUNCTION
+
+FUNCTION f4()            ! { dg-warning "not set" }
+REAL, DIMENSION(:), POINTER :: f4
+END FUNCTION
+
+FUNCTION f5()            ! { dg-warning "not set" }
+REAL, DIMENSION(:), ALLOCATABLE :: f5
+END FUNCTION
+
+FUNCTION f6()            ! { dg-warning "not set" }
+CHARACTER(2) :: f6
+END FUNCTION
+
+
+
+FUNCTION g1() RESULT(h)  ! { dg-warning "not set" }
+REAL :: h
+END FUNCTION
+
+FUNCTION g2() RESULT(h)  ! { dg-warning "not set" }
+REAL, DIMENSION(1) :: h
+END FUNCTION
+
+FUNCTION g3() RESULT(h)  ! { dg-warning "not set" }
+REAL, POINTER :: h
+END FUNCTION
+
+FUNCTION g4() RESULT(h)  ! { dg-warning "not set" }
+REAL, DIMENSION(:), POINTER :: h
+END FUNCTION
+
+FUNCTION g5() RESULT(h)  ! { dg-warning "not set" }
+REAL, DIMENSION(:), ALLOCATABLE :: h
+END FUNCTION
+
+FUNCTION g6() RESULT(h)  ! { dg-warning "not set" }
+CHARACTER(2) :: h
+END FUNCTION
+
diff --git a/gcc/testsuite/gfortran.dg/warn_function_without_result_2.f90 b/gcc/testsuite/gfortran.dg/warn_function_without_result_2.f90
new file mode 100644
index 000000000..25fd0b73a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_function_without_result_2.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-Wall" }
+!
+! PR fortran/50923
+!
+module m
+contains
+  integer pure function f() ! { dg-warning "Return value of function 'f' at .1. not set" }
+  end function f
+  integer pure function g() result(h) ! { dg-warning "Return value 'h' of function 'g' declared at .1. not set" }
+  end function g
+  integer pure function i()
+    i = 7
+  end function i
+  integer pure function j() result(k)
+    k = 8
+  end function j
+end module m
+! { dg-final { cleanup-modules "mod" } }
diff --git a/gcc/testsuite/gfortran.dg/warn_implicit_procedure_1.f90 b/gcc/testsuite/gfortran.dg/warn_implicit_procedure_1.f90
new file mode 100644
index 000000000..8f21b60e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_implicit_procedure_1.f90
@@ -0,0 +1,43 @@
+! { dg-do compile }
+! { dg-options "-Wimplicit-procedure" }
+
+! PR fortran/22552
+! Check for correct -Wimplicit-procedure warnings.
+
+MODULE m
+
+CONTAINS
+
+  SUBROUTINE my_sub ()
+  END SUBROUTINE my_sub
+
+  INTEGER FUNCTION my_func ()
+    my_func = 42
+  END FUNCTION my_func
+
+END MODULE m
+
+SUBROUTINE test (proc)
+  IMPLICIT NONE
+  CALL proc () ! { dg-bogus "is not explicitly declared" }
+END SUBROUTINE test
+
+PROGRAM main
+  USE m
+  EXTERNAL :: ext_sub
+  EXTERNAL :: test
+  INTEGER :: ext_func
+
+  CALL ext_sub () ! { dg-bogus "is not explicitly declared" }
+  PRINT *, ext_func () ! { dg-bogus "is not explicitly declared" }
+  PRINT *, implicit_func () ! { dg-bogus "is not explicitly declared" }
+  CALL my_sub () ! { dg-bogus "is not explicitly declared" }
+  PRINT *, my_func () ! { dg-bogus "is not explicitly declared" }
+  PRINT *, SIN (3.14159) ! { dg-bogus "is not explicitly declared" }
+
+  CALL undef_sub (1, 2, 3) ! { dg-warning "is not explicitly declared" }
+  ! Can't check undefined function, because it needs to be declared a type
+  ! in any case (and the implicit type is enough to not trigger this warning).
+END PROGRAM
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/warn_intent_out_not_set.f90 b/gcc/testsuite/gfortran.dg/warn_intent_out_not_set.f90
new file mode 100644
index 000000000..76c62eaec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_intent_out_not_set.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! { dg-options "-c -Wall" }
+!
+! PR fortran/42360
+!
+MODULE m
+  TYPE :: t1
+    INTEGER :: a = 42, b
+  END TYPE
+
+  TYPE :: t2
+    INTEGER :: a, b
+  END TYPE
+
+CONTAINS
+  SUBROUTINE sub1(x)             ! no warning, default initializer
+    type(t1), intent(out) :: x
+  END SUBROUTINE
+
+  SUBROUTINE sub2(x)             ! no warning, initialized
+    type(t2), intent(out) :: x
+    x%a = 42
+  END SUBROUTINE
+
+  SUBROUTINE sub3(x)             ! { dg-warning "not set" }
+    type(t2), intent(out) :: x
+  END SUBROUTINE
+END MODULE
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/warn_std_1.f90 b/gcc/testsuite/gfortran.dg/warn_std_1.f90
new file mode 100644
index 000000000..b0e4b5d41
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_std_1.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-std=gnu" }
+!
+! PR fortran/32778 - pedantic warning: intrinsics that 
+!                    are GNU extensions not part of -std=gnu
+!
+! (1/3) Check for excess errors if -std=gnu.
+!
+
+CHARACTER(len=255) :: tmp
+REAL(8) :: x
+
+! GNU extension, check overload of F77 standard intrinsic
+x = ZABS(CMPLX(0.0, 1.0, 8))
+
+! GNU extension
+CALL flush()
+
+! F95
+tmp = ADJUSTL("  gfortran  ")
+
+! F2003
+CALL GET_COMMAND (tmp)
+
+END
diff --git a/gcc/testsuite/gfortran.dg/warn_std_2.f90 b/gcc/testsuite/gfortran.dg/warn_std_2.f90
new file mode 100644
index 000000000..325fc8cb6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_std_2.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-std=f95 -Wintrinsics-std" }
+!
+! PR fortran/32778 - pedantic warning: intrinsics that 
+!                    are GNU extensions not part of -std=gnu
+!
+! (2/3) Check for GNU extensions and intrinsics from F2003 if -std=f95.
+!
+
+CHARACTER(len=255) :: tmp
+REAL(8) :: x
+
+! GNU extension, check overload of F77 standard intrinsic
+x = ZABS(CMPLX(0.0, 1.0, 8))    ! { dg-warning "extension" }
+
+! GNU extension
+CALL flush()                    ! { dg-warning "extension" }
+
+! F95
+tmp = ADJUSTL("  gfortran  ")
+
+! F2003
+CALL GET_COMMAND (tmp)          ! { dg-warning "Fortran 2003" }
+
+END
diff --git a/gcc/testsuite/gfortran.dg/warn_std_3.f90 b/gcc/testsuite/gfortran.dg/warn_std_3.f90
new file mode 100644
index 000000000..89fe25738
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_std_3.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-std=f2003 -Wintrinsics-std" }
+!
+! PR fortran/32778 - pedantic warning: intrinsics that 
+!                    are GNU extensions not part of -std=gnu
+!
+! (3/3) Check for GNU extensions if -std=f2003.
+!
+
+CHARACTER(len=255) :: tmp
+REAL(8) :: x
+
+! GNU extension, check overload of F77 standard intrinsic
+x = ZABS(CMPLX(0.0, 1.0, 8))    ! { dg-warning "extension" }
+
+! GNU extension
+CALL flush()                    ! { dg-warning "extension" }
+
+! F95
+tmp = ADJUSTL("  gfortran  ")
+
+! F2003
+CALL GET_COMMAND (tmp)
+
+END
diff --git a/gcc/testsuite/gfortran.dg/warn_unused_dummy_argument_1.f90 b/gcc/testsuite/gfortran.dg/warn_unused_dummy_argument_1.f90
new file mode 100644
index 000000000..66b0f1a58
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_unused_dummy_argument_1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-Wall" }
+!
+! PR fortran/38407
+!
+
+SUBROUTINE s(dummy)                ! { dg-warning "Unused dummy" }
+  INTEGER, INTENT(in) :: dummy
+  INTEGER :: variable              ! { dg-warning "Unused variable" }
+END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/warn_unused_dummy_argument_2.f90 b/gcc/testsuite/gfortran.dg/warn_unused_dummy_argument_2.f90
new file mode 100644
index 000000000..6a2233ba0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_unused_dummy_argument_2.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-Wall -Wno-unused-dummy-argument" }
+!
+! PR fortran/38407
+!
+
+SUBROUTINE s(dummy)
+  INTEGER, INTENT(in) :: dummy
+  INTEGER :: variable              ! { dg-warning "Unused variable" }
+END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/warn_unused_var.f90 b/gcc/testsuite/gfortran.dg/warn_unused_var.f90
new file mode 100644
index 000000000..1858e6852
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_unused_var.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! { dg-options "-Wunused-variable" }
+!
+! PR fortran/37420
+!
+integer :: i ! { dg-warning "Unused variable" }
+end
diff --git a/gcc/testsuite/gfortran.dg/warning-directive-1.F90 b/gcc/testsuite/gfortran.dg/warning-directive-1.F90
new file mode 100644
index 000000000..5f5931572
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warning-directive-1.F90
@@ -0,0 +1,5 @@
+! { dg-do preprocess }
+! { dg-options "-std=f95 -fdiagnostics-show-option" }
+
+#warning "Printed"
+! { dg-warning "\"Printed\" .-Wcpp." "" { target *-*-* } 4 }
diff --git a/gcc/testsuite/gfortran.dg/warning-directive-2.F90 b/gcc/testsuite/gfortran.dg/warning-directive-2.F90
new file mode 100644
index 000000000..7e4418530
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warning-directive-2.F90
@@ -0,0 +1,5 @@
+! { dg-do preprocess }
+! { dg-options "-std=f95 -fdiagnostics-show-option -Werror=cpp" }
+! { dg-message "some warnings being treated as errors" "" {target "*-*-*"} 0 } 
+#warning "Printed"
+! { dg-error "\"Printed\" .-Werror=cpp." "" { target *-*-* } 4 }
diff --git a/gcc/testsuite/gfortran.dg/warning-directive-3.F90 b/gcc/testsuite/gfortran.dg/warning-directive-3.F90
new file mode 100644
index 000000000..aa20c1942
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warning-directive-3.F90
@@ -0,0 +1,5 @@
+! { dg-do preprocess }
+! { dg-options "-std=f95 -fdiagnostics-show-option -Werror -Wno-error=cpp" }
+
+#warning "Printed"
+! { dg-warning "\"Printed\" .-Wcpp." "" { target *-*-* } 4 }
diff --git a/gcc/testsuite/gfortran.dg/warning-directive-4.F90 b/gcc/testsuite/gfortran.dg/warning-directive-4.F90
new file mode 100644
index 000000000..a5c381149
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warning-directive-4.F90
@@ -0,0 +1,5 @@
+! { dg-do preprocess }
+! { dg-options "-std=f95 -fdiagnostics-show-option -Wno-cpp" }
+
+#warning "Not printed"
+! { dg-bogus "." "" { target *-*-* } 4 }
diff --git a/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f b/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f
new file mode 100644
index 000000000..56465a9c0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options " -Werror" }
+! PR fortran/21061
+! gfortran ignores -Werror
+! fixed-form tests
+       program warnings_are_errors_1
+       implicit none
+       integer(kind=1) :: i
+       real :: r1, r2(3)
+! gfc_warning_now:
+0      r1 = 0 ! { dg-warning "Zero is not a valid statement label" }
+!
+34 5   i=0 
+! gfc_notify_std(GFC_STD_F95_DEL):
+       do r1 = 1, 2 ! { dg-warning "Deleted feature: Loop variable" }
+         i = i+1
+       end do
+       call foo j bar
+! gfc_warning:
+       r2(4) = 0 ! { dg-warning "is out of bounds" }
+       
+       goto 3 45
+       end
+! { dg-final { output-exists-not } }
diff --git a/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90 b/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90
new file mode 100644
index 000000000..0a0883c67
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-Werror -Wunused -std=f95" }
+! PR fortran/21061
+! gfortran ignores -Werror
+! free-form tests
+
+! gfc_notify_std:
+       function char_ (ch) ! { dg-warning "Obsolescent feature" }
+       character(*) :: char_, ch
+        char_ = ch
+       end function char_
+
+! warning(0,...):
+!      function wrong_warn (i) ! { -warning "Function does not return a value" }
+!      integer i
+!      end function wrong_warn
+
+       implicit none
+! gfc_warning:
+1234  complex :: cplx ! { dg-warning "defined but cannot be used" }
+      cplx = 20.
+
+! gfc_warning_now:
+ 1 ! { dg-warning "Ignoring statement label in empty statement" }
+       end
+! { dg-final { output-exists-not } }
diff --git a/gcc/testsuite/gfortran.dg/where_1.f90 b/gcc/testsuite/gfortran.dg/where_1.f90
new file mode 100644
index 000000000..0f5b5e77b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/where_1.f90
@@ -0,0 +1,64 @@
+! { dg-do run }
+! Tests the fix for PR35759 and PR35756 in which the dependencies
+! led to an incorrect use of the "simple where", gfc_trans_where_3.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+  logical :: la(6) = (/(2*(i/2) /= i, i = 1, 6)/), lb(6)
+  CALL PR35759
+  CALL PR35756
+!
+! The first version of the fix caused this to regress as pointed
+! out by Dominique d'Humieres
+!
+  lb = la
+  where(la)
+    la = .false.
+  elsewhere
+    la = .true.
+  end where
+  if (any(la .eqv. lb)) call abort()
+CONTAINS
+  subroutine PR35759
+    integer UDA1L(6)
+    integer ::  UDA1R(6), expected(6) = (/2,0,5,0,3,0/)
+    LOGICAL LDA(5)
+    UDA1L(1:6) = 0
+    uda1r = (/1,2,3,4,5,6/)
+    lda = (/ (i/2*2 .ne. I, i=1,5) /)
+    WHERE (LDA)
+      UDA1L(1:5) = UDA1R(2:6)
+    ELSEWHERE
+      UDA1L(2:6) = UDA1R(6:2:-1)
+    ENDWHERE
+    if (any (expected /= uda1l)) call abort
+  END subroutine
+
+  SUBROUTINE PR35756
+    INTEGER  ILA(10), CLA(10)
+    LOGICAL  LDA(10)
+    ILA = (/ (I, i=1,10) /)
+    LDA = (/ (i/2*2 .ne. I, i=1,10) /)
+    WHERE(LDA)
+      CLA = 10
+    ELSEWHERE
+      CLA = 2
+    ENDWHERE
+    WHERE(LDA)
+      ILA = R_MY_MAX_I(ILA)
+    ELSEWHERE
+      ILA = R_MY_MIN_I(ILA)
+    ENDWHERE
+    IF (any (CLA /= ILA)) call abort
+  end subroutine
+
+  INTEGER FUNCTION R_MY_MAX_I(A)
+    INTEGER  ::  A(:)
+    R_MY_MAX_I = MAXVAL(A)
+  END FUNCTION R_MY_MAX_I
+
+  INTEGER FUNCTION R_MY_MIN_I(A)
+    INTEGER  ::  A(:)
+    R_MY_MIN_I = MINVAL(A)
+  END FUNCTION R_MY_MIN_I
+END
diff --git a/gcc/testsuite/gfortran.dg/where_2.f90 b/gcc/testsuite/gfortran.dg/where_2.f90
new file mode 100644
index 000000000..b6e952b20
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/where_2.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! Tests the fix for PR35743 and PR35745.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+program try_rg0025
+  logical lda(5)
+  lda = (/(i/2*2 .ne. I, i=1,5)/)
+  call PR35743 (lda,  1,  2,  3,  5,  6, -1, -2)
+  CALL PR34745
+end program
+
+! Previously, the negative mask size would not be detected.
+SUBROUTINE PR35743 (LDA,nf1,nf2,nf3,nf5,nf6,mf1,mf2)
+  type unseq
+    real  r
+  end type unseq
+  TYPE(UNSEQ) TDA1L(6)
+  LOGICAL LDA(NF5)
+  TDA1L(1:6)%r = 1.0
+  WHERE (LDA(NF6:NF3))
+    TDA1L(MF1:NF5:MF1) = TDA1L(NF6:NF2)
+  ENDWHERE
+END SUBROUTINE
+
+! Previously, the expression in the WHERE block would be evaluated
+! ouside the loop generated by the where.
+SUBROUTINE PR34745
+  INTEGER IDA(10)
+  REAL RDA(10)
+  RDA    = 1.0
+  nf0 = 0
+  WHERE (RDA < -15.0)
+    IDA = 1/NF0 + 2
+  ENDWHERE
+END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/where_3.f90 b/gcc/testsuite/gfortran.dg/where_3.f90
new file mode 100644
index 000000000..1507ad982
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/where_3.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+! PR fortran/50129
+! ICE after reporting an error on a masked ELSEWHERE statement following an
+! unmasked one.
+!
+! Contributed by Joost Van de Vondele <Joost.VandeVondele@pci.uzh.ch>
+
+INTEGER :: I(3)
+WHERE (I>2)
+ELSEWHERE
+ELSEWHERE (I<1) ! { dg-error "follows previous unmasked ELSEWHERE" }
+END WHERE
+END
+
diff --git a/gcc/testsuite/gfortran.dg/where_nested_1.f90 b/gcc/testsuite/gfortran.dg/where_nested_1.f90
new file mode 100644
index 000000000..c28cfcd96
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/where_nested_1.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! PR 25423: Nested WHERE constructs.
+program nested_where
+
+    implicit none
+    integer :: a(4)
+    logical :: mask1(4) = (/.TRUE., .TRUE., .FALSE., .FALSE./), &
+               mask2(4) = (/.TRUE., .FALSE., .TRUE., .FALSE./)
+
+    where (mask1)
+        where (mask2)
+            a = 1
+        elsewhere
+            a = 2
+        end where
+    elsewhere
+        where (mask2)
+            a = 3
+        elsewhere
+            a = 4
+        end where
+    end where
+
+    print *, a
+
+end program nested_where
diff --git a/gcc/testsuite/gfortran.dg/where_operator_assign_1.f90 b/gcc/testsuite/gfortran.dg/where_operator_assign_1.f90
new file mode 100644
index 000000000..c2b4abf85
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/where_operator_assign_1.f90
@@ -0,0 +1,108 @@
+! { dg-do compile }
+! Tests the fix for PR30407, in which operator assignments did not work
+! in WHERE blocks or simple WHERE statements.  This is the test provided
+! by the reporter.
+!
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+!==============================================================================
+
+MODULE kind_mod
+
+   IMPLICIT NONE
+
+   PRIVATE
+
+   INTEGER, PUBLIC, PARAMETER :: I4=SELECTED_INT_KIND(9)
+   INTEGER, PUBLIC, PARAMETER :: TF=KIND(.TRUE._I4)
+
+END MODULE kind_mod
+
+!==============================================================================
+
+MODULE pointer_mod
+
+   USE kind_mod, ONLY : I4
+
+   IMPLICIT NONE
+
+   PRIVATE
+
+   TYPE, PUBLIC :: pvt
+      INTEGER(I4), POINTER, DIMENSION(:) :: vect
+   END TYPE pvt
+
+   INTERFACE ASSIGNMENT(=)
+      MODULE PROCEDURE p_to_p
+   END INTERFACE
+
+   PUBLIC :: ASSIGNMENT(=)
+
+CONTAINS
+
+   !---------------------------------------------------------------------------
+
+   PURE ELEMENTAL SUBROUTINE p_to_p(a1, a2)
+      IMPLICIT NONE
+      TYPE(pvt), INTENT(OUT) :: a1
+      TYPE(pvt), INTENT(IN) :: a2
+      a1%vect = a2%vect
+   END SUBROUTINE p_to_p
+
+   !---------------------------------------------------------------------------
+
+END MODULE pointer_mod
+
+!==============================================================================
+
+PROGRAM test_prog
+
+   USE pointer_mod, ONLY : pvt, ASSIGNMENT(=)
+
+   USE kind_mod, ONLY : I4, TF
+
+   IMPLICIT NONE
+
+   INTEGER(I4), DIMENSION(12_I4), TARGET :: ia
+   LOGICAL(TF), DIMENSION(2_I4,3_I4) :: la
+   TYPE(pvt), DIMENSION(6_I4) :: pv
+   INTEGER(I4) :: i
+
+   ! Initialisation...
+   la(:,1_I4:3_I4:2_I4)=.TRUE._TF
+   la(:,2_I4)=.FALSE._TF
+
+   DO i=1_I4,6_I4
+      pv(i)%vect => ia((2_I4*i-1_I4):(2_I4*i))
+   END DO
+
+   ia=0_I4
+
+   DO i=1_I4,3_I4
+      WHERE(la((/1_I4,2_I4/),i))
+         pv((2_I4*i-1_I4):(2_I4*i))= iaef((/(2_I4*i-1_I4),(2_I4*i)/))
+      ELSEWHERE
+         pv((2_I4*i-1_I4):(2_I4*i))= iaef((/0_I4,0_I4/))
+      END WHERE
+   END DO
+
+   if (any (ia .ne. (/1,-1,2,-2,0,0,0,0,5,-5,6,-6/))) call abort ()
+
+CONTAINS
+
+   TYPE(pvt) ELEMENTAL FUNCTION iaef(index) RESULT(ans)
+
+      USE kind_mod, ONLY :  I4
+      USE pointer_mod, ONLY : pvt, ASSIGNMENT(=)
+
+      IMPLICIT NONE
+
+      INTEGER(I4), INTENT(IN) :: index
+
+      ALLOCATE(ans%vect(2_I4))
+      ans%vect=(/index,-index/)
+
+   END FUNCTION iaef
+
+END PROGRAM test_prog
+
+! { dg-final { cleanup-modules "kind_mod pointer_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/where_operator_assign_2.f90 b/gcc/testsuite/gfortran.dg/where_operator_assign_2.f90
new file mode 100644
index 000000000..420103f19
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/where_operator_assign_2.f90
@@ -0,0 +1,106 @@
+! { dg-do compile }
+! Tests the fix for PR30407, in which operator assignments did not work
+! in WHERE blocks or simple WHERE statements.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!******************************************************************************
+module global
+  type :: a
+    integer :: b
+    integer :: c
+  end type a
+  interface assignment(=)
+    module procedure a_to_a
+  end interface
+  interface operator(.ne.)
+    module procedure a_ne_a
+  end interface
+
+  type(a) :: x(4), y(4), z(4), u(4, 4)
+  logical :: l1(4), t = .true., f= .false.
+contains
+!******************************************************************************
+  elemental subroutine a_to_a (m, n)
+    type(a), intent(in) :: n
+    type(a), intent(out) :: m
+    m%b = n%b + 1
+    m%c = n%c
+  end subroutine a_to_a
+!******************************************************************************
+  elemental logical function a_ne_a (m, n)
+    type(a), intent(in) :: n
+    type(a), intent(in) :: m
+    a_ne_a = (m%b .ne. n%b) .or. (m%c .ne. n%c)
+  end function a_ne_a
+!******************************************************************************
+  elemental function foo (m)
+    type(a) :: foo
+    type(a), intent(in) :: m
+    foo%b = 0
+    foo%c = m%c
+  end function foo  
+end module global
+!******************************************************************************
+program test
+  use global
+  x = (/a (0, 1),a (0, 2),a (0, 3),a (0, 4)/)
+  y = x
+  z = x
+  l1 = (/t, f, f, t/)
+
+  call test_where_1
+  if (any (y .ne. (/a (2, 1),a (2, 2),a (2, 3),a (2, 4)/))) call abort ()
+
+  call test_where_2
+  if (any (y .ne. (/a (1, 0),a (2, 2),a (2, 3),a (1, 0)/))) call abort ()
+  if (any (z .ne. (/a (3, 4),a (1, 0),a (1, 0),a (3, 1)/))) call abort ()
+
+  call test_where_3
+  if (any (y .ne. (/a (1, 0),a (1, 2),a (1, 3),a (1, 0)/))) call abort ()
+
+  y = x
+  call test_where_forall_1
+  if (any (u(4, :) .ne. (/a (1, 4),a (2, 2),a (2, 3),a (1, 4)/))) call abort ()
+
+  l1 = (/t, f, t, f/)
+  call test_where_4
+  if (any (x .ne. (/a (1, 1),a (2, 1),a (1, 3),a (2, 3)/))) call abort ()
+
+contains
+!******************************************************************************
+  subroutine test_where_1        ! Test a simple WHERE
+    where (l1) y = x
+  end subroutine test_where_1
+!******************************************************************************
+  subroutine test_where_2        ! Test a WHERE blocks
+    where (l1)
+      y = a (0, 0)
+      z = z(4:1:-1)
+    elsewhere
+      y = x
+      z = a (0, 0)
+    end where
+  end subroutine test_where_2
+!******************************************************************************
+  subroutine test_where_3        ! Test a simple WHERE with a function assignment
+    where (.not. l1) y = foo (x)
+  end subroutine test_where_3
+!******************************************************************************
+  subroutine test_where_forall_1 ! Test a WHERE in a FORALL block
+    forall (i = 1:4)
+      where (.not. l1)
+        u(i, :) = x
+      elsewhere
+        u(i, :) = a(0, i)
+      endwhere
+    end forall
+  end subroutine test_where_forall_1
+!******************************************************************************
+  subroutine test_where_4       ! Test a WHERE assignment with dependencies
+    where (l1(1:3))
+      x(2:4) = x(1:3)
+    endwhere
+  end subroutine test_where_4
+end program test 
+! { dg-final { cleanup-modules "global" } }
+
diff --git a/gcc/testsuite/gfortran.dg/where_operator_assign_3.f90 b/gcc/testsuite/gfortran.dg/where_operator_assign_3.f90
new file mode 100644
index 000000000..eddbdfc00
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/where_operator_assign_3.f90
@@ -0,0 +1,81 @@
+! { dg-do compile }
+! Tests the fix for PR30407, in which operator assignments did not work
+! in WHERE blocks or simple WHERE statements. This tests that the character
+! lengths are transmitted OK.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!******************************************************************************
+module global
+  type :: a
+    integer :: b
+    character(8):: c
+  end type a
+  interface assignment(=)
+    module procedure a_to_a, c_to_a, a_to_c
+  end interface
+  interface operator(.ne.)
+    module procedure a_ne_a
+  end interface
+
+  type(a) :: x(4), y(4)
+  logical :: l1(4), t = .true., f= .false.
+contains
+!******************************************************************************
+  elemental subroutine a_to_a (m, n)
+    type(a), intent(in) :: n
+    type(a), intent(out) :: m
+    m%b = len ( trim(n%c))
+    m%c = n%c
+  end subroutine a_to_a
+  elemental subroutine c_to_a (m, n)
+    character(8), intent(in) :: n
+    type(a), intent(out) :: m
+    m%b = m%b + 1
+    m%c = n
+  end subroutine c_to_a
+  elemental subroutine a_to_c (m, n)
+    type(a), intent(in) :: n
+    character(8), intent(out) :: m
+    m = n%c
+  end subroutine a_to_c
+!******************************************************************************
+  elemental logical function a_ne_a (m, n)
+    type(a), intent(in) :: n
+    type(a), intent(in) :: m
+    a_ne_a = (m%b .ne. n%b) .or. (m%c .ne. n%c)
+  end function a_ne_a
+!******************************************************************************
+  elemental function foo (m)
+    type(a) :: foo
+    type(a), intent(in) :: m
+    foo%b = 0
+    foo%c = m%c
+  end function foo  
+end module global
+!******************************************************************************
+program test
+  use global
+  x = (/a (0, "one"),a (0, "two"),a (0, "three"),a (0, "four")/)
+  y = x
+  l1 = (/t,f,f,t/)
+
+  call test_where_char1
+  call test_where_char2
+  if (any(y .ne. &
+    (/a(4, "null"), a(8, "non-null"), a(8, "non-null"), a(4, "null")/))) call abort ()
+contains
+  subroutine test_where_char1   ! Test a WHERE blocks
+    where (l1)
+      y = a (0, "null")
+    elsewhere
+      y = x
+    end where
+  end subroutine test_where_char1
+  subroutine test_where_char2   ! Test a WHERE blocks
+    where (y%c .ne. "null")
+      y = a (99, "non-null")
+    endwhere
+  end subroutine test_where_char2
+end program test 
+! { dg-final { cleanup-modules "global" } }
+
diff --git a/gcc/testsuite/gfortran.dg/where_operator_assign_4.f90 b/gcc/testsuite/gfortran.dg/where_operator_assign_4.f90
new file mode 100644
index 000000000..e1c479e5f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/where_operator_assign_4.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! PR fortran/34661 ICE on user-defined assignments in where statements
+! Testcase contributed by Joost VandeVondele
+
+MODULE M1
+ IMPLICIT NONE
+ TYPE T1
+   INTEGER :: I
+ END TYPE T1
+ INTERFACE ASSIGNMENT(=)
+  MODULE PROCEDURE S1
+ END INTERFACE
+CONTAINS
+ SUBROUTINE S1(I,J)
+   TYPE(T1), INTENT(OUT)  :: I(2)
+   TYPE(T1), INTENT(IN)  :: J(2)
+   I%I=-J%I
+ END SUBROUTINE S1
+END MODULE M1
+
+USE M1
+TYPE(T1) :: I(2),J(2)
+I(:)%I=1
+WHERE (I(:)%I>0)
+ J=I                       ! { dg-error "Non-ELEMENTAL user-defined assignment in WHERE" }
+END WHERE
+
+WHERE (I(:)%I>0) J=I       ! { dg-error "Non-ELEMENTAL user-defined assignment in WHERE" }
+
+END
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_1.f90 b/gcc/testsuite/gfortran.dg/whole_file_1.f90
new file mode 100644
index 000000000..598c9d319
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_1.f90
@@ -0,0 +1,60 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file" }
+! Tests the fix for PR22571 in which the derived types in a, b
+! c and d were not detected to be different.  In e and f, they
+! are the same because they are sequence types.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+subroutine a(p)
+  type t
+    integer :: t1
+  end type
+  type(t) :: p
+  p%t1 = 42
+end subroutine
+
+subroutine b
+  type u
+    integer :: u1
+  end type
+  type (u) :: q
+  call a(q)  ! { dg-warning "Type mismatch" }
+  print *, q%u1
+end subroutine
+
+subroutine c(p)
+  type u
+    integer :: u1
+  end type
+  type(u) :: p
+  p%u1 = 42
+end subroutine
+
+subroutine d
+  type u
+    integer :: u1
+  end type
+  type (u) :: q
+  call c(q)  ! { dg-warning "Type mismatch" }
+  print *, q%u1
+end subroutine
+
+subroutine e(p)
+  type u
+    sequence
+    integer :: u1
+  end type
+  type(u) :: p
+  p%u1 = 42
+end subroutine
+
+subroutine f
+  type u
+    sequence
+    integer :: u1
+  end type
+  type (u) :: q
+  call e(q)  ! This is OK because the types are sequence.
+  print *, q%u1
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/whole_file_10.f90 b/gcc/testsuite/gfortran.dg/whole_file_10.f90
new file mode 100644
index 000000000..fb100bb0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_10.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file" }
+! Test the fix for the fifth problem in PR40011, where the
+! entries were not resolved, resulting in a segfault.
+!
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+!
+recursive function fac(i) result (res)
+  integer :: i, j, k, res
+  k = 1
+  goto 100
+entry bifac(i,j) result (res)
+  k = j
+100 continue
+  if (i < k) then
+    res = 1
+  else
+    res = i * bifac(i-k,k)
+  end if
+end function
+
+program test
+  external fac
+  external bifac
+  integer :: fac, bifac
+  print *, fac(5)
+  print *, bifac(5,2)
+  print*, fac(6)
+  print *, bifac(6,2)
+  print*, fac(0)
+  print *, bifac(1,2)
+end program test
diff --git a/gcc/testsuite/gfortran.dg/whole_file_11.f90 b/gcc/testsuite/gfortran.dg/whole_file_11.f90
new file mode 100644
index 000000000..d50e48107
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_11.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file" }
+!
+! Tests the fix PR40011 comment 16 in which the derived type lists in
+! different program units were getting mixed up.
+!
+! Contributed by Daniel Franck  <dfranke@gcc.gnu.org>
+!
+MODULE module_foo
+  TYPE :: foo_node
+    TYPE(foo_node_private), POINTER :: p
+  END TYPE
+
+  TYPE :: foo_node_private
+    TYPE(foo_node), DIMENSION(-1:1) :: link
+  END TYPE
+
+  TYPE :: foo
+    TYPE(foo_node) :: root
+  END TYPE
+END MODULE
+
+FUNCTION foo_insert()
+  USE module_foo, ONLY: foo, foo_node
+
+  INTEGER :: foo_insert
+  TYPE(foo_node) :: parent, current
+  INTEGER :: cmp
+
+  parent  = current
+  current = current%p%link(cmp)
+END FUNCTION
+
+FUNCTION foo_count()
+  USE module_foo, ONLY: foo
+  INTEGER :: foo_count
+END FUNCTION
+
+! { dg-final { cleanup-modules "module_foo" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_12.f90 b/gcc/testsuite/gfortran.dg/whole_file_12.f90
new file mode 100644
index 000000000..150ac5f9d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_12.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file" }
+!
+! Tests the fix PR40011 comment 17 in which the explicit interface was
+! being ignored and the missing argument was not correctly handled, which
+! led to an ICE.
+!
+! Contributed by Dominique d'Humieres  <dominiq@lps.ens.fr
+!
+          Implicit None 
+          call sub(1,2) 
+          call sub(1,2,3)
+ 
+          contains
+
+          subroutine sub(i,j,k) 
+          Implicit None 
+          Integer, Intent( In )           :: i 
+          Integer, Intent( In )           :: j 
+          Integer, Intent( In ), Optional :: k 
+          intrinsic present 
+          write(*,*)' 3 presence flag ',present(k) 
+          write(*,*)' 1st arg ',i 
+          write(*,*)' 2nd arg ',j 
+          if (present(k)) then 
+            write(*,*)' 3rd arg ',k 
+          else 
+            write(*,*)' 3rd arg is absent' 
+          endif 
+          return 
+          end subroutine
+
+          end
diff --git a/gcc/testsuite/gfortran.dg/whole_file_13.f90 b/gcc/testsuite/gfortran.dg/whole_file_13.f90
new file mode 100644
index 000000000..99e3ceecb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_13.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-options "-fwhole-file -O3" }
+! Check that the TYPE_CANONICAL is being correctly set
+! for the derived types, when whole file compiling.
+! (based on import.f90)
+!
+subroutine test(x)
+  type myType3
+    sequence
+    integer :: i
+  end type myType3
+  type(myType3) :: x
+  if(x%i /= 7) call abort()
+  x%i = 1
+end subroutine test
+
+
+program foo
+  type myType3
+    sequence
+    integer :: i
+  end type myType3
+
+  type(myType3) :: z
+  z%i = 7
+  call test(z)
+  if(z%i /= 1) call abort
+end program foo
diff --git a/gcc/testsuite/gfortran.dg/whole_file_14.f90 b/gcc/testsuite/gfortran.dg/whole_file_14.f90
new file mode 100644
index 000000000..65058960b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_14.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-options "-fwhole-file -O3" }
+! Check that the derived types are correctly substituted when
+! whole file compiling.
+!
+! Contributed by Dominique d'Humieres  <dominiq@lps.ens.fr
+!
+module global
+ type                                ::  mytype
+   type(mytype),pointer   ::  this
+ end type mytype
+ type(mytype),target        :: base
+end module global
+
+program test_equi
+  use global
+  call check()
+  print *, "base%this%this=>base?"  ,  associated(base%this%this,base)
+  print *, "base%this%this=>?" ,          associated(base%this%this)
+  print *, "base%this=>?" ,                   associated(base%this)
+contains
+  subroutine check()
+    type(mytype),target        :: j
+    base%this => j                      !have the variables point
+    j%this => base                      !to one another
+  end subroutine check                  !take j out of scope
+end program test_equi
+! { dg-final { cleanup-modules "global" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_15.f90 b/gcc/testsuite/gfortran.dg/whole_file_15.f90
new file mode 100644
index 000000000..08d612044
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_15.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file" }
+! Test the fix for PR43450 in which the use of 'replica_env_type'
+! caused an ICE in ep_types
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+MODULE replica_types
+  TYPE replica_env_type
+  END TYPE replica_env_type
+CONTAINS
+  SUBROUTINE rep_env_create(rep_env, para_env, input, nrep, prep,&
+       sync_v,keep_wf_history,row_force)
+  END SUBROUTINE rep_env_create
+  SUBROUTINE rep_envs_add_rep_env(rep_env)
+    TYPE(replica_env_type), POINTER          :: rep_env
+  END SUBROUTINE rep_envs_add_rep_env
+END MODULE replica_types
+MODULE ep_types
+  USE replica_types
+  TYPE ep_env_type
+     TYPE(replica_env_type), POINTER :: mol_envs
+  END TYPE ep_env_type
+  TYPE ep_env_p_type
+     TYPE(ep_env_type), POINTER :: ep_env
+  END TYPE ep_env_p_type
+  TYPE(ep_env_p_type), DIMENSION(:), POINTER :: ep_envs
+CONTAINS
+  SUBROUTINE ep_force_release()
+  END SUBROUTINE ep_force_release
+END MODULE ep_types
+! { dg-final { cleanup-modules "replica_types ep_types" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_16.f90 b/gcc/testsuite/gfortran.dg/whole_file_16.f90
new file mode 100644
index 000000000..048350f1d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_16.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file" }
+!
+! PR fortran/31346
+!
+program main
+  real, dimension(2) :: a
+  call foo(a)                ! { dg-error "must have an explicit interface" }
+end program main
+
+subroutine foo(a)
+  real, dimension(:) :: a
+end subroutine foo
diff --git a/gcc/testsuite/gfortran.dg/whole_file_17.f90 b/gcc/testsuite/gfortran.dg/whole_file_17.f90
new file mode 100644
index 000000000..86272b848
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_17.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file" }
+!
+! PR fortran/30668
+!
+
+integer(8) function two()
+  two = 2
+end function two
+
+CHARACTER(len=8) function string()
+  string = "gfortran"
+end function string
+
+
+program xx
+  INTEGER :: a
+  CHARACTER(len=4) :: s, string   ! { dg-error "Character length mismatch" }
+
+  a = two()                       ! { dg-error "Return type mismatch" }
+  s = string()
+end program xx
diff --git a/gcc/testsuite/gfortran.dg/whole_file_18.f90 b/gcc/testsuite/gfortran.dg/whole_file_18.f90
new file mode 100644
index 000000000..f758408f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_18.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file -Wno-unused-dummy-argument" }
+!
+! PR fortran/34260
+!
+      PROGRAM MAIN
+      REAL A
+      CALL SUB(A)             ! { dg-error "requires an explicit interface" }
+      END PROGRAM
+
+      SUBROUTINE SUB(A,I)
+      REAL :: A
+      INTEGER, OPTIONAL :: I
+      END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/whole_file_19.f90 b/gcc/testsuite/gfortran.dg/whole_file_19.f90
new file mode 100644
index 000000000..56f3cb69d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_19.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file" }
+! Test the fix for pr40011 comment #42, in which the subroutine
+! would just get lost with -fwhole-file.
+!
+! Contributed by Joost VandeVandole <jv244@cam.ac.uk>
+!
+SUBROUTINE c()
+ CALL a()
+END SUBROUTINE c
+
+SUBROUTINE a()
+END SUBROUTINE a
+
+MODULE M
+CONTAINS
+ SUBROUTINE b()
+   CALL c()
+ END SUBROUTINE
+END MODULE
+
+USE M
+CALL b()
+END
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_2.f90 b/gcc/testsuite/gfortran.dg/whole_file_2.f90
new file mode 100644
index 000000000..4e33c06b6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_2.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file" }
+! Tests the fix for PR26227 in which the interface mismatches
+! below were not detected.
+!
+! Contributed by Andrew Pinski <pinskia@gcc.gnu.org>
+!
+function a(b)
+REAL ::b
+b = 2.0
+a = 1.0
+end function
+
+program gg
+real :: h
+character (5) :: chr = 'hello'
+h = a(); ! { dg-warning "Missing actual argument" }
+call test ([chr]) ! { dg-warning "Rank mismatch" }
+end program gg
+
+subroutine test (a)
+  character (5) :: a
+  if (a .ne. 'hello') call abort
+end subroutine test
+
diff --git a/gcc/testsuite/gfortran.dg/whole_file_20.f03 b/gcc/testsuite/gfortran.dg/whole_file_20.f03
new file mode 100644
index 000000000..61e2a4df9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_20.f03
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file -fcoarray=single" }
+!
+! Procedures with dummy arguments that are coarrays or polymorphic
+! must have an explicit interface in the calling routine.
+!
+
+MODULE classtype
+  type :: t
+    integer :: comp
+  end type
+END MODULE
+
+PROGRAM main
+  USE classtype
+  CLASS(t), POINTER :: tt
+
+  INTEGER :: coarr[*]
+
+  CALL coarray(coarr)         ! { dg-error " must have an explicit interface" }
+  CALL polymorph(tt)          ! { dg-error " must have an explicit interface" }
+END PROGRAM
+
+SUBROUTINE coarray(a)
+  INTEGER :: a[*]
+END SUBROUTINE
+
+SUBROUTINE polymorph(b)
+  USE classtype
+  CLASS(t) :: b
+END SUBROUTINE
+
+! { dg-final { cleanup-modules "classtype" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_21.f90 b/gcc/testsuite/gfortran.dg/whole_file_21.f90
new file mode 100644
index 000000000..2bd979dd4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_21.f90
@@ -0,0 +1,27 @@
+! { dg-do link }
+! PR fortran/40011
+!
+! Contributed by Joost VandeVondele
+!
+!
+! Before no "one" function was generated with -fwhole-file.
+!
+!
+SUBROUTINE one ( )
+END SUBROUTINE one
+
+SUBROUTINE two ( )
+END SUBROUTINE two
+
+MODULE mod
+CONTAINS
+  SUBROUTINE three ( )
+    CALL two ( )
+  END SUBROUTINE three
+  SUBROUTINE four ( )
+      CALL one ( )
+  END SUBROUTINE four
+END MODULE mod
+END
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_22.f90 b/gcc/testsuite/gfortran.dg/whole_file_22.f90
new file mode 100644
index 000000000..4e229207c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_22.f90
@@ -0,0 +1,38 @@
+! { dg-do link }
+! { dg-options "-fwhole-program -O3 -g" }
+!
+! PR fortran/40873
+!
+      program prog
+        call one()
+        call two()
+        call test()
+      end program prog
+      subroutine one()
+        call three()
+      end subroutine one
+      subroutine two()
+        call three()
+      end subroutine two
+      subroutine three()
+      end subroutine three
+
+SUBROUTINE c()
+ CALL a()
+END SUBROUTINE c
+
+SUBROUTINE a()
+END SUBROUTINE a
+
+MODULE M
+CONTAINS
+ SUBROUTINE b()
+   CALL c()
+ END SUBROUTINE
+END MODULE
+
+subroutine test()
+USE M
+CALL b()
+END
+
diff --git a/gcc/testsuite/gfortran.dg/whole_file_23.f90 b/gcc/testsuite/gfortran.dg/whole_file_23.f90
new file mode 100644
index 000000000..c8f66e6cd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_23.f90
@@ -0,0 +1,49 @@
+! { dg-do compile }
+! 
+! PR fortran/40873
+!
+! Failed to compile (segfault) with -fwhole-file.
+! Cf. PR 40873 comment 24; test case taken from
+! PR fortran/31867 comment 6.
+!
+
+pure integer function lensum (words, sep)
+  character (len=*), intent(in)        :: words(:), sep
+  lensum = (size (words)-1) * len (sep) + sum (len_trim (words))
+end function
+
+module util_mod
+  implicit none
+  interface
+    pure integer function lensum (words, sep)
+      character (len=*), intent(in)        :: words(:), sep
+    end function
+  end interface
+  contains
+  function join (words, sep) result(str)
+! trim and concatenate a vector of character variables, 
+! inserting sep between them
+    character (len=*), intent(in)        :: words(:), sep
+    character (len=lensum (words, sep))  :: str
+    integer                              :: i, nw
+    nw  = size (words)
+    str = ""
+    if (nw < 1) then
+      return
+    else
+      str = words(1)
+    end if
+    do i=2,nw
+      str = trim (str) // sep // words(i)
+    end do
+  end function join
+end module util_mod
+!
+program xjoin
+  use util_mod, only: join
+  implicit none
+  character (len=5) :: words(2) = (/"two  ","three"/) 
+  write (*,"(1x,'words = ',a)") "'"//join (words, "&")//"'"
+end program xjoin
+
+! { dg-final { cleanup-modules "util_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_24.f90 b/gcc/testsuite/gfortran.dg/whole_file_24.f90
new file mode 100644
index 000000000..4ac11cce2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_24.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+!
+! PR fortran/45077
+!
+! Contributed by Dominique d'Humieres, based on a test
+! case of Juergen Reuter.
+!
+
+module iso_red
+  type, public :: varying_string
+     character(LEN=1), dimension(:), allocatable :: chars
+  end type varying_string
+end module iso_red
+
+module ifiles
+  use iso_red, string_t => varying_string
+contains
+  function line_get_string_advance (line) result (string)
+    type(string_t) :: string
+    character :: line
+  end function line_get_string_advance
+end module ifiles
+
+module syntax_rules
+  use iso_red, string_t => varying_string
+  use ifiles, only: line_get_string_advance
+contains
+  subroutine syntax_init_from_ifile ()
+    type(string_t) :: string
+       string = line_get_string_advance ("")
+  end subroutine syntax_init_from_ifile
+end module syntax_rules
+end
+
+! { dg-final { cleanup-modules "iso_red ifiles syntax_rules" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_25.f90 b/gcc/testsuite/gfortran.dg/whole_file_25.f90
new file mode 100644
index 000000000..d2cbd36ae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_25.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fwhole-program" }
+!
+! PR fortran/45087
+!
+
+module ints
+   INTERFACE
+      SUBROUTINE NOZZLE()
+      END SUBROUTINE NOZZLE
+   END INTERFACE
+end module ints
+
+      SUBROUTINE NOZZLE()
+      END SUBROUTINE NOZZLE
+      program CORTESA 
+      USE INTS
+      CALL NOZZLE ()
+      END program CORTESA
+
+! { dg-final { cleanup-modules "ints" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_26.f90 b/gcc/testsuite/gfortran.dg/whole_file_26.f90
new file mode 100644
index 000000000..8ce451070
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_26.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-fwhole-program  --param ggc-min-expand=0 --param ggc-min-heapsize=0" }
+!
+! PR fortran/45087
+!
+
+module INTS
+  interface
+    subroutine NEXT
+    end subroutine NEXT
+    subroutine VALUE()
+    end subroutine VALUE
+  end interface
+end module INTS
+
+subroutine NEXT
+end subroutine NEXT
+
+subroutine VALUE()
+  use INTS, only: NEXT
+  CALL NEXT
+end subroutine VALUE
+
+end
+
+! { dg-final { cleanup-modules "ints" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_27.f90 b/gcc/testsuite/gfortran.dg/whole_file_27.f90
new file mode 100644
index 000000000..412954727
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_27.f90
@@ -0,0 +1,210 @@
+! { dg-do compile }
+!
+! PR fortran/45125
+!
+! Contributed by Salvatore Filippone and Dominique d'Humieres.
+!
+
+module const_mod
+  ! This is the default integer
+  integer, parameter  :: ndig=8
+  integer, parameter  :: int_k_ = selected_int_kind(ndig)
+  ! This is an 8-byte  integer, and normally different from default integer. 
+  integer, parameter  :: longndig=12
+  integer, parameter  :: long_int_k_ = selected_int_kind(longndig)
+  !
+  ! These must be the kind parameter corresponding to MPI_DOUBLE_PRECISION
+  ! and MPI_REAL
+  !
+  integer, parameter  :: dpk_ = kind(1.d0)
+  integer, parameter  :: spk_ = kind(1.e0)
+  integer, save       :: sizeof_dp, sizeof_sp
+  integer, save       :: sizeof_int, sizeof_long_int
+  integer, save       :: mpi_integer
+
+  integer, parameter :: invalid_ = -1 
+  integer, parameter :: spmat_null_=0, spmat_bld_=1
+  integer, parameter :: spmat_asb_=2, spmat_upd_=4
+
+  !
+  ! 
+  !     Error constants
+  integer, parameter, public :: success_=0
+  integer, parameter, public :: err_iarg_neg_=10
+end module const_mod
+module base_mat_mod
+  
+  use const_mod 
+
+
+  type  :: base_sparse_mat
+    integer, private     :: m, n
+    integer, private     :: state, duplicate 
+    logical, private     :: triangle, unitd, upper, sorted
+  contains 
+
+    procedure, pass(a) :: get_fmt => base_get_fmt
+    procedure, pass(a) :: set_null => base_set_null
+    procedure, pass(a) :: allocate_mnnz => base_allocate_mnnz
+    generic,   public  :: allocate => allocate_mnnz
+  end type base_sparse_mat
+
+  interface 
+    subroutine  base_allocate_mnnz(m,n,a,nz) 
+      import base_sparse_mat, long_int_k_
+      integer, intent(in) :: m,n
+      class(base_sparse_mat), intent(inout) :: a
+      integer, intent(in), optional  :: nz
+    end subroutine base_allocate_mnnz
+  end interface
+
+contains
+
+  function base_get_fmt(a) result(res)
+    implicit none 
+    class(base_sparse_mat), intent(in) :: a
+    character(len=5) :: res
+    res = 'NULL'
+  end function base_get_fmt
+
+  subroutine  base_set_null(a) 
+    implicit none 
+    class(base_sparse_mat), intent(inout) :: a
+
+    a%state = spmat_null_
+  end subroutine base_set_null
+
+
+end module base_mat_mod
+
+module d_base_mat_mod
+  
+  use base_mat_mod
+
+  type, extends(base_sparse_mat) :: d_base_sparse_mat
+  contains
+  end type d_base_sparse_mat
+  
+  
+  
+  type, extends(d_base_sparse_mat) :: d_coo_sparse_mat
+    
+    integer              :: nnz
+    integer, allocatable :: ia(:), ja(:)
+    real(dpk_), allocatable :: val(:)
+    
+  contains
+    
+    procedure, pass(a) :: get_fmt      => d_coo_get_fmt
+    procedure, pass(a) :: allocate_mnnz => d_coo_allocate_mnnz
+    
+  end type d_coo_sparse_mat
+  
+  
+  interface
+    subroutine  d_coo_allocate_mnnz(m,n,a,nz) 
+      import d_coo_sparse_mat
+      integer, intent(in) :: m,n
+      class(d_coo_sparse_mat), intent(inout) :: a
+      integer, intent(in), optional :: nz
+    end subroutine d_coo_allocate_mnnz
+  end interface
+  
+contains 
+  
+  function d_coo_get_fmt(a) result(res)
+    implicit none 
+    class(d_coo_sparse_mat), intent(in) :: a
+    character(len=5) :: res
+    res = 'COO'
+  end function d_coo_get_fmt
+  
+end module d_base_mat_mod
+
+subroutine  base_allocate_mnnz(m,n,a,nz) 
+  use base_mat_mod, protect_name => base_allocate_mnnz
+  implicit none 
+  integer, intent(in) :: m,n
+  class(base_sparse_mat), intent(inout) :: a
+  integer, intent(in), optional  :: nz
+  Integer :: err_act
+  character(len=20)  :: name='allocate_mnz', errfmt
+  logical, parameter :: debug=.false.
+
+  ! This is the base version. If we get here
+  ! it means the derived class is incomplete,
+  ! so we throw an error.
+  errfmt=a%get_fmt()
+  write(0,*) 'Error: Missing ovverriding impl for allocate in class ',errfmt
+
+  return
+
+end subroutine base_allocate_mnnz
+
+subroutine  d_coo_allocate_mnnz(m,n,a,nz) 
+  use d_base_mat_mod, protect_name => d_coo_allocate_mnnz
+  implicit none 
+  integer, intent(in) :: m,n
+  class(d_coo_sparse_mat), intent(inout) :: a
+  integer, intent(in), optional :: nz
+  Integer :: err_act, info, nz_
+  character(len=20)  :: name='allocate_mnz'
+  logical, parameter :: debug=.false.
+
+  info = success_
+  if (m < 0) then 
+    info = err_iarg_neg_
+  endif
+  if (n < 0) then 
+    info = err_iarg_neg_
+  endif
+  if (present(nz)) then 
+    nz_ = nz
+  else
+    nz_ = max(7*m,7*n,1)
+  end if
+  if (nz_ < 0) then 
+    info = err_iarg_neg_
+  endif
+! !$  if (info == success_) call realloc(nz_,a%ia,info)
+! !$  if (info == success_) call realloc(nz_,a%ja,info)
+! !$  if (info == success_) call realloc(nz_,a%val,info)
+  if (info == success_) then 
+! !$    call a%set_nrows(m)
+! !$    call a%set_ncols(n)
+! !$    call a%set_nzeros(0)
+! !$    call a%set_bld()
+! !$    call a%set_triangle(.false.)
+! !$    call a%set_unit(.false.)
+! !$    call a%set_dupl(dupl_def_)
+    write(0,*) 'Allocated COO succesfully, should now set components'
+  else 
+    write(0,*) 'COO allocation failed somehow. Go figure'
+  end if
+  return
+
+end subroutine d_coo_allocate_mnnz
+
+
+program d_coo_err
+  use d_base_mat_mod
+  implicit none
+
+  integer            :: ictxt, iam, np
+
+  ! solver parameters
+  type(d_coo_sparse_mat) :: acoo
+  
+  ! other variables
+  integer nnz, n
+
+  n   = 32
+  nnz = n*9
+  
+  call acoo%set_null()
+  call acoo%allocate(n,n,nz=nnz)
+
+  stop
+end program d_coo_err
+
+! { dg-final { cleanup-modules "base_mat_mod const_mod d_base_mat_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_28.f90 b/gcc/testsuite/gfortran.dg/whole_file_28.f90
new file mode 100644
index 000000000..78c848e40
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_28.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! Test the fix for the problem described in PR45077 comments #4 and #5.
+! Note that the module file is kept for whole_file_29.f90
+!
+! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+module iso_red
+  type, public :: varying_string
+     character(LEN=1), dimension(:), allocatable :: chars
+  end type varying_string
+end module iso_red
+! DO NOT CLEAN UP THE MODULE FILE - whole_file_29.f90 does it.
diff --git a/gcc/testsuite/gfortran.dg/whole_file_29.f90 b/gcc/testsuite/gfortran.dg/whole_file_29.f90
new file mode 100644
index 000000000..2521dadac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_29.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! Test the fix for the problem described in PR45077 comments #4 and #5.
+! Note that the module file from whole_file_28.f90, 'iso_red', is
+! needed for this test.
+!
+! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+module ifiles
+  use iso_red, string_t => varying_string
+contains
+  function line_get_string_advance (line) result (string)
+    type(string_t) :: string
+    character :: line
+  end function line_get_string_advance
+end module ifiles
+
+module syntax_rules
+  use iso_red, string_t => varying_string
+  use ifiles, only: line_get_string_advance
+contains
+  subroutine syntax_init_from_ifile ()
+    type(string_t) :: string
+       string = line_get_string_advance ("")
+  end subroutine syntax_init_from_ifile
+end module syntax_rules
+end
+! { dg-final { cleanup-modules "syntax_rules ifiles iso_red" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_3.f90 b/gcc/testsuite/gfortran.dg/whole_file_3.f90
new file mode 100644
index 000000000..242280ccf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_3.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file" }
+! Tests the fix for PR26227 in which the interface mismatches
+! below were not detected.
+!
+! Contributed by Andrew Pinski <pinskia@gcc.gnu.org>
+!
+      SUBROUTINE PHLOAD (READER,*)
+      IMPLICIT NONE
+      EXTERNAL         READER
+      CALL READER (*1)
+ 1    RETURN 1
+      END SUBROUTINE
+
+      program test
+      EXTERNAL R
+      call PHLOAD (R, 1) ! { dg-warning "Missing alternate return spec" }
+      CALL PHLOAD (R, 2) ! { dg-warning "Missing alternate return spec" }
+      CALL PHLOAD (R, *999) ! This one is OK
+ 999  continue
+      END program test
diff --git a/gcc/testsuite/gfortran.dg/whole_file_30.f90 b/gcc/testsuite/gfortran.dg/whole_file_30.f90
new file mode 100644
index 000000000..813ca0686
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_30.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! Test the fix for the problem described in PR46818.
+! Note that the module file is kept for whole_file_31.f90
+!
+! Contributed by Martien Hulsen  <m.a.hulsen@tue.nl>
+! and reduced by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+! ============== system_defs.f90 =============
+module system_defs_m
+  type sysvector_t
+    integer :: probnr = 0
+    real, allocatable, dimension(:) :: u
+  end type sysvector_t
+end module system_defs_m
+! DO NOT CLEAN UP THE MODULE FILE - whole_file_31.f90 does it.
diff --git a/gcc/testsuite/gfortran.dg/whole_file_31.f90 b/gcc/testsuite/gfortran.dg/whole_file_31.f90
new file mode 100644
index 000000000..7ef0b9f67
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_31.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! Test the fix for the problem described in PR46818.
+! Note that the module file from whole_file_30.f90, 'system_defs_m',
+! is needed for this test.
+!
+! Contributed by Martien Hulsen  <m.a.hulsen@tue.nl>
+! and reduced by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+! ========== t.f90 ===========================
+module convecreac_m
+  use system_defs_m
+  type(sysvector_t), pointer :: solution
+end module convecreac_m
+
+program t
+  use convecreac_m
+  implicit none
+  type(sysvector_t), target :: sol
+  solution => sol
+end program t
+! { dg-final { cleanup-modules "system_defs_m convecreac_m" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_32.f90 b/gcc/testsuite/gfortran.dg/whole_file_32.f90
new file mode 100644
index 000000000..6626fbd5a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_32.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-O -finline-small-functions" }
+! Tests the fix for PR45743 in which the compilation failed with an ICE
+! internal compiler error: verify_stmts failed.  The source is the essential
+! part of whole_file_3.f90.
+!
+! Contributed by Zdenek Sojka  <zsojka@seznam.cz>
+!
+      SUBROUTINE PHLOAD (READER,*)
+      IMPLICIT NONE
+      EXTERNAL         READER
+      CALL READER (*1)
+ 1    RETURN 1
+      END SUBROUTINE
+
+      program test
+      EXTERNAL R
+      CALL PHLOAD (R, *999) ! This one is OK
+ 999  continue
+      END program test
diff --git a/gcc/testsuite/gfortran.dg/whole_file_33.f90 b/gcc/testsuite/gfortran.dg/whole_file_33.f90
new file mode 100644
index 000000000..31faeaa09
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_33.f90
@@ -0,0 +1,50 @@
+! { dg-do compile }
+!
+! PR fortran/48588
+!
+! Contributed by Andres Legarra.
+!
+
+MODULE LA_PRECISION
+IMPLICIT NONE
+INTEGER, PARAMETER :: dp = KIND(1.0D0)
+END MODULE LA_PRECISION
+
+module lapack90
+INTERFACE
+  SUBROUTINE DGESV_F90( A, B, IPIV, INFO )
+    USE la_precision, ONLY: wp => dp
+    IMPLICIT NONE
+    INTEGER, INTENT(OUT), OPTIONAL         :: INFO
+    INTEGER, INTENT(OUT), OPTIONAL, TARGET :: IPIV(:)
+    REAL(WP), INTENT(IN OUT)               :: A(:,:), B(:,:)
+  END SUBROUTINE DGESV_F90
+END INTERFACE
+end module
+
+SUBROUTINE DGESV_F90( A, B, IPIV, INFO )
+  USE la_precision, ONLY: wp => dp
+  IMPLICIT NONE
+  INTEGER, INTENT(OUT), OPTIONAL         :: INFO
+  INTEGER, INTENT(OUT), OPTIONAL, TARGET :: IPIV(:)
+  REAL(WP), INTENT(IN OUT)               :: A(:,:), B(:,:)
+END SUBROUTINE DGESV_F90
+
+MODULE DENSEOP
+  USE LAPACK90
+  implicit none
+  integer, parameter :: r8 = SELECTED_REAL_KIND( 15, 307 )
+  real(r8)::denseop_tol=1.d-50
+
+  CONTAINS
+
+  SUBROUTINE GEINV8 (x)
+   real(r8)::x(:,:)
+   real(r8),allocatable::x_o(:,:)
+   allocate(x_o(size(x,1),size(x,1)))
+   CALL dgesv_f90(x,x_o)
+   x=x_o
+  END SUBROUTINE GEINV8
+END MODULE DENSEOP
+
+! { dg-final { cleanup-modules "la_precision lapack90 denseop" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_34.f90 b/gcc/testsuite/gfortran.dg/whole_file_34.f90
new file mode 100644
index 000000000..9b421e004
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_34.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+!
+! PR fortran/48788
+!
+! Contributed by Zdenek Sojka
+!
+function foo ()
+end function foo
+  character(4), external :: foo ! { dg-error "Return type mismatch of function" }
+  character(4) :: x
+  x = foo ()
+END
diff --git a/gcc/testsuite/gfortran.dg/whole_file_35.f90 b/gcc/testsuite/gfortran.dg/whole_file_35.f90
new file mode 100644
index 000000000..46a886551
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_35.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR fortran/50408
+!
+! Contributed by Vittorio Zecca
+!
+       module m
+         type int
+           integer  :: val
+         end type int
+         interface ichar
+           module procedure uch
+        end interface
+       contains
+         function uch (c)
+           character (len=1), intent (in) :: c
+           type (int)                     :: uch
+           intrinsic ichar
+           uch%val = 127 - ichar (c)
+         end function uch 
+       end module m
+
+      program p
+        use m
+        print *,ichar('~') ! must print "1"
+      end program p
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_4.f90 b/gcc/testsuite/gfortran.dg/whole_file_4.f90
new file mode 100644
index 000000000..671bc2db5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_4.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file -std=legacy" }
+! Tests the fix for PR24886 in which the mismatch between the
+! character lengths of the actual and formal arguments of
+! 'foo' was not detected.
+!
+! Contributed by Uttam Pawar <uttamp@us.ibm.com>
+!
+        subroutine foo(y)
+           character(len=20) :: y
+           y = 'hello world'
+        end
+
+        program test
+           character(len=10) :: x
+           call foo(x) ! { dg-warning "actual argument shorter" }
+           write(*,*) 'X=',x
+           pause
+        end
diff --git a/gcc/testsuite/gfortran.dg/whole_file_5.f90 b/gcc/testsuite/gfortran.dg/whole_file_5.f90
new file mode 100644
index 000000000..34240c9f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_5.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-O3 -fwhole-file -fdump-tree-optimized" }
+! { dg-add-options bind_pic_locally }
+!
+! Check that inlining of functions declared BEFORE usage works.
+! If yes, then the dump does not contain a call to F().
+!
+
+INTEGER FUNCTION f()
+  f = 42
+END FUNCTION
+
+PROGRAM main
+  INTEGER :: a, f
+  a = f()
+  print *, a, f()
+END PROGRAM
+
+! { dg-final { scan-tree-dump-times "= f \\(\\)" 0 "optimized" } }
+! { dg-final { cleanup-tree-dump "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_6.f90 b/gcc/testsuite/gfortran.dg/whole_file_6.f90
new file mode 100644
index 000000000..1d92bc360
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_6.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-O3 -fwhole-file -fdump-tree-optimized" }
+! { dg-add-options bind_pic_locally }
+!
+! Check that inlining of functions declared AFTER usage works.
+! If yes, then the dump does not contain a call to F().
+!
+
+PROGRAM main
+  INTEGER :: a(3), f
+  a = f()
+  print *, a
+END PROGRAM
+
+INTEGER FUNCTION f()
+  f = 42
+END FUNCTION
+
+! { dg-final { scan-tree-dump-times "= f \\(\\)" 0 "optimized" } }
+! { dg-final { cleanup-tree-dump "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/whole_file_7.f90 b/gcc/testsuite/gfortran.dg/whole_file_7.f90
new file mode 100644
index 000000000..53fed228a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_7.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file" }
+! Test the fixes for the first two problems in PR40011
+!
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+!
+! This function would not compile because -fwhole-file would
+! try repeatedly to resolve the function because of the self
+! reference.
+RECURSIVE FUNCTION eval_args(q)  result (r)
+  INTEGER NNODE 
+  PARAMETER (NNODE  = 10) 
+  TYPE NODE 
+    SEQUENCE 
+    INTEGER car 
+    INTEGER cdr 
+  END TYPE NODE 
+  TYPE(NODE) heap(NNODE) 
+  INTEGER r, q 
+  r = eval_args(heap(q)%cdr) 
+END FUNCTION eval_args 
+
+function test(n)
+  real, dimension(2) :: test
+  integer            :: n
+  test = n
+  return
+end function test
+
+program arr     ! The error was not picked up causing an ICE
+  real, dimension(2) :: res
+  res = test(2) ! { dg-error "needs an explicit INTERFACE" }
+  print *, res
+end program
diff --git a/gcc/testsuite/gfortran.dg/whole_file_8.f90 b/gcc/testsuite/gfortran.dg/whole_file_8.f90
new file mode 100644
index 000000000..6ea319a9d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_8.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file" }
+! Test the fix for the third problem in PR40011, where false
+! type/rank mismatches were found in the main program calls.
+!
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+!
+subroutine test_d(fn, val, res)
+  double precision fn
+  double precision val, res
+
+  print *, fn(val), res
+end subroutine
+
+subroutine test_c(fn, val, res)
+  complex fn
+  complex val, res
+
+  print *, fn(val), res
+end subroutine
+
+program specifics
+
+  intrinsic dcos
+  intrinsic dcosh
+  intrinsic dexp
+
+  intrinsic conjg
+
+  call test_d (dcos, 1d0, dcos(1d0))
+  call test_d (dcosh, 1d0, dcosh(1d0))
+  call test_d (dexp, 1d0, dexp(1d0))
+
+  call test_c (conjg, (1.0,1.0) , conjg((1.0,1.0)))
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/whole_file_9.f90 b/gcc/testsuite/gfortran.dg/whole_file_9.f90
new file mode 100644
index 000000000..64dce42ee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/whole_file_9.f90
@@ -0,0 +1,46 @@
+! { dg-do compile }
+! { dg-options "-fwhole-file" }
+! Test the fix for the fourth problem in PR40011, where the
+! entries were not resolved, resulting in a segfault.
+!
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+!
+program test
+interface
+  function bad_stuff(n)
+    integer :: bad_stuff (2)
+    integer :: n(2)
+  end function bad_stuff
+   recursive function rec_stuff(n) result (tmp)
+    integer :: n(2), tmp(2)
+  end function rec_stuff
+end interface
+   integer :: res(2)
+  res = bad_stuff((/-19,-30/))
+
+end program test
+
+  recursive function bad_stuff(n)
+    integer :: bad_stuff (2)
+    integer :: n(2), tmp(2), ent = 0, sent = 0
+    save ent, sent
+    ent = -1
+   entry rec_stuff(n) result (tmp)
+    if (ent == -1) then
+      sent = ent
+      ent = 0
+    end if
+    ent = ent + 1
+    tmp = 1
+    if(maxval (n) < 5) then
+      tmp = tmp + rec_stuff (n+1)
+      ent = ent - 1
+    endif
+    if (ent == 1) then
+      if (sent == -1) then
+        bad_stuff = tmp + bad_stuff (1)
+      end if
+      ent = 0
+      sent = 0
+    end if
+  end function bad_stuff
diff --git a/gcc/testsuite/gfortran.dg/widechar_1.f90 b/gcc/testsuite/gfortran.dg/widechar_1.f90
new file mode 100644
index 000000000..804de9d7a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_1.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-fbackslash" }
+
+  character(len=20,kind=4) :: s4
+  character(len=20,kind=1) :: s1
+
+  s1 = "foo\u0000"
+  s1 = "foo\u00ff"
+  s1 = "foo\u0100" ! { dg-error "is not representable" }
+  s1 = "foo\u0101" ! { dg-error "is not representable" }
+  s1 = "foo\U00000101" ! { dg-error "is not representable" }
+
+  s1 = 4_"foo bar"
+  s1 = 4_"foo\u00ff"
+  s1 = 4_"foo\u0101" ! { dg-error "cannot be converted" }
+  s1 = 4_"foo\u1101" ! { dg-error "cannot be converted" }
+  s1 = 4_"foo\UFFFFFFFF" ! { dg-error "cannot be converted" }
+
+  s4 = "foo\u0000"
+  s4 = "foo\u00ff"
+  s4 = "foo\u0100" ! { dg-error "is not representable" }
+  s4 = "foo\U00000100" ! { dg-error "is not representable" }
+
+  s4 = 4_"foo bar"
+  s4 = 4_"\xFF\x96"
+  s4 = 4_"\x00\x96"
+  s4 = 4_"foo\u00ff"
+  s4 = 4_"foo\u0101"
+  s4 = 4_"foo\u1101"
+  s4 = 4_"foo\Uab98EF56"
+  s4 = 4_"foo\UFFFFFFFF"
+
+end
diff --git a/gcc/testsuite/gfortran.dg/widechar_2.f90 b/gcc/testsuite/gfortran.dg/widechar_2.f90
new file mode 100644
index 000000000..706901e6b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_2.f90
@@ -0,0 +1,69 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+  character(kind=1,len=20) :: s1
+  character(kind=4,len=20) :: s4
+
+  s1 = "this is me!"
+  s4 = s1
+  call check(s1, 4_"this is me!         ")
+  call check2(s1, 4_"this is me!         ")
+  s4 = "this is me!"
+  call check(s1, 4_"this is me!         ")
+  call check2(s1, 4_"this is me!         ")
+
+  s1 = ""
+  s4 = s1
+  call check(s1, 4_"                    ")
+  call check2(s1, 4_"                    ")
+  s4 = ""
+  call check(s1, 4_"                    ")
+  call check2(s1, 4_"                    ")
+
+  s1 = " \xFF"
+  s4 = s1
+  call check(s1, 4_" \xFF                  ")
+  call check2(s1, 4_" \xFF                  ")
+  s4 = " \xFF"
+  call check(s1, 4_" \xFF                  ")
+  call check2(s1, 4_" \xFF                  ")
+
+  s1 = "  \xFF"
+  s4 = s1
+  call check(s1, 4_"  \xFF                 ")
+  call check2(s1, 4_"  \xFF                 ")
+  s4 = "  \xFF"
+  call check(s1, 4_"  \xFF                 ")
+  call check2(s1, 4_"  \xFF                 ")
+
+contains
+  subroutine check(s1,s4)
+    character(kind=1,len=20) :: s1, t1
+    character(kind=4,len=20) :: s4
+    t1 = s4
+    if (t1 /= s1) call abort
+    if (len(s1) /= len(t1)) call abort
+    if (len(s1) /= len(s4)) call abort
+    if (len_trim(s1) /= len_trim(t1)) call abort
+    if (len_trim(s1) /= len_trim(s4)) call abort
+  end subroutine check
+
+  subroutine check2(s1,s4)
+    character(kind=1,len=*) :: s1
+    character(kind=4,len=*) :: s4
+    character(kind=1,len=len(s1)) :: t1
+    character(kind=4,len=len(s4)) :: t4
+
+    t1 = s4
+    t4 = s1
+    if (t1 /= s1) call abort
+    if (t4 /= s4) call abort
+    if (len(s1) /= len(t1)) call abort
+    if (len(s1) /= len(s4)) call abort
+    if (len(s1) /= len(t4)) call abort
+    if (len_trim(s1) /= len_trim(t1)) call abort
+    if (len_trim(s1) /= len_trim(s4)) call abort
+    if (len_trim(s1) /= len_trim(t4)) call abort
+  end subroutine check2
+
+end
diff --git a/gcc/testsuite/gfortran.dg/widechar_3.f90 b/gcc/testsuite/gfortran.dg/widechar_3.f90
new file mode 100644
index 000000000..653f1d93a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_3.f90
@@ -0,0 +1,112 @@
+! { dg-do compile }
+! { dg-options "-fmax-errors=1000" }
+
+  character(kind=1,len=20) :: s1, t1
+  character(kind=4,len=20) :: s4, t4
+
+  print *, "" // ""
+  print *, "" // 4_"" ! { dg-error "Operands of string concatenation operator" }
+  print *, 4_"" // "" ! { dg-error "Operands of string concatenation operator" }
+  print *, 4_"" // 4_""
+
+  print *, s1 // ""
+  print *, s1 // 4_"" ! { dg-error "Operands of string concatenation operator" }
+  print *, s4 // "" ! { dg-error "Operands of string concatenation operator" }
+  print *, s4 // 4_""
+
+  print *, "" // s1
+  print *, 4_"" // s1 ! { dg-error "Operands of string concatenation operator" }
+  print *, "" // s4 ! { dg-error "Operands of string concatenation operator" }
+  print *, 4_"" // s4
+
+  print *, s1 // t1
+  print *, s1 // t4 ! { dg-error "Operands of string concatenation operator" }
+  print *, s4 // t1 ! { dg-error "Operands of string concatenation operator" }
+  print *, s4 // t4
+
+  print *, s1 .eq. ""
+  print *, s1 .eq. 4_"" ! { dg-error "Operands of comparison operator" }
+  print *, s4 .eq. "" ! { dg-error "Operands of comparison operator" }
+  print *, s4 .eq. 4_""
+
+  print *, s1 == ""
+  print *, s1 == 4_"" ! { dg-error "Operands of comparison operator" }
+  print *, s4 == "" ! { dg-error "Operands of comparison operator" }
+  print *, s4 == 4_""
+
+  print *, s1 .ne. ""
+  print *, s1 .ne. 4_"" ! { dg-error "Operands of comparison operator" }
+  print *, s4 .ne. "" ! { dg-error "Operands of comparison operator" }
+  print *, s4 .ne. 4_""
+
+  print *, s1 /= ""
+  print *, s1 /= 4_"" ! { dg-error "Operands of comparison operator" }
+  print *, s4 /= "" ! { dg-error "Operands of comparison operator" }
+  print *, s4 /= 4_""
+
+  print *, s1 .le. ""
+  print *, s1 .le. 4_"" ! { dg-error "Operands of comparison operator" }
+  print *, s4 .le. "" ! { dg-error "Operands of comparison operator" }
+  print *, s4 .le. 4_""
+
+  print *, s1 <= ""
+  print *, s1 <= 4_"" ! { dg-error "Operands of comparison operator" }
+  print *, s4 <= "" ! { dg-error "Operands of comparison operator" }
+  print *, s4 <= 4_""
+
+  print *, s1 .ge. ""
+  print *, s1 .ge. 4_"" ! { dg-error "Operands of comparison operator" }
+  print *, s4 .ge. "" ! { dg-error "Operands of comparison operator" }
+  print *, s4 .ge. 4_""
+
+  print *, s1 >= ""
+  print *, s1 >= 4_"" ! { dg-error "Operands of comparison operator" }
+  print *, s4 >= "" ! { dg-error "Operands of comparison operator" }
+  print *, s4 >= 4_""
+
+  print *, s1 .lt. ""
+  print *, s1 .lt. 4_"" ! { dg-error "Operands of comparison operator" }
+  print *, s4 .lt. "" ! { dg-error "Operands of comparison operator" }
+  print *, s4 .lt. 4_""
+
+  print *, s1 < ""
+  print *, s1 < 4_"" ! { dg-error "Operands of comparison operator" }
+  print *, s4 < "" ! { dg-error "Operands of comparison operator" }
+  print *, s4 < 4_""
+
+  print *, s1 .gt. ""
+  print *, s1 .gt. 4_"" ! { dg-error "Operands of comparison operator" }
+  print *, s4 .gt. "" ! { dg-error "Operands of comparison operator" }
+  print *, s4 .gt. 4_""
+
+  print *, s1 > ""
+  print *, s1 > 4_"" ! { dg-error "Operands of comparison operator" }
+  print *, s4 > "" ! { dg-error "Operands of comparison operator" }
+  print *, s4 > 4_""
+
+  print *, "" ==  ""
+  print *, 4_"" ==  "" ! { dg-error "Operands of comparison operator" }
+  print *, "" .eq.  ""
+  print *, 4_"" .eq.  "" ! { dg-error "Operands of comparison operator" }
+  print *, "" /=  ""
+  print *, 4_"" /=  "" ! { dg-error "Operands of comparison operator" }
+  print *, "" .ne.  ""
+  print *, 4_"" .ne.  "" ! { dg-error "Operands of comparison operator" }
+  print *, "" .lt.  ""
+  print *, 4_"" .lt.  "" ! { dg-error "Operands of comparison operator" }
+  print *, "" <  ""
+  print *, 4_"" <  "" ! { dg-error "Operands of comparison operator" }
+  print *, "" .le.  ""
+  print *, 4_"" .le.  "" ! { dg-error "Operands of comparison operator" }
+  print *, "" <=  ""
+  print *, 4_"" <=  "" ! { dg-error "Operands of comparison operator" }
+  print *, "" .gt.  ""
+  print *, 4_"" .gt.  "" ! { dg-error "Operands of comparison operator" }
+  print *, "" >  ""
+  print *, 4_"" >  "" ! { dg-error "Operands of comparison operator" }
+  print *, "" .ge.  ""
+  print *, 4_"" .ge.  "" ! { dg-error "Operands of comparison operator" }
+  print *, "" >=  ""
+  print *, 4_"" >=  "" ! { dg-error "Operands of comparison operator" }
+
+  end
diff --git a/gcc/testsuite/gfortran.dg/widechar_4.f90 b/gcc/testsuite/gfortran.dg/widechar_4.f90
new file mode 100644
index 000000000..1166f8bfb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_4.f90
@@ -0,0 +1,147 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+  character(kind=1,len=20) :: s1, t1
+  character(kind=4,len=20) :: s4, t4
+
+  call test (4_"ccc  ", 4_"bbb", 4_"ccc", 4_"ddd")
+  call test (4_" \xACp  ", 4_" \x900000 ", 4_" \xACp  ", 4_"ddd")
+  call test (4_" \xACp  ", 4_" \x900000 ", 4_" \xACp  ", 4_"ddd")
+
+  call test2 (4_" \x900000 ", 4_" \xACp  ", 4_"ddd")
+
+contains
+
+  subroutine test(s4, t4, u4, v4)
+    character(kind=4,len=*) :: s4, t4, u4, v4
+
+    if (.not. (s4 >= t4)) call abort
+    if (.not. (s4 > t4)) call abort
+    if (.not. (s4 .ge. t4)) call abort
+    if (.not. (s4 .gt. t4)) call abort
+    if (      (s4 == t4)) call abort
+    if (.not. (s4 /= t4)) call abort
+    if (      (s4 .eq. t4)) call abort
+    if (.not. (s4 .ne. t4)) call abort
+    if (      (s4 <= t4)) call abort
+    if (      (s4 < t4)) call abort
+    if (      (s4 .le. t4)) call abort
+    if (      (s4 .lt. t4)) call abort
+
+    if (.not. (s4 >= u4)) call abort
+    if (      (s4 > u4)) call abort
+    if (.not. (s4 .ge. u4)) call abort
+    if (      (s4 .gt. u4)) call abort
+    if (.not. (s4 == u4)) call abort
+    if (      (s4 /= u4)) call abort
+    if (.not. (s4 .eq. u4)) call abort
+    if (      (s4 .ne. u4)) call abort
+    if (.not. (s4 <= u4)) call abort
+    if (      (s4 < u4)) call abort
+    if (.not. (s4 .le. u4)) call abort
+    if (      (s4 .lt. u4)) call abort
+
+    if (      (s4 >= v4)) call abort
+    if (      (s4 > v4)) call abort
+    if (      (s4 .ge. v4)) call abort
+    if (      (s4 .gt. v4)) call abort
+    if (      (s4 == v4)) call abort
+    if (.not. (s4 /= v4)) call abort
+    if (      (s4 .eq. v4)) call abort
+    if (.not. (s4 .ne. v4)) call abort
+    if (.not. (s4 <= v4)) call abort
+    if (.not. (s4 < v4)) call abort
+    if (.not. (s4 .le. v4)) call abort
+    if (.not. (s4 .lt. v4)) call abort
+
+  end subroutine test
+
+  subroutine test2(t4, u4, v4)
+    character(kind=4,len=*) :: t4, u4, v4
+
+    if (.not. (4_" \xACp  " >= t4)) call abort
+    if (.not. (4_" \xACp  " > t4)) call abort
+    if (.not. (4_" \xACp  " .ge. t4)) call abort
+    if (.not. (4_" \xACp  " .gt. t4)) call abort
+    if (      (4_" \xACp  " == t4)) call abort
+    if (.not. (4_" \xACp  " /= t4)) call abort
+    if (      (4_" \xACp  " .eq. t4)) call abort
+    if (.not. (4_" \xACp  " .ne. t4)) call abort
+    if (      (4_" \xACp  " <= t4)) call abort
+    if (      (4_" \xACp  " < t4)) call abort
+    if (      (4_" \xACp  " .le. t4)) call abort
+    if (      (4_" \xACp  " .lt. t4)) call abort
+
+    if (.not. (4_" \xACp  " >= u4)) call abort
+    if (      (4_" \xACp  " > u4)) call abort
+    if (.not. (4_" \xACp  " .ge. u4)) call abort
+    if (      (4_" \xACp  " .gt. u4)) call abort
+    if (.not. (4_" \xACp  " == u4)) call abort
+    if (      (4_" \xACp  " /= u4)) call abort
+    if (.not. (4_" \xACp  " .eq. u4)) call abort
+    if (      (4_" \xACp  " .ne. u4)) call abort
+    if (.not. (4_" \xACp  " <= u4)) call abort
+    if (      (4_" \xACp  " < u4)) call abort
+    if (.not. (4_" \xACp  " .le. u4)) call abort
+    if (      (4_" \xACp  " .lt. u4)) call abort
+
+    if (      (4_" \xACp  " >= v4)) call abort
+    if (      (4_" \xACp  " > v4)) call abort
+    if (      (4_" \xACp  " .ge. v4)) call abort
+    if (      (4_" \xACp  " .gt. v4)) call abort
+    if (      (4_" \xACp  " == v4)) call abort
+    if (.not. (4_" \xACp  " /= v4)) call abort
+    if (      (4_" \xACp  " .eq. v4)) call abort
+    if (.not. (4_" \xACp  " .ne. v4)) call abort
+    if (.not. (4_" \xACp  " <= v4)) call abort
+    if (.not. (4_" \xACp  " < v4)) call abort
+    if (.not. (4_" \xACp  " .le. v4)) call abort
+    if (.not. (4_" \xACp  " .lt. v4)) call abort
+
+  end subroutine test2
+
+  subroutine test3(t4, u4, v4)
+    character(kind=4,len=*) :: t4, u4, v4
+
+    if (.not. (4_" \xACp  " >= 4_" \x900000 ")) call abort
+    if (.not. (4_" \xACp  " > 4_" \x900000 ")) call abort
+    if (.not. (4_" \xACp  " .ge. 4_" \x900000 ")) call abort
+    if (.not. (4_" \xACp  " .gt. 4_" \x900000 ")) call abort
+    if (      (4_" \xACp  " == 4_" \x900000 ")) call abort
+    if (.not. (4_" \xACp  " /= 4_" \x900000 ")) call abort
+    if (      (4_" \xACp  " .eq. 4_" \x900000 ")) call abort
+    if (.not. (4_" \xACp  " .ne. 4_" \x900000 ")) call abort
+    if (      (4_" \xACp  " <= 4_" \x900000 ")) call abort
+    if (      (4_" \xACp  " < 4_" \x900000 ")) call abort
+    if (      (4_" \xACp  " .le. 4_" \x900000 ")) call abort
+    if (      (4_" \xACp  " .lt. 4_" \x900000 ")) call abort
+
+    if (.not. (4_" \xACp  " >= 4_" \xACp  ")) call abort
+    if (      (4_" \xACp  " > 4_" \xACp  ")) call abort
+    if (.not. (4_" \xACp  " .ge. 4_" \xACp  ")) call abort
+    if (      (4_" \xACp  " .gt. 4_" \xACp  ")) call abort
+    if (.not. (4_" \xACp  " == 4_" \xACp  ")) call abort
+    if (      (4_" \xACp  " /= 4_" \xACp  ")) call abort
+    if (.not. (4_" \xACp  " .eq. 4_" \xACp  ")) call abort
+    if (      (4_" \xACp  " .ne. 4_" \xACp  ")) call abort
+    if (.not. (4_" \xACp  " <= 4_" \xACp  ")) call abort
+    if (      (4_" \xACp  " < 4_" \xACp  ")) call abort
+    if (.not. (4_" \xACp  " .le. 4_" \xACp  ")) call abort
+    if (      (4_" \xACp  " .lt. 4_" \xACp  ")) call abort
+
+    if (      (4_" \xACp  " >= 4_"ddd")) call abort
+    if (      (4_" \xACp  " > 4_"ddd")) call abort
+    if (      (4_" \xACp  " .ge. 4_"ddd")) call abort
+    if (      (4_" \xACp  " .gt. 4_"ddd")) call abort
+    if (      (4_" \xACp  " == 4_"ddd")) call abort
+    if (.not. (4_" \xACp  " /= 4_"ddd")) call abort
+    if (      (4_" \xACp  " .eq. 4_"ddd")) call abort
+    if (.not. (4_" \xACp  " .ne. 4_"ddd")) call abort
+    if (.not. (4_" \xACp  " <= 4_"ddd")) call abort
+    if (.not. (4_" \xACp  " < 4_"ddd")) call abort
+    if (.not. (4_" \xACp  " .le. 4_"ddd")) call abort
+    if (.not. (4_" \xACp  " .lt. 4_"ddd")) call abort
+
+  end subroutine test3
+
+end
diff --git a/gcc/testsuite/gfortran.dg/widechar_5.f90 b/gcc/testsuite/gfortran.dg/widechar_5.f90
new file mode 100644
index 000000000..ed2f32fbd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_5.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+module kinds
+  implicit none
+  integer, parameter :: one = 1, four = 4
+end module kinds
+
+module inner
+  use kinds
+  implicit none
+  character(kind=one,len=*), parameter :: inner1 = "abcdefg \xEF kl"
+  character(kind=four,len=*), parameter :: &
+        inner4 = 4_"\u9317x \U001298cef   dea\u10De"
+end module inner
+
+module middle
+  use inner
+  implicit none
+  character(kind=one,len=len(inner1)), dimension(2,2), parameter :: middle1 &
+    = reshape ([ character(kind=one,len=len(inner1)) :: inner1, ""], &
+               [ 2, 2 ], &
+               [ character(kind=one,len=len(inner1)) :: "foo", "ba " ])
+  character(kind=four,len=len(inner4)), dimension(2,2), parameter :: middle4 &
+    = reshape ([ character(kind=four,len=len(inner4)) :: inner4, 4_""], &
+               [ 2, 2 ], &
+               [ character(kind=four,len=len(inner4)) :: 4_"foo", 4_"ba " ])
+end module middle
+
+module outer
+  use middle
+  implicit none
+  character(kind=one,len=*), parameter :: my1(2) = middle1(1,:)
+  character(kind=four,len=*), parameter :: my4(2) = middle4(1,:)
+end module outer
+
+program test_modules
+  use outer, outer1 => my1, outer4 => my4
+  implicit none
+
+  if (len (inner1) /= len(inner4)) call abort
+  if (len (inner1) /= len_trim(inner1)) call abort
+  if (len (inner4) /= len_trim(inner4)) call abort
+
+  if (len(middle1) /= len(inner1)) call abort
+  if (len(outer1) /= len(inner1)) call abort
+  if (len(middle4) /= len(inner4)) call abort
+  if (len(outer4) /= len(inner4)) call abort
+
+  if (any (len_trim (middle1) /= reshape([len(middle1), 0, 3, 2], [2,2]))) &
+    call abort
+  if (any (len_trim (middle4) /= reshape([len(middle4), 0, 3, 2], [2,2]))) &
+    call abort
+  if (any (len_trim (outer1) /= [len(outer1), 3])) call abort
+  if (any (len_trim (outer4) /= [len(outer4), 3])) call abort
+
+end program test_modules
+
+! { dg-final { cleanup-modules "kinds inner middle outer" } }
diff --git a/gcc/testsuite/gfortran.dg/widechar_6.f90 b/gcc/testsuite/gfortran.dg/widechar_6.f90
new file mode 100644
index 000000000..9151adba4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_6.f90
@@ -0,0 +1,64 @@
+! { dg-do run }
+
+module mod
+
+  interface cut
+    module procedure cut1
+    module procedure cut4
+  end interface cut
+
+contains
+
+  function cut1 (s)
+    character(kind=1,len=*), intent(in) :: s
+    character(kind=1,len=max(0,len(s)-3)) :: cut1
+
+    cut1 = s(4:)
+  end function cut1
+
+  function cut4 (s)
+    character(kind=4,len=*), intent(in) :: s
+    character(kind=4,len=max(0,len(s)-3)) :: cut4
+
+    cut4 = s(4:)
+  end function cut4
+
+end module mod
+
+program test
+  use mod
+
+  if (len (cut1("")) /= 0 .or. cut1("") /= "") call abort
+  if (len (cut1("1")) /= 0 .or. cut1("") /= "") call abort
+  if (len (cut1("12")) /= 0 .or. cut1("") /= "") call abort
+  if (len (cut1("123")) /= 0 .or. cut1("") /= "") call abort
+  if (len (cut1("1234")) /= 1 .or. cut1("4") /= "") call abort
+  if (len (cut1("12345")) /= 2 .or. cut1("45") /= "") call abort
+
+  if (len (cut4(4_"")) /= 0 .or. cut4(4_"") /= 4_"") call abort
+  if (len (cut4(4_"1")) /= 0 .or. cut4(4_"") /= 4_"") call abort
+  if (len (cut4(4_"12")) /= 0 .or. cut4(4_"") /= 4_"") call abort
+  if (len (cut4(4_"123")) /= 0 .or. cut4(4_"") /= 4_"") call abort
+  if (len (cut4(4_"1234")) /= 1 .or. cut4(4_"4") /= 4_"") call abort
+  if (len (cut4(4_"12345")) /= 2 .or. cut4(4_"45") /= 4_"") call abort
+
+  if (kind (cut("")) /= kind("")) call abort
+  if (kind (cut(4_"")) /= kind(4_"")) call abort
+
+  if (len (cut("")) /= 0 .or. cut("") /= "") call abort
+  if (len (cut("1")) /= 0 .or. cut("") /= "") call abort
+  if (len (cut("12")) /= 0 .or. cut("") /= "") call abort
+  if (len (cut("123")) /= 0 .or. cut("") /= "") call abort
+  if (len (cut("1234")) /= 1 .or. cut("4") /= "") call abort
+  if (len (cut("12345")) /= 2 .or. cut("45") /= "") call abort
+
+  if (len (cut(4_"")) /= 0 .or. cut(4_"") /= 4_"") call abort
+  if (len (cut(4_"1")) /= 0 .or. cut(4_"") /= 4_"") call abort
+  if (len (cut(4_"12")) /= 0 .or. cut(4_"") /= 4_"") call abort
+  if (len (cut(4_"123")) /= 0 .or. cut(4_"") /= 4_"") call abort
+  if (len (cut(4_"1234")) /= 1 .or. cut(4_"4") /= 4_"") call abort
+  if (len (cut(4_"12345")) /= 2 .or. cut(4_"45") /= 4_"") call abort
+
+end program test
+
+! { dg-final { cleanup-modules "mod" } }
diff --git a/gcc/testsuite/gfortran.dg/widechar_7.f90 b/gcc/testsuite/gfortran.dg/widechar_7.f90
new file mode 100644
index 000000000..436832117
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_7.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+
+program test
+
+  character(kind=1,len=10) :: s1 = 4_"foobargee", t1 = 4_""
+  character(kind=4,len=10) :: s4 = "foobargee", t4 = ""
+
+  t1(5:5) = s1(6:6)
+  t4(5:5) = s4(6:6)
+  t4(5:5) = s1(6:6)
+  t1(5:5) = s4(6:6)
+
+  call sub (t1, t4)
+
+end program test
+
+! { dg-final { scan-tree-dump-times "memmove" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/widechar_8.f90 b/gcc/testsuite/gfortran.dg/widechar_8.f90
new file mode 100644
index 000000000..e61129416
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_8.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+!
+! PR fortran/37025
+!
+! Check whether transferring to character(kind=4) and transferring back works
+!
+implicit none
+character(len=4,kind=4) :: str
+integer(4) :: buffer(4) = [int(z'039f'),int(z'03cd'),int(z'03c7'),  &
+                           int(z'30b8') ], &
+              buffer2(4)
+
+open(6,encoding="UTF-8")
+str = transfer(buffer, str)
+!print *, str
+!print *, 4_'\u039f\u03cd\u03c7\u30b8'
+if (str /= 4_'\u039f\u03cd\u03c7\u30b8') call abort()
+str = transfer([int(z'039f'),int(z'03cd'),int(z'03c7'),  &
+                           int(z'30b8') ], str)
+if (str /= 4_'\u039f\u03cd\u03c7\u30b8') call abort()
+
+buffer2 = transfer(4_'\u039f\u03cd\u03c7\u30b8', buffer2, 4)
+!print *, buffer
+!print *, buffer2
+buffer2 = transfer(str, buffer2, 4)
+if (any(buffer2 /= buffer)) call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/widechar_9.f90 b/gcc/testsuite/gfortran.dg/widechar_9.f90
new file mode 100644
index 000000000..c78a1eb52
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_9.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+!
+! PR fortran/37076
+!
+! Before the result of concatenations was always a kind=1 string
+!
+program test3
+  integer,parameter :: u = 4
+  character(1,u),parameter :: nen=char(int(z'5e74'),u) !year
+  character(25,u) :: string
+  string = u_"2008"//nen
+  print *, u_"2008"//nen ! Compiles OK
+  print *, u_"2008"//nen//u_"8" ! Rejects this.
+end program test3
diff --git a/gcc/testsuite/gfortran.dg/widechar_IO_1.f90 b/gcc/testsuite/gfortran.dg/widechar_IO_1.f90
new file mode 100644
index 000000000..0fe479cda
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_IO_1.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! Wide chracter I/O test 1, formatted and mixed kind
+! Test case developed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+program test1
+  integer, parameter :: k4 = 4
+  character(len=10,kind=4) :: wide
+  character(len=10,kind=1) :: thin
+  character(kind=1,len=25) :: buffer
+  wide=k4_"Goodbye!"
+  thin="Hello!"
+  write(buffer, '(a)') wide
+  if (buffer /= "Goodbye!") call abort
+  open(10, form="formatted", access="stream", status="scratch")
+  write(10, '(a)') thin
+  rewind(10)
+  read(10, '(a)') wide
+  if (wide /= k4_"Hello!") call abort
+  write(buffer,*) thin, ">",wide,"<"
+  if (buffer /= " Hello!    >Hello!    <") call abort
+end program test1
diff --git a/gcc/testsuite/gfortran.dg/widechar_IO_2.f90 b/gcc/testsuite/gfortran.dg/widechar_IO_2.f90
new file mode 100644
index 000000000..6b13e4f93
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_IO_2.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! Wide chracter I/O test 2, formatted array write and read
+! Test case developed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+program chkdata
+    integer, parameter :: k4=4
+    character(len=7, kind=k4), dimension(3) :: mychar
+    character(50) :: buffer
+    mychar(1) = k4_"abc1234"
+    mychar(2) = k4_"def5678"
+    mychar(3) = k4_"ghi9012"
+    buffer = ""
+    write(buffer,'(3(a))') mychar(2:3), mychar(1)
+    if (buffer /= "def5678ghi9012abc1234") call abort
+    write(buffer,'(3(a))') mychar
+    if (buffer /= "abc1234def5678ghi9012") call abort
+    mychar = ""
+    read(buffer,'(3(a))') mychar
+    if (any(mychar.ne.[ k4_"abc1234",k4_"def5678",k4_"ghi9012" ])) call abort
+end program chkdata
diff --git a/gcc/testsuite/gfortran.dg/widechar_IO_3.f90 b/gcc/testsuite/gfortran.dg/widechar_IO_3.f90
new file mode 100644
index 000000000..c09205e2d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_IO_3.f90
@@ -0,0 +1,23 @@
+! { dg-do run { target fd_truncate } }
+! Wide character I/O test 3, unformatted arrays
+! Test case developed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+program test1
+  integer, parameter :: k4 = 4
+  character(len=10,kind=4) :: wide
+  character(len=10,kind=4), dimension(5,7) :: widearray
+  wide = k4_"abcdefg"
+  widearray = k4_"1234abcd"
+  open(10, form="unformatted", status="scratch")
+  write(10) wide
+  rewind(10)
+  wide = "wrong"
+  read(10) wide
+  if (wide /= k4_"abcdefg") call abort
+  rewind(10)
+  write(10) widearray(2:4,3:7)
+  widearray(2:4,3:7)=""
+  rewind(10)
+  read(10) widearray(2:4,3:7)
+  close(10)
+  if (any(widearray.ne.k4_"1234abcd")) call abort
+end program test1
diff --git a/gcc/testsuite/gfortran.dg/widechar_IO_4.f90 b/gcc/testsuite/gfortran.dg/widechar_IO_4.f90
new file mode 100644
index 000000000..e108b15c4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_IO_4.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options -fbackslash }
+! Wide chracter I/O test 4, formatted ISO-8859-1 characters in string
+! Test case developed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+! Compile with -fbackslash
+integer, parameter  :: k4 = 4
+character(kind=1,len=15) :: buffer
+character(kind=1, len=1) :: c1, c2
+character(kind=4,len=20) :: str = k4_'X\xF8öABC' ! ISO-8859-1 encoded string
+buffer = ""
+write(buffer,'(3a)')':',trim(str),':'
+if (buffer.ne.':X\xF8öABC: ') call abort
+str = ""
+read(buffer,'(3a)') c1,str(1:6),c2
+if (c1.ne.':') call abort
+if (str.ne.k4_'X\xF8öAB') call abort
+if (c2.ne.'C') call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/widechar_compare_1.f90 b/gcc/testsuite/gfortran.dg/widechar_compare_1.f90
new file mode 100644
index 000000000..44101104c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_compare_1.f90
@@ -0,0 +1,10 @@
+! { dg-do run }
+! PR 50192 - on little-endian systems, this used to fail.
+program main
+  character(kind=4,len=2) :: c1, c2
+  c1 = 4_' '
+  c2 = 4_' '
+  c1(1:1) = transfer(257, mold=c1(1:1))
+  c2(1:1) = transfer(64, mold=c2(1:1))
+  if (c1 < c2) call abort
+end program main
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_1.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_1.f90
new file mode 100644
index 000000000..cb9804296
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_1.f90
@@ -0,0 +1,116 @@
+! { dg-do compile }
+! { dg-options "-fmax-errors=100000" }
+
+  character(kind=1,len=20) :: s1, t1, u1, v1
+  character(kind=4,len=20) :: s4, t4, u4, v4
+
+  call date_and_time(date=s1)
+  call date_and_time(time=s1)
+  call date_and_time(zone=s1)
+  call date_and_time(s1, t1, u1)
+
+  call date_and_time(date=s4) ! { dg-error "must be of kind 1" }
+  call date_and_time(time=s4) ! { dg-error "must be of kind 1" }
+  call date_and_time(zone=s4) ! { dg-error "must be of kind 1" }
+  call date_and_time(s4, t4, u4) ! { dg-error "must be of kind 1" }
+
+  call get_command(s1)
+  call get_command(s4) ! { dg-error "Type of argument" }
+
+  call get_command_argument(1, s1)
+  call get_command_argument(1, s4) ! { dg-error "Type of argument" }
+
+  call get_environment_variable("PATH", s1)
+  call get_environment_variable(s1)
+  call get_environment_variable(s1, t1)
+  call get_environment_variable(4_"PATH", s1) ! { dg-error "Type of argument" }
+  call get_environment_variable(s4) ! { dg-error "Type of argument" }
+  call get_environment_variable(s1, t4) ! { dg-error "Type of argument" }
+  call get_environment_variable(s4, t1) ! { dg-error "Type of argument" }
+
+  print *, lge(s1,t1)
+  print *, lge(s1,"foo")
+  print *, lge("foo",t1)
+  print *, lge("bar","foo")
+
+  print *, lge(s1,t4) ! { dg-error "must be of kind 1" }
+  print *, lge(s1,4_"foo") ! { dg-error "must be of kind 1" }
+  print *, lge("foo",t4) ! { dg-error "must be of kind 1" }
+  print *, lge("bar",4_"foo") ! { dg-error "must be of kind 1" }
+
+  print *, lge(s4,t1) ! { dg-error "must be of kind 1" }
+  print *, lge(s4,"foo") ! { dg-error "must be of kind 1" }
+  print *, lge(4_"foo",t1) ! { dg-error "must be of kind 1" }
+  print *, lge(4_"bar","foo") ! { dg-error "must be of kind 1" }
+
+  print *, lge(s4,t4) ! { dg-error "must be of kind 1" }
+  print *, lge(s4,4_"foo") ! { dg-error "must be of kind 1" }
+  print *, lge(4_"foo",t4) ! { dg-error "must be of kind 1" }
+  print *, lge(4_"bar",4_"foo") ! { dg-error "must be of kind 1" }
+
+  print *, lgt(s1,t1)
+  print *, lgt(s1,"foo")
+  print *, lgt("foo",t1)
+  print *, lgt("bar","foo")
+
+  print *, lgt(s1,t4) ! { dg-error "must be of kind 1" }
+  print *, lgt(s1,4_"foo") ! { dg-error "must be of kind 1" }
+  print *, lgt("foo",t4) ! { dg-error "must be of kind 1" }
+  print *, lgt("bar",4_"foo") ! { dg-error "must be of kind 1" }
+
+  print *, lgt(s4,t1) ! { dg-error "must be of kind 1" }
+  print *, lgt(s4,"foo") ! { dg-error "must be of kind 1" }
+  print *, lgt(4_"foo",t1) ! { dg-error "must be of kind 1" }
+  print *, lgt(4_"bar","foo") ! { dg-error "must be of kind 1" }
+
+  print *, lgt(s4,t4) ! { dg-error "must be of kind 1" }
+  print *, lgt(s4,4_"foo") ! { dg-error "must be of kind 1" }
+  print *, lgt(4_"foo",t4) ! { dg-error "must be of kind 1" }
+  print *, lgt(4_"bar",4_"foo") ! { dg-error "must be of kind 1" }
+
+  print *, lle(s1,t1)
+  print *, lle(s1,"foo")
+  print *, lle("foo",t1)
+  print *, lle("bar","foo")
+
+  print *, lle(s1,t4) ! { dg-error "must be of kind 1" }
+  print *, lle(s1,4_"foo") ! { dg-error "must be of kind 1" }
+  print *, lle("foo",t4) ! { dg-error "must be of kind 1" }
+  print *, lle("bar",4_"foo") ! { dg-error "must be of kind 1" }
+
+  print *, lle(s4,t1) ! { dg-error "must be of kind 1" }
+  print *, lle(s4,"foo") ! { dg-error "must be of kind 1" }
+  print *, lle(4_"foo",t1) ! { dg-error "must be of kind 1" }
+  print *, lle(4_"bar","foo") ! { dg-error "must be of kind 1" }
+
+  print *, lle(s4,t4) ! { dg-error "must be of kind 1" }
+  print *, lle(s4,4_"foo") ! { dg-error "must be of kind 1" }
+  print *, lle(4_"foo",t4) ! { dg-error "must be of kind 1" }
+  print *, lle(4_"bar",4_"foo") ! { dg-error "must be of kind 1" }
+
+  print *, llt(s1,t1)
+  print *, llt(s1,"foo")
+  print *, llt("foo",t1)
+  print *, llt("bar","foo")
+
+  print *, llt(s1,t4) ! { dg-error "must be of kind 1" }
+  print *, llt(s1,4_"foo") ! { dg-error "must be of kind 1" }
+  print *, llt("foo",t4) ! { dg-error "must be of kind 1" }
+  print *, llt("bar",4_"foo") ! { dg-error "must be of kind 1" }
+
+  print *, llt(s4,t1) ! { dg-error "must be of kind 1" }
+  print *, llt(s4,"foo") ! { dg-error "must be of kind 1" }
+  print *, llt(4_"foo",t1) ! { dg-error "must be of kind 1" }
+  print *, llt(4_"bar","foo") ! { dg-error "must be of kind 1" }
+
+  print *, llt(s4,t4) ! { dg-error "must be of kind 1" }
+  print *, llt(s4,4_"foo") ! { dg-error "must be of kind 1" }
+  print *, llt(4_"foo",t4) ! { dg-error "must be of kind 1" }
+  print *, llt(4_"bar",4_"foo") ! { dg-error "must be of kind 1" }
+
+  print *, selected_char_kind("foo")
+  print *, selected_char_kind(4_"foo") ! { dg-error "must be of kind 1" }
+  print *, selected_char_kind(s1)
+  print *, selected_char_kind(s4) ! { dg-error "must be of kind 1" }
+
+  end
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_10.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_10.f90
new file mode 100644
index 000000000..c961d93cf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_10.f90
@@ -0,0 +1,89 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+  implicit none
+  character(kind=1,len=3) :: s1(3)
+  character(kind=4,len=3) :: s4(3)
+
+  s1 = [ "abc", "def", "ghi" ]
+  s4 = s1
+  s4 = [ "abc", "def", "ghi" ]
+
+  if (any (cshift (s1, 0) /= s1)) call abort
+  if (any (cshift (s4, 0) /= s4)) call abort
+  if (any (cshift (s1, 3) /= s1)) call abort
+  if (any (cshift (s4, 3) /= s4)) call abort
+  if (any (cshift (s1, 6) /= s1)) call abort
+  if (any (cshift (s4, 6) /= s4)) call abort
+  if (any (cshift (s1, -3) /= s1)) call abort
+  if (any (cshift (s4, -3) /= s4)) call abort
+  if (any (cshift (s1, -6) /= s1)) call abort
+  if (any (cshift (s4, -6) /= s4)) call abort
+
+  if (any (cshift (s1, 1) /= [ s1(2:3), s1(1) ])) call abort
+  if (any (cshift (s1, -1) /= [ s1(3), s1(1:2) ])) call abort
+  if (any (cshift (s1, 4) /= [ s1(2:3), s1(1) ])) call abort
+  if (any (cshift (s1, -4) /= [ s1(3), s1(1:2) ])) call abort
+
+  if (any (cshift (s4, 1) /= [ s4(2:3), s4(1) ])) call abort
+  if (any (cshift (s4, -1) /= [ s4(3), s4(1:2) ])) call abort
+  if (any (cshift (s4, 4) /= [ s4(2:3), s4(1) ])) call abort
+  if (any (cshift (s4, -4) /= [ s4(3), s4(1:2) ])) call abort
+
+  if (any (cshift (s1, 2) /= [ s1(3), s1(1:2) ])) call abort
+  if (any (cshift (s1, -2) /= [ s1(2:3), s1(1) ])) call abort
+  if (any (cshift (s1, 5) /= [ s1(3), s1(1:2) ])) call abort
+  if (any (cshift (s1, -5) /= [ s1(2:3), s1(1) ])) call abort
+
+  if (any (cshift (s4, 2) /= [ s4(3), s4(1:2) ])) call abort
+  if (any (cshift (s4, -2) /= [ s4(2:3), s4(1) ])) call abort
+  if (any (cshift (s4, 5) /= [ s4(3), s4(1:2) ])) call abort
+  if (any (cshift (s4, -5) /= [ s4(2:3), s4(1) ])) call abort
+
+
+  if (any (eoshift (s1, 0) /= s1)) call abort
+  if (any (eoshift (s4, 0) /= s4)) call abort
+  if (any (eoshift (s1, 3) /= "")) call abort
+  if (any (eoshift (s4, 3) /= 4_"")) call abort
+  if (any (eoshift (s1, 3, "   ") /= "")) call abort
+  if (any (eoshift (s4, 3, 4_"   ") /= 4_"")) call abort
+  if (any (eoshift (s1, 3, " x ") /= " x")) call abort
+  if (any (eoshift (s4, 3, 4_" x ") /= 4_" x")) call abort
+  if (any (eoshift (s1, -3) /= "")) call abort
+  if (any (eoshift (s4, -3) /= 4_"")) call abort
+  if (any (eoshift (s1, -3, "   ") /= "")) call abort
+  if (any (eoshift (s4, -3, 4_"   ") /= 4_"")) call abort
+  if (any (eoshift (s1, -3, " x ") /= " x")) call abort
+  if (any (eoshift (s4, -3, 4_" x ") /= 4_" x")) call abort
+  if (any (eoshift (s1, 4) /= "")) call abort
+  if (any (eoshift (s4, 4) /= 4_"")) call abort
+  if (any (eoshift (s1, 4, "   ") /= "")) call abort
+  if (any (eoshift (s4, 4, 4_"   ") /= 4_"")) call abort
+  if (any (eoshift (s1, 4, " x ") /= " x")) call abort
+  if (any (eoshift (s4, 4, 4_" x ") /= 4_" x")) call abort
+  if (any (eoshift (s1, -4) /= "")) call abort
+  if (any (eoshift (s4, -4) /= 4_"")) call abort
+  if (any (eoshift (s1, -4, "   ") /= "")) call abort
+  if (any (eoshift (s4, -4, 4_"   ") /= 4_"")) call abort
+  if (any (eoshift (s1, -4, " x ") /= " x")) call abort
+  if (any (eoshift (s4, -4, 4_" x ") /= 4_" x")) call abort
+
+  if (any (eoshift (s1, 1) /= [ s1(2:3), "   " ])) call abort
+  if (any (eoshift (s1, -1) /= [ "   ", s1(1:2) ])) call abort
+  if (any (eoshift (s1, 1, " x ") /= [ s1(2:3), " x " ])) call abort
+  if (any (eoshift (s1, -1, " x ") /= [ " x ", s1(1:2) ])) call abort
+  if (any (eoshift (s4, 1) /= [ s4(2:3), 4_"   " ])) call abort
+  if (any (eoshift (s4, -1) /= [ 4_"   ", s4(1:2) ])) call abort
+  if (any (eoshift (s4, 1, 4_" x ") /= [ s4(2:3), 4_" x " ])) call abort
+  if (any (eoshift (s4, -1, 4_" x ") /= [ 4_" x ", s4(1:2) ])) call abort
+
+  if (any (eoshift (s1, 2) /= [ s1(3), "   ", "   " ])) call abort
+  if (any (eoshift (s1, -2) /= [ "   ", "   ", s1(1) ])) call abort
+  if (any (eoshift (s1, 2, " x ") /= [ s1(3), " x ", " x " ])) call abort
+  if (any (eoshift (s1, -2, " x ") /= [ " x ", " x ", s1(1) ])) call abort
+  if (any (eoshift (s4, 2) /= [ s4(3), 4_"   ", 4_"   " ])) call abort
+  if (any (eoshift (s4, -2) /= [ 4_"   ", 4_"   ", s4(1) ])) call abort
+  if (any (eoshift (s4, 2, 4_" x ") /= [ s4(3), 4_" x ", 4_" x " ])) call abort
+  if (any (eoshift (s4, -2, 4_" x ") /= [ 4_" x ", 4_" x ", s4(1) ])) call abort
+
+end
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_2.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_2.f90
new file mode 100644
index 000000000..0a1d449b6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_2.f90
@@ -0,0 +1,129 @@
+! { dg-do compile }
+! { dg-options "-fmax-errors=1000" }
+
+program failme
+
+  integer :: i, j, array(20)
+  integer(kind=4) :: i4
+  integer(kind=8) :: i8
+  character(kind=1,len=20) :: s1, t1
+  character(kind=4,len=20) :: s4, t4
+
+  call ctime (i8, s1)
+  call ctime (i8, s4) ! { dg-error "must be of kind" }
+
+  call chdir (s1)
+  call chdir (s1, i)
+  call chdir (s4) ! { dg-error "must be of kind" }
+  call chdir (s4, i) ! { dg-error "must be of kind" }
+
+  call chmod (s1, t1)
+  call chmod (s1, t4) ! { dg-error "must be of kind" }
+  call chmod (s4, t1) ! { dg-error "must be of kind" }
+  call chmod (s4, t4) ! { dg-error "must be of kind" }
+  call chmod (s1, t1, i)
+  call chmod (s1, t4, i) ! { dg-error "must be of kind" }
+  call chmod (s4, t1, i) ! { dg-error "must be of kind" }
+  call chmod (s4, t4, i) ! { dg-error "must be of kind" }
+
+  call fdate (s1)
+  call fdate (s4) ! { dg-error "must be of kind" }
+
+  call gerror (s1)
+  call gerror (s4) ! { dg-error "must be of kind" }
+
+  call getcwd (s1)
+  call getcwd (s1, i)
+  call getcwd (s4) ! { dg-error "must be of kind" }
+  call getcwd (s4, i) ! { dg-error "must be of kind" }
+
+  call getenv (s1, t1)
+  call getenv (s1, t4) ! { dg-error "Type of argument" }
+  call getenv (s4, t1) ! { dg-error "Type of argument" }
+  call getenv (s4, t4) ! { dg-error "Type of argument" }
+
+  call getarg (i, s1)
+  call getarg (i, s4) ! { dg-error "must be of kind" }
+
+  call getlog (s1)
+  call getlog (s4) ! { dg-error "must be of kind" }
+
+  call fgetc (j, s1)
+  call fgetc (j, s1, i)
+  call fgetc (j, s4) ! { dg-error "must be of kind" }
+  call fgetc (j, s4, i) ! { dg-error "must be of kind" }
+
+  call fget (s1)
+  call fget (s1, i)
+  call fget (s4) ! { dg-error "must be of kind" }
+  call fget (s4, i) ! { dg-error "must be of kind" }
+
+  call fputc (j, s1)
+  call fputc (j, s1, i)
+  call fputc (j, s4) ! { dg-error "must be of kind" }
+  call fputc (j, s4, i) ! { dg-error "must be of kind" }
+
+  call fput (s1)
+  call fput (s1, i)
+  call fput (s4) ! { dg-error "must be of kind" }
+  call fput (s4, i) ! { dg-error "must be of kind" }
+
+  call hostnm (s1)
+  call hostnm (s1, i)
+  call hostnm (s4) ! { dg-error "must be of kind" }
+  call hostnm (s4, i) ! { dg-error "must be of kind" }
+
+  call link (s1, t1)
+  call link (s1, t4) ! { dg-error "must be of kind" }
+  call link (s4, t1) ! { dg-error "must be of kind" }
+  call link (s4, t4) ! { dg-error "must be of kind" }
+  call link (s1, t1, i)
+  call link (s1, t4, i) ! { dg-error "must be of kind" }
+  call link (s4, t1, i) ! { dg-error "must be of kind" }
+  call link (s4, t4, i) ! { dg-error "must be of kind" }
+
+  call perror (s1)
+  call perror (s4) ! { dg-error "must be of kind" }
+
+  call rename (s1, t1)
+  call rename (s1, t4) ! { dg-error "must be of kind" }
+  call rename (s4, t1) ! { dg-error "must be of kind" }
+  call rename (s4, t4) ! { dg-error "must be of kind" }
+  call rename (s1, t1, i)
+  call rename (s1, t4, i) ! { dg-error "must be of kind" }
+  call rename (s4, t1, i) ! { dg-error "must be of kind" }
+  call rename (s4, t4, i) ! { dg-error "must be of kind" }
+
+  call lstat (s1, array)
+  call lstat (s1, array, i)
+  call lstat (s4, array) ! { dg-error "must be of kind" }
+  call lstat (s4, array, i) ! { dg-error "must be of kind" }
+
+  call stat (s1, array)
+  call stat (s1, array, i)
+  call stat (s4, array) ! { dg-error "must be of kind" }
+  call stat (s4, array, i) ! { dg-error "must be of kind" }
+
+  call symlnk (s1, t1)
+  call symlnk (s1, t4) ! { dg-error "must be of kind" }
+  call symlnk (s4, t1) ! { dg-error "must be of kind" }
+  call symlnk (s4, t4) ! { dg-error "must be of kind" }
+  call symlnk (s1, t1, i)
+  call symlnk (s1, t4, i) ! { dg-error "must be of kind" }
+  call symlnk (s4, t1, i) ! { dg-error "must be of kind" }
+  call symlnk (s4, t4, i) ! { dg-error "must be of kind" }
+
+  call system (s1)
+  call system (s1, i)
+  call system (s4) ! { dg-error "Type of argument" }
+  call system (s4, i) ! { dg-error "Type of argument" }
+
+  call ttynam (i, s1)
+  call ttynam (i, s4) ! { dg-error "must be of kind" }
+
+  call unlink (s1)
+  call unlink (s1, i)
+  call unlink (s4) ! { dg-error "must be of kind" }
+  call unlink (s4, i) ! { dg-error "must be of kind" }
+
+end program failme
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_3.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_3.f90
new file mode 100644
index 000000000..7073b893b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_3.f90
@@ -0,0 +1,69 @@
+! { dg-do compile }
+! { dg-options "-fmax-errors=1000" }
+
+program failme
+
+  integer :: i, array(20)
+  integer(kind=4) :: i4
+  integer(kind=8) :: i8
+  character(kind=1,len=20) :: s1, t1
+  character(kind=4,len=20) :: s4, t4
+
+  print *, access (s1, t1)
+  print *, access (s1, t4) ! { dg-error "must be of kind" }
+  print *, access (s4, t1) ! { dg-error "must be of kind" }
+  print *, access (s4, t4) ! { dg-error "must be of kind" }
+
+  print *, chdir (s1)
+  print *, chdir (s4) ! { dg-error "must be of kind" }
+
+  print *, chmod (s1, t1)
+  print *, chmod (s1, t4) ! { dg-error "must be of kind" }
+  print *, chmod (s4, t1) ! { dg-error "must be of kind" }
+  print *, chmod (s4, t4) ! { dg-error "must be of kind" }
+
+  print *, fget (s1)
+  print *, fget (s4) ! { dg-error "must be of kind" }
+
+  print *, fgetc (i, s1)
+  print *, fgetc (i, s4) ! { dg-error "must be of kind" }
+
+  print *, fput (s1)
+  print *, fput (s4) ! { dg-error "must be of kind" }
+
+  print *, fputc (i, s1)
+  print *, fputc (i, s4) ! { dg-error "must be of kind" }
+
+  print *, getcwd (s1)
+  print *, getcwd (s4) ! { dg-error "Type of argument" }
+
+  print *, hostnm (s1)
+  print *, hostnm (s4) ! { dg-error "must be of kind" }
+
+  print *, link (s1, t1)
+  print *, link (s1, t4) ! { dg-error "must be of kind" }
+  print *, link (s4, t1) ! { dg-error "must be of kind" }
+  print *, link (s4, t4) ! { dg-error "must be of kind" }
+
+  print *, lstat (s1, array)
+  print *, lstat (s4, array) ! { dg-error "must be of kind" }
+  print *, stat (s1, array)
+  print *, stat (s4, array) ! { dg-error "must be of kind" }
+
+  print *, rename (s1, t1)
+  print *, rename (s1, t4) ! { dg-error "must be of kind" }
+  print *, rename (s4, t1) ! { dg-error "must be of kind" }
+  print *, rename (s4, t4) ! { dg-error "must be of kind" }
+
+  print *, symlnk (s1, t1)
+  print *, symlnk (s1, t4) ! { dg-error "must be of kind" }
+  print *, symlnk (s4, t1) ! { dg-error "must be of kind" }
+  print *, symlnk (s4, t4) ! { dg-error "must be of kind" }
+
+  print *, system (s1)
+  print *, system (s4) ! { dg-error "Type of argument" }
+
+  print *, unlink (s1)
+  print *, unlink (s4) ! { dg-error "must be of kind" }
+
+end program failme
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_4.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_4.f90
new file mode 100644
index 000000000..c9f8e8cd2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_4.f90
@@ -0,0 +1,121 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+  character(kind=1,len=20) :: s1
+  character(kind=4,len=20) :: s4
+
+  call test_adjust1 ("  foo bar ", 4_"  foo bar ")
+  s1 = "  foo bar " ; s4 = 4_"  foo bar "
+  call test_adjust2 (s1, s4)
+
+  call test_adjust1 ("  foo bar \xFF", 4_"  foo bar \xFF")
+  s1 = "  foo bar \xFF" ; s4 = 4_"  foo bar \xFF"
+  call test_adjust2 (s1, s4)
+
+  call test_adjust1 ("\0  foo bar \xFF", 4_"\0  foo bar \xFF")
+  s1 = "\0  foo bar \xFF" ; s4 = 4_"\0  foo bar \xFF"
+  call test_adjust2 (s1, s4)
+
+  s4 = "\0  foo bar \xFF"
+  if (adjustl (s4) /= adjustl (4_"\0  foo bar \xFF        ")) call abort
+  if (adjustr (s4) /= adjustr (4_"\0  foo bar \xFF        ")) call abort
+
+  s4 = "   \0  foo bar \xFF"
+  if (adjustl (s4) /= adjustl (4_"   \0  foo bar \xFF     ")) call abort
+  if (adjustr (s4) /= adjustr (4_"   \0  foo bar \xFF     ")) call abort
+
+  s4 = 4_" \U12345678\xeD bar \ufd30"
+  if (adjustl (s4) /= &
+      adjustl (4_" \U12345678\xeD bar \ufd30           ")) call abort
+  if (adjustr (s4) /= &
+      adjustr (4_" \U12345678\xeD bar \ufd30           ")) call abort
+
+contains
+
+  subroutine test_adjust1 (s1, s4)
+
+    character(kind=1,len=*) :: s1
+    character(kind=4,len=*) :: s4
+
+    character(kind=1,len=len(s4)) :: t1
+    character(kind=4,len=len(s1)) :: t4
+
+    if (len(s1) /= len(s4)) call abort
+    if (len(t1) /= len(t4)) call abort
+
+    if (len_trim(s1) /= len_trim (s4)) call abort
+
+    t1 = adjustl (s4)
+    t4 = adjustl (s1)
+    if (t1 /= adjustl (s1)) call abort
+    if (t4 /= adjustl (s4)) call abort
+    if (len_trim (t1) /= len_trim (t4)) call abort
+    if (len_trim (adjustl (s1)) /= len_trim (t4)) call abort
+    if (len_trim (adjustl (s4)) /= len_trim (t1)) call abort
+
+    if (len_trim (t1) /= len (trim (t1))) call abort
+    if (len_trim (s1) /= len (trim (s1))) call abort
+    if (len_trim (t4) /= len (trim (t4))) call abort
+    if (len_trim (s4) /= len (trim (s4))) call abort
+
+    t1 = adjustr (s4)
+    t4 = adjustr (s1)
+    if (t1 /= adjustr (s1)) call abort
+    if (t4 /= adjustr (s4)) call abort
+    if (len_trim (t1) /= len_trim (t4)) call abort
+    if (len_trim (adjustr (s1)) /= len_trim (t4)) call abort
+    if (len_trim (adjustr (s4)) /= len_trim (t1)) call abort
+    if (len (t1) /= len_trim (t1)) call abort
+    if (len (t4) /= len_trim (t4)) call abort
+
+    if (len_trim (t1) /= len (trim (t1))) call abort
+    if (len_trim (s1) /= len (trim (s1))) call abort
+    if (len_trim (t4) /= len (trim (t4))) call abort
+    if (len_trim (s4) /= len (trim (s4))) call abort
+
+  end subroutine test_adjust1
+
+  subroutine test_adjust2 (s1, s4)
+
+    character(kind=1,len=20) :: s1
+    character(kind=4,len=20) :: s4
+
+    character(kind=1,len=len(s4)) :: t1
+    character(kind=4,len=len(s1)) :: t4
+
+    if (len(s1) /= len(s4)) call abort
+    if (len(t1) /= len(t4)) call abort
+
+    if (len_trim(s1) /= len_trim (s4)) call abort
+
+    t1 = adjustl (s4)
+    t4 = adjustl (s1)
+    if (t1 /= adjustl (s1)) call abort
+    if (t4 /= adjustl (s4)) call abort
+    if (len_trim (t1) /= len_trim (t4)) call abort
+    if (len_trim (adjustl (s1)) /= len_trim (t4)) call abort
+    if (len_trim (adjustl (s4)) /= len_trim (t1)) call abort
+
+    if (len_trim (t1) /= len (trim (t1))) call abort
+    if (len_trim (s1) /= len (trim (s1))) call abort
+    if (len_trim (t4) /= len (trim (t4))) call abort
+    if (len_trim (s4) /= len (trim (s4))) call abort
+
+    t1 = adjustr (s4)
+    t4 = adjustr (s1)
+    if (t1 /= adjustr (s1)) call abort
+    if (t4 /= adjustr (s4)) call abort
+    if (len_trim (t1) /= len_trim (t4)) call abort
+    if (len_trim (adjustr (s1)) /= len_trim (t4)) call abort
+    if (len_trim (adjustr (s4)) /= len_trim (t1)) call abort
+    if (len (t1) /= len_trim (t1)) call abort
+    if (len (t4) /= len_trim (t4)) call abort
+
+    if (len_trim (t1) /= len (trim (t1))) call abort
+    if (len_trim (s1) /= len (trim (s1))) call abort
+    if (len_trim (t4) /= len (trim (t4))) call abort
+    if (len_trim (s4) /= len (trim (s4))) call abort
+
+  end subroutine test_adjust2
+
+end
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_5.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_5.f90
new file mode 100644
index 000000000..e388685ad
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_5.f90
@@ -0,0 +1,121 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+  implicit none
+  integer :: i, j
+  character(kind=4,len=5), dimension(3,3), parameter :: &
+    p = reshape([4_" \xFF   ", 4_"\0    ", 4_" foo ", &
+                 4_"\u1230\uD67Bde\U31DC8B30", 4_"     ", 4_"fa fe", &
+                 4_"     ", 4_"foo  ", 4_"nul\0l"], [3,3])
+       
+  character(kind=4,len=5), dimension(3,3) :: m1
+  character(kind=4,len=5), allocatable, dimension(:,:) :: m2
+
+  if (kind (p) /= 4) call abort
+  if (kind (m1) /= 4) call abort
+  if (kind (m2) /= 4) call abort
+
+  m1 = reshape (p, [3,3])
+
+  allocate (m2(3,3))
+  m2(:,:) = reshape (m1, [3,3])
+
+  if (any (m1 /= p)) call abort
+  if (any (m2 /= p)) call abort
+
+  if (size (p) /= 9) call abort
+  if (size (m1) /= 9) call abort
+  if (size (m2) /= 9) call abort
+  if (size (p,1) /= 3) call abort
+  if (size (m1,1) /= 3) call abort
+  if (size (m2,1) /= 3) call abort
+  if (size (p,2) /= 3) call abort
+  if (size (m1,2) /= 3) call abort
+  if (size (m2,2) /= 3) call abort
+
+  call check_shape (p, (/3,3/), 5)
+  call check_shape (p, shape(p), 5)
+  call check_shape (m1, (/3,3/), 5)
+  call check_shape (m1, shape(m1), 5)
+  call check_shape (m1, (/3,3/), 5)
+  call check_shape (m1, shape(m1), 5)
+
+  deallocate (m2)
+
+
+  allocate (m2(3,4))
+  m2 = reshape (m1, [3,4], p)
+  if (any (m2(1:3,1:3) /= p)) call abort
+  if (any (m2(1:3,4) /= m1(1:3,1))) call abort
+  call check_shape (m2, (/3,4/), 5)
+  deallocate (m2)
+
+  allocate (m2(3,3))
+  do i = 1, 3
+    do j = 1, 3
+      m2(i,j) = m1(i,j)
+    end do
+  end do
+
+  m2 = transpose(m2)
+  if (any(transpose(p) /= m2)) call abort
+  if (any(transpose(m1) /= m2)) call abort
+  if (any(transpose(m2) /= p)) call abort
+  if (any(transpose(m2) /= m1)) call abort
+
+  m1 = transpose(p)
+  if (any(transpose(p) /= m2)) call abort
+  if (any(m1 /= m2)) call abort
+  if (any(transpose(m2) /= p)) call abort
+  if (any(transpose(m2) /= transpose(m1))) call abort
+  deallocate (m2)
+
+  allocate (m2(3,3))
+  m2 = p
+  m1 = m2
+  if (any (spread ( p, 1, 2) /= spread (m1, 1, 2))) call abort
+  if (any (spread ( p, 1, 2) /= spread (m2, 1, 2))) call abort
+  if (any (spread (m1, 1, 2) /= spread (m2, 1, 2))) call abort
+  deallocate (m2)
+
+  allocate (m2(3,3))
+  m2 = p
+  m1 = m2
+  if (any (pack (p, p /= 4_"") /= [4_" \xFF   ", 4_"\0    ", 4_" foo ", &
+                                   4_"\u1230\uD67Bde\U31DC8B30", 4_"fa fe", &
+                                   4_"foo  ", 4_"nul\0l"])) call abort
+  if (any (len_trim (pack (p, p /= 4_"")) /= [2,1,4,5,5,3,5])) call abort
+  if (any (pack (m1, m1 /= 4_"") /= [4_" \xFF   ", 4_"\0    ", 4_" foo ", &
+                                   4_"\u1230\uD67Bde\U31DC8B30", 4_"fa fe", &
+                                   4_"foo  ", 4_"nul\0l"])) call abort
+  if (any (len_trim (pack (m1, m1 /= 4_"")) /= [2,1,4,5,5,3,5])) call abort
+  if (any (pack (m2, m2 /= 4_"") /= [4_" \xFF   ", 4_"\0    ", 4_" foo ", &
+                                   4_"\u1230\uD67Bde\U31DC8B30", 4_"fa fe", &
+                                   4_"foo  ", 4_"nul\0l"])) call abort
+  if (any (len_trim (pack (m2, m2 /= 4_"")) /= [2,1,4,5,5,3,5])) call abort
+  deallocate (m2)
+
+  allocate (m2(1,7))
+  m2 = reshape ([4_" \xFF   ", 4_"\0    ", 4_" foo ", &
+                 4_"\u1230\uD67Bde\U31DC8B30", 4_"fa fe", &
+                 4_"foo  ", 4_"nul\0l"], [1,7])
+  m1 = p
+  if (any (unpack(m2(1,:), p /= 4_"", 4_"     ") /= p)) call abort
+  if (any (unpack(m2(1,:), m1 /= 4_"", 4_"     ") /= m1)) call abort
+  deallocate (m2)
+
+contains
+
+  subroutine check_shape (array, res, l)
+    character(kind=4,len=*), dimension(:,:) :: array
+    integer, dimension(:) :: res
+    integer :: l
+
+    if (kind (array) /= 4) call abort
+    if (len(array) /= l) call abort
+
+    if (size (res) /= size (shape (array))) call abort
+    if (any (shape (array) /= res)) call abort
+  end subroutine check_shape
+
+end
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_6.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_6.f90
new file mode 100644
index 000000000..68b46d8f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_6.f90
@@ -0,0 +1,109 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+  character(kind=1, len=3) :: s1
+  character(kind=4, len=3) :: s4
+  integer :: i
+
+  s1 = "fo "
+  s4 = 4_"fo "
+  i = 3
+
+  ! Check the REPEAT intrinsic
+
+  if (repeat (1_"foo", 2) /= 1_"foofoo") call abort
+  if (repeat (1_"fo ", 2) /= 1_"fo fo ") call abort
+  if (repeat (1_"fo ", 2) /= 1_"fo fo") call abort
+  if (repeat (1_"fo ", 0) /= 1_"") call abort
+  if (repeat (s1, 2) /= 1_"fo fo ") call abort
+  if (repeat (s1, 2) /= 1_"fo fo") call abort
+  if (repeat (s1, 2) /= s1 // s1) call abort
+  if (repeat (s1, 3) /= s1 // s1 // s1) call abort
+  if (repeat (s1, 1) /= s1) call abort
+  if (repeat (s1, 0) /= "") call abort
+
+  if (repeat (4_"foo", 2) /= 4_"foofoo") call abort
+  if (repeat (4_"fo ", 2) /= 4_"fo fo ") call abort
+  if (repeat (4_"fo ", 2) /= 4_"fo fo") call abort
+  if (repeat (4_"fo ", 0) /= 4_"") call abort
+  if (repeat (s4, 2) /= 4_"fo fo ") call abort
+  if (repeat (s4, 2) /= 4_"fo fo") call abort
+  if (repeat (s4, 3) /= s4 // s4 // s4) call abort
+  if (repeat (s4, 1) /= s4) call abort
+  if (repeat (s4, 0) /= 4_"") call abort
+
+  call check_repeat (s1, s4)
+  call check_repeat ("", 4_"")
+  call check_repeat ("truc", 4_"truc")
+  call check_repeat ("truc ", 4_"truc ")
+
+  ! Check NEW_LINE
+
+  if (ichar(new_line ("")) /= 10) call abort
+  if (len(new_line ("")) /= 1) call abort
+  if (ichar(new_line (s1)) /= 10) call abort
+  if (len(new_line (s1)) /= 1) call abort
+  if (ichar(new_line (["",""])) /= 10) call abort
+  if (len(new_line (["",""])) /= 1) call abort
+  if (ichar(new_line ([s1,s1])) /= 10) call abort
+  if (len(new_line ([s1,s1])) /= 1) call abort
+
+  if (ichar(new_line (4_"")) /= 10) call abort
+  if (len(new_line (4_"")) /= 1) call abort
+  if (ichar(new_line (s4)) /= 10) call abort
+  if (len(new_line (s4)) /= 1) call abort
+  if (ichar(new_line ([4_"",4_""])) /= 10) call abort
+  if (len(new_line ([4_"",4_""])) /= 1) call abort
+  if (ichar(new_line ([s4,s4])) /= 10) call abort
+  if (len(new_line ([s4,s4])) /= 1) call abort
+
+  ! Check SIZEOF
+
+  if (sizeof ("") /= 0) call abort
+  if (sizeof (4_"") /= 0) call abort
+  if (sizeof ("x") /= 1) call abort
+  if (sizeof ("\xFF") /= 1) call abort
+  if (sizeof (4_"x") /= 4) call abort
+  if (sizeof (4_"\UFFFFFFFF") /= 4) call abort
+  if (sizeof (s1) /= 3) call abort
+  if (sizeof (s4) /= 12) call abort
+
+  if (sizeof (["a", "x", "z"]) / sizeof ("a") /= 3) call abort
+  if (sizeof ([4_"a", 4_"x", 4_"z"]) / sizeof (4_"a") /= 3) call abort
+
+  call check_sizeof ("", 4_"", 0)
+  call check_sizeof ("x", 4_"x", 1)
+  call check_sizeof ("\xFF", 4_"\UFEBCE19E", 1)
+  call check_sizeof ("\xFF ", 4_"\UFEBCE19E ", 2)
+  call check_sizeof (s1, s4, 3)
+
+contains
+
+  subroutine check_repeat (s1, s4)
+    character(kind=1, len=*), intent(in) :: s1
+    character(kind=4, len=*), intent(in) :: s4
+    integer :: i
+
+    do i = 0, 10
+      if (len (repeat(s1, i)) /= i * len(s1)) call abort
+      if (len (repeat(s4, i)) /= i * len(s4)) call abort
+
+      if (len_trim (repeat(s1, i)) &
+          /= max(0, (i - 1) * len(s1) + len_trim (s1))) call abort
+      if (len_trim (repeat(s4, i)) &
+          /= max(0, (i - 1) * len(s4) + len_trim (s4))) call abort
+    end do
+  end subroutine check_repeat
+
+  subroutine check_sizeof (s1, s4, i)
+    character(kind=1, len=*), intent(in) :: s1
+    character(kind=4, len=*), intent(in) :: s4
+    character(kind=4, len=len(s4)) :: t4
+    integer, intent(in) :: i
+    
+    if (sizeof (s1) /= i) call abort
+    if (sizeof (s4) / sizeof (4_" ") /= i) call abort
+    if (sizeof (t4) / sizeof (4_" ") /= i) call abort
+  end subroutine check_sizeof
+
+end
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_7.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_7.f90
new file mode 100644
index 000000000..7971af396
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_7.f90
@@ -0,0 +1,125 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+  character(kind=1, len=10) :: s1, t1
+  character(kind=4, len=10) :: s4, t4
+
+  call check1("foobargeefoobargee", "arg", &
+              [ index  ("foobargeefoobargee", "arg", .true.),  &
+                index  ("foobargeefoobargee", "arg", .false.), &
+                scan   ("foobargeefoobargee", "arg", .true.),  &
+                scan   ("foobargeefoobargee", "arg", .false.), &
+                verify ("foobargeefoobargee", "arg", .true.),  &
+                verify ("foobargeefoobargee", "arg", .false.) ], &
+              4_"foobargeefoobargee", 4_"arg", &
+              [ index  (4_"foobargeefoobargee", 4_"arg", .true.),  &
+                index  (4_"foobargeefoobargee", 4_"arg", .false.), &
+                scan   (4_"foobargeefoobargee", 4_"arg", .true.),  &
+                scan   (4_"foobargeefoobargee", 4_"arg", .false.), &
+                verify (4_"foobargeefoobargee", 4_"arg", .true.),  &
+                verify (4_"foobargeefoobargee", 4_"arg", .false.) ])
+
+  call check1("foobargeefoobargee", "", &
+              [ index  ("foobargeefoobargee", "", .true.),  &
+                index  ("foobargeefoobargee", "", .false.), &
+                scan   ("foobargeefoobargee", "", .true.),  &
+                scan   ("foobargeefoobargee", "", .false.), &
+                verify ("foobargeefoobargee", "", .true.),  &
+                verify ("foobargeefoobargee", "", .false.) ], &
+              4_"foobargeefoobargee", 4_"", &
+              [ index  (4_"foobargeefoobargee", 4_"", .true.),  &
+                index  (4_"foobargeefoobargee", 4_"", .false.), &
+                scan   (4_"foobargeefoobargee", 4_"", .true.),  &
+                scan   (4_"foobargeefoobargee", 4_"", .false.), &
+                verify (4_"foobargeefoobargee", 4_"", .true.),  &
+                verify (4_"foobargeefoobargee", 4_"", .false.) ])
+  call check1("foobargeefoobargee", "klm", &
+              [ index  ("foobargeefoobargee", "klm", .true.),  &
+                index  ("foobargeefoobargee", "klm", .false.), &
+                scan   ("foobargeefoobargee", "klm", .true.),  &
+                scan   ("foobargeefoobargee", "klm", .false.), &
+                verify ("foobargeefoobargee", "klm", .true.),  &
+                verify ("foobargeefoobargee", "klm", .false.) ], &
+              4_"foobargeefoobargee", 4_"klm", &
+              [ index  (4_"foobargeefoobargee", 4_"klm", .true.),  &
+                index  (4_"foobargeefoobargee", 4_"klm", .false.), &
+                scan   (4_"foobargeefoobargee", 4_"klm", .true.),  &
+                scan   (4_"foobargeefoobargee", 4_"klm", .false.), &
+                verify (4_"foobargeefoobargee", 4_"klm", .true.),  &
+                verify (4_"foobargeefoobargee", 4_"klm", .false.) ])
+  call check1("foobargeefoobargee", "gee", &
+              [ index  ("foobargeefoobargee", "gee", .true.),  &
+                index  ("foobargeefoobargee", "gee", .false.), &
+                scan   ("foobargeefoobargee", "gee", .true.),  &
+                scan   ("foobargeefoobargee", "gee", .false.), &
+                verify ("foobargeefoobargee", "gee", .true.),  &
+                verify ("foobargeefoobargee", "gee", .false.) ], &
+              4_"foobargeefoobargee", 4_"gee", &
+              [ index  (4_"foobargeefoobargee", 4_"gee", .true.),  &
+                index  (4_"foobargeefoobargee", 4_"gee", .false.), &
+                scan   (4_"foobargeefoobargee", 4_"gee", .true.),  &
+                scan   (4_"foobargeefoobargee", 4_"gee", .false.), &
+                verify (4_"foobargeefoobargee", 4_"gee", .true.),  &
+                verify (4_"foobargeefoobargee", 4_"gee", .false.) ])
+  call check1("foobargeefoobargee", "foo", &
+              [ index  ("foobargeefoobargee", "foo", .true.),  &
+                index  ("foobargeefoobargee", "foo", .false.), &
+                scan   ("foobargeefoobargee", "foo", .true.),  &
+                scan   ("foobargeefoobargee", "foo", .false.), &
+                verify ("foobargeefoobargee", "foo", .true.),  &
+                verify ("foobargeefoobargee", "foo", .false.) ], &
+              4_"foobargeefoobargee", 4_"foo", &
+              [ index  (4_"foobargeefoobargee", 4_"foo", .true.),  &
+                index  (4_"foobargeefoobargee", 4_"foo", .false.), &
+                scan   (4_"foobargeefoobargee", 4_"foo", .true.),  &
+                scan   (4_"foobargeefoobargee", 4_"foo", .false.), &
+                verify (4_"foobargeefoobargee", 4_"foo", .true.),  &
+                verify (4_"foobargeefoobargee", 4_"foo", .false.) ])
+
+  call check1("  \b fe \b\0 bar cad", " \b\0", &
+              [ index  ("  \b fe \b\0 bar cad", " \b\0", .true.),  &
+                index  ("  \b fe \b\0 bar cad", " \b\0", .false.), &
+                scan   ("  \b fe \b\0 bar cad", " \b\0", .true.),  &
+                scan   ("  \b fe \b\0 bar cad", " \b\0", .false.), &
+                verify ("  \b fe \b\0 bar cad", " \b\0", .true.),  &
+                verify ("  \b fe \b\0 bar cad", " \b\0", .false.) ], &
+              4_"  \uC096 fe \uC096\uB8DE bar cad", 4_" \uC096\uB8DE", &
+              [ index  (4_"  \uC096 fe \uC096\uB8DE bar cad", &
+                        4_" \uC096\uB8DE", .true.),  &
+                index  (4_"  \uC096 fe \uC096\uB8DE bar cad", &
+                        4_" \uC096\uB8DE", .false.), &
+                scan   (4_"  \uC096 fe \uC096\uB8DE bar cad", &
+                        4_" \uC096\uB8DE", .true.),  &
+                scan   (4_"  \uC096 fe \uC096\uB8DE bar cad", &
+                        4_" \uC096\uB8DE", .false.), &
+                verify (4_"  \uC096 fe \uC096\uB8DE bar cad", &
+                        4_" \uC096\uB8DE", .true.),  &
+                verify (4_"  \uC096 fe \uC096\uB8DE bar cad", &
+                        4_" \uC096\uB8DE", .false.) ])
+
+contains
+
+  subroutine check1 (s1, t1, res1, s4, t4, res4)
+    character(kind=1, len=*) :: s1, t1
+    character(kind=4, len=*) :: s4, t4
+    integer :: res1(6), res4(6)
+
+    if (any (res1 /= res4)) call abort
+
+    if (index  (s1, t1, .true.)  /= res1(1)) call abort
+    if (index  (s1, t1, .false.) /= res1(2)) call abort
+    if (scan   (s1, t1, .true.)  /= res1(3)) call abort
+    if (scan   (s1, t1, .false.) /= res1(4)) call abort
+    if (verify (s1, t1, .true.)  /= res1(5)) call abort
+    if (verify (s1, t1, .false.) /= res1(6)) call abort
+
+    if (index  (s4, t4, .true.)  /= res4(1)) call abort
+    if (index  (s4, t4, .false.) /= res4(2)) call abort
+    if (scan   (s4, t4, .true.)  /= res4(3)) call abort
+    if (scan   (s4, t4, .false.) /= res4(4)) call abort
+    if (verify (s4, t4, .true.)  /= res4(5)) call abort
+    if (verify (s4, t4, .false.) /= res4(6)) call abort
+
+  end subroutine check1
+
+end
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_8.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_8.f90
new file mode 100644
index 000000000..eeeabbca5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_8.f90
@@ -0,0 +1,85 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+  logical, parameter :: bigendian = transfer ((/1_1,0_1,0_1,0_1/), 0_4) /= 1
+
+  character(kind=1,len=3) :: s1, t1, u1
+  character(kind=4,len=3) :: s4, t4, u4
+
+  ! Test MERGE intrinsic
+
+  call check_merge1 ("foo", "gee", .true., .false.)
+  call check_merge4 (4_"foo", 4_"gee", .true., .false.)
+
+  if (merge ("foo", "gee", .true.) /= "foo") call abort
+  if (merge ("foo", "gee", .false.) /= "gee") call abort
+  if (merge (4_"foo", 4_"gee", .true.) /= 4_"foo") call abort
+  if (merge (4_"foo", 4_"gee", .false.) /= 4_"gee") call abort
+
+  ! Test TRANSFER intrinsic
+
+  if (bigendian) then
+    if (transfer (4_"x", "    ") /= "\0\0\0x") call abort
+  else
+    if (transfer (4_"x", "    ") /= "x\0\0\0") call abort
+  endif
+  if (transfer (4_"\U44444444", "    ") /= "\x44\x44\x44\x44") call abort
+  if (transfer (4_"\U3FE91B5A", 0_4) /= int(z'3FE91B5A', 4)) call abort
+
+  call check_transfer_i (4_"\U3FE91B5A", [int(z'3FE91B5A', 4)])
+  call check_transfer_i (4_"\u1B5A", [int(z'1B5A', 4)])
+
+contains
+
+  subroutine check_merge1 (s1, t1, t, f)
+    character(kind=1,len=*) :: s1, t1
+    logical :: t, f
+
+    if (merge (s1, t1, .true.) /= s1) call abort
+    if (merge (s1, t1, .false.) /= t1) call abort
+    if (len (merge (s1, t1, .true.)) /= len (s1)) call abort
+    if (len (merge (s1, t1, .false.)) /= len (t1)) call abort
+    if (len_trim (merge (s1, t1, .true.)) /= len_trim (s1)) call abort
+    if (len_trim (merge (s1, t1, .false.)) /= len_trim (t1)) call abort
+
+    if (merge (s1, t1, t) /= s1) call abort
+    if (merge (s1, t1, f) /= t1) call abort
+    if (len (merge (s1, t1, t)) /= len (s1)) call abort
+    if (len (merge (s1, t1, f)) /= len (t1)) call abort
+    if (len_trim (merge (s1, t1, t)) /= len_trim (s1)) call abort
+    if (len_trim (merge (s1, t1, f)) /= len_trim (t1)) call abort
+
+  end subroutine check_merge1
+
+  subroutine check_merge4 (s4, t4, t, f)
+    character(kind=4,len=*) :: s4, t4
+    logical :: t, f
+
+    if (merge (s4, t4, .true.) /= s4) call abort
+    if (merge (s4, t4, .false.) /= t4) call abort
+    if (len (merge (s4, t4, .true.)) /= len (s4)) call abort
+    if (len (merge (s4, t4, .false.)) /= len (t4)) call abort
+    if (len_trim (merge (s4, t4, .true.)) /= len_trim (s4)) call abort
+    if (len_trim (merge (s4, t4, .false.)) /= len_trim (t4)) call abort
+
+    if (merge (s4, t4, t) /= s4) call abort
+    if (merge (s4, t4, f) /= t4) call abort
+    if (len (merge (s4, t4, t)) /= len (s4)) call abort
+    if (len (merge (s4, t4, f)) /= len (t4)) call abort
+    if (len_trim (merge (s4, t4, t)) /= len_trim (s4)) call abort
+    if (len_trim (merge (s4, t4, f)) /= len_trim (t4)) call abort
+
+  end subroutine check_merge4
+
+  subroutine check_transfer_i (s, i)
+    character(kind=4,len=*) :: s
+    integer(kind=4), dimension(len(s)) :: i
+
+    if (transfer (s, 0_4) /= ichar (s(1:1))) call abort
+    if (transfer (s, 0_4) /= i(1)) call abort
+    if (any (transfer (s, [0_4]) /= i)) call abort
+    if (any (transfer (s, 0_4, len(s)) /= i)) call abort
+
+  end subroutine check_transfer_i
+
+end
diff --git a/gcc/testsuite/gfortran.dg/widechar_intrinsics_9.f90 b/gcc/testsuite/gfortran.dg/widechar_intrinsics_9.f90
new file mode 100644
index 000000000..ca6fa5818
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_intrinsics_9.f90
@@ -0,0 +1,70 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+  implicit none
+  character(kind=1,len=3) :: s1, t1
+  character(kind=4,len=3) :: s4, t4
+
+  s1 = "foo" ; t1 = "bar"
+  call check_minmax_1 ("foo", "bar", min("foo","bar"), max("foo","bar"))
+  call check_minmax_1 ("bar", "foo", min("foo","bar"), max("foo","bar"))
+  call check_minmax_1 (s1, t1, min(s1,t1), max(s1,t1))
+  call check_minmax_1 (t1, s1, min(s1,t1), max(s1,t1))
+
+  s1 = "   " ; t1 = "bar"
+  call check_minmax_1 ("   ", "bar", min("   ","bar"), max("   ","bar"))
+  call check_minmax_1 ("bar", "   ", min("   ","bar"), max("   ","bar"))
+  call check_minmax_1 (s1, t1, min(s1,t1), max(s1,t1))
+  call check_minmax_1 (t1, s1, min(s1,t1), max(s1,t1))
+
+  s1 = "   " ; t1 = "   "
+  call check_minmax_1 ("   ", "   ", min("   ","   "), max("   ","   "))
+  call check_minmax_1 ("   ", "   ", min("   ","   "), max("   ","   "))
+  call check_minmax_1 (s1, t1, min(s1,t1), max(s1,t1))
+  call check_minmax_1 (t1, s1, min(s1,t1), max(s1,t1))
+
+  s1 = "d\xFF " ; t1 = "d  "
+  call check_minmax_1 ("d\xFF ", "d  ", min("d\xFF ","d  "), max("d\xFF ","d  "))
+  call check_minmax_1 ("d  ", "d\xFF ", min("d\xFF ","d  "), max("d\xFF ","d  "))
+  call check_minmax_1 (s1, t1, min(s1,t1), max(s1,t1))
+  call check_minmax_1 (t1, s1, min(s1,t1), max(s1,t1))
+
+  s4 = 4_"   " ; t4 = 4_"xxx"
+  call check_minmax_2 (4_"   ", 4_"xxx", min(4_"   ", 4_"xxx"), &
+                       max(4_"   ", 4_"xxx"))
+  call check_minmax_2 (4_"xxx", 4_"   ", min(4_"   ", 4_"xxx"), &
+                       max(4_"   ", 4_"xxx"))
+  call check_minmax_2 (s4, t4, min(s4,t4), max(s4,t4))
+  call check_minmax_2 (t4, s4, min(s4,t4), max(s4,t4))
+
+  s4 = 4_" \u1be3m" ; t4 = 4_"xxx"
+  call check_minmax_2 (4_" \u1be3m", 4_"xxx", min(4_" \u1be3m", 4_"xxx"), &
+                       max(4_" \u1be3m", 4_"xxx"))
+  call check_minmax_2 (4_"xxx", 4_" \u1be3m", min(4_" \u1be3m", 4_"xxx"), &
+                       max(4_" \u1be3m", 4_"xxx"))
+  call check_minmax_2 (s4, t4, min(s4,t4), max(s4,t4))
+  call check_minmax_2 (t4, s4, min(s4,t4), max(s4,t4))
+
+contains
+
+  subroutine check_minmax_1 (s1, s2, smin, smax)
+    implicit none
+    character(kind=1,len=*), intent(in) :: s1, s2, smin, smax
+    character(kind=4,len=len(s1)) :: w1, w2, wmin, wmax
+
+    w1 = s1 ; w2 = s2 ; wmin = smin ; wmax = smax
+    if (min (w1, w2) /= wmin) call abort
+    if (max (w1, w2) /= wmax) call abort
+    if (min (s1, s2) /= smin) call abort
+    if (max (s1, s2) /= smax) call abort
+  end subroutine check_minmax_1
+
+  subroutine check_minmax_2 (s1, s2, smin, smax)
+    implicit none
+    character(kind=4,len=*), intent(in) :: s1, s2, smin, smax
+
+    if (min (s1, s2) /= smin) call abort
+    if (max (s1, s2) /= smax) call abort
+  end subroutine check_minmax_2
+
+end
diff --git a/gcc/testsuite/gfortran.dg/widechar_select_1.f90 b/gcc/testsuite/gfortran.dg/widechar_select_1.f90
new file mode 100644
index 000000000..64315af0b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_select_1.f90
@@ -0,0 +1,55 @@
+! { dg-do run }
+! { dg-options "-fbackslash" }
+
+  call testme(test("foo"), test4(4_"foo"), 1)
+  call testme(test(""), test4(4_""), 1)
+  call testme(test("gee"), test4(4_"gee"), 4)
+  call testme(test("bar"), test4(4_"bar"), 1)
+  call testme(test("magi"), test4(4_"magi"), 4)
+  call testme(test("magic"), test4(4_"magic"), 2)
+  call testme(test("magic   "), test4(4_"magic   "), 2)
+  call testme(test("magica"), test4(4_"magica"), 4)
+  call testme(test("freeze"), test4(4_"freeze"), 3)
+  call testme(test("freeze "), test4(4_"freeze "), 3)
+  call testme(test("frugal"), test4(4_"frugal"), 3)
+  call testme(test("frugal "), test4(4_"frugal "), 3)
+  call testme(test("frugal \x01"), test4(4_"frugal \x01"), 3)
+  call testme(test("frugal \xFF"), test4(4_"frugal \xFF"), 4)
+
+contains
+  integer function test(s)
+    character(len=*) :: s
+  
+    select case (s)
+      case ("":"foo")
+        test = 1
+      case ("magic")
+        test = 2
+      case ("freeze":"frugal")
+        test = 3
+      case default
+        test = 4
+    end select
+  end function test
+
+  integer function test4(s)
+    character(kind=4,len=*) :: s
+  
+    select case (s)
+      case (4_"":4_"foo")
+        test4 = 1
+      case (4_"magic")
+        test4 = 2
+      case (4_"freeze":4_"frugal")
+        test4 = 3
+      case default
+        test4 = 4
+    end select
+  end function test4
+
+  subroutine testme(x,y,z)
+    integer :: x, y, z
+    if (x /= y) call abort
+    if (x /= z) call abort
+  end subroutine testme
+end
diff --git a/gcc/testsuite/gfortran.dg/widechar_select_2.f90 b/gcc/testsuite/gfortran.dg/widechar_select_2.f90
new file mode 100644
index 000000000..2eea9aed7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/widechar_select_2.f90
@@ -0,0 +1,37 @@
+! { dg-do compile }
+
+  character(kind=1,len=20) :: s1
+  character(kind=4,len=20) :: s4
+
+  select case (s1)
+    case ("":4_"foo") ! { dg-error "must be of kind" }
+      test = 1
+    case (4_"gee") ! { dg-error "must be of kind" }
+      test = 1
+    case ("bar")
+      test = 1
+    case default
+      test = 4
+  end select
+
+  select case (s4)
+    case ("":4_"foo") ! { dg-error "must be of kind" }
+      test = 1
+    case (4_"gee")
+      test = 1
+    case ("bar") ! { dg-error "must be of kind" }
+      test = 1
+    case default
+      test = 4
+  end select
+
+  select case (s4)
+    case (4_"foo":4_"bar")
+      test = 1
+    case (4_"foo":4_"gee") ! { dg-error "overlaps with CASE label" }
+      test = 1
+    case (4_"foo") ! { dg-error "overlaps with CASE label" }
+      test = 1
+  end select
+
+end
diff --git a/gcc/testsuite/gfortran.dg/winapi.f90 b/gcc/testsuite/gfortran.dg/winapi.f90
new file mode 100644
index 000000000..0ee3920ff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/winapi.f90
@@ -0,0 +1,23 @@
+! { dg-do run { target *-*-cygwin* *-*-mingw* } }
+! { dg-options "-lkernel32" }
+! Test case provided by Dennis Wassel.
+
+PROGRAM winapi
+
+  USE, INTRINSIC :: iso_c_binding
+  IMPLICIT NONE
+
+  INTERFACE
+     ! Specifically select the lstrlenA version for ASCII.
+     FUNCTION lstrlen(string) BIND(C, name = "lstrlenA")
+       USE, INTRINSIC :: iso_c_binding
+       IMPLICIT NONE
+       !GCC$ ATTRIBUTES STDCALL :: lstrlen
+       INTEGER (C_INT)          :: lstrlen
+       CHARACTER(KIND=C_CHAR), INTENT(in) :: string(*)
+     END FUNCTION lstrlen
+  END INTERFACE
+  
+  IF (lstrlen(C_CHAR_"winapi"//C_NULL_CHAR) /= 6) CALL abort()
+
+END PROGRAM winapi
diff --git a/gcc/testsuite/gfortran.dg/write_0_pe_format.f90 b/gcc/testsuite/gfortran.dg/write_0_pe_format.f90
new file mode 100644
index 000000000..3890c32ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/write_0_pe_format.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! PR libfortran/20101
+! With format "PE", 0.0 must still have "+00" as exponent
+character(len=10) :: c1, c2
+write(c1,"(1pe9.2)") 0.0
+write(c2,"(1pe9.2)") 1.0
+if (trim(adjustl(c1)) .ne. "0.00E+00") call abort()
+if (trim(adjustl(c2)) .ne. "1.00E+00") call abort()
+end
diff --git a/gcc/testsuite/gfortran.dg/write_back.f b/gcc/testsuite/gfortran.dg/write_back.f
new file mode 100644
index 000000000..a8472f7ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/write_back.f
@@ -0,0 +1,26 @@
+! { dg-do run { target fd_truncate } }
+! PR 26499 : Positioning of EOF after backspaces and write.
+! This test verifies that the last write truncates the file.
+! Submitted by Jerry DeLisle <jvdelisle@verizon.net>.
+      program test
+      integer at,eof
+      dimension idata(5)
+      idata = -42
+      open(unit=11,form='unformatted')
+      write(11)idata
+      write(11)idata
+      write(11)idata
+      backspace(11)
+      backspace(11)
+      write(11)idata
+      close(11, status="keep")  
+      open(unit=11,form='unformatted')
+      rewind(11)
+      read(11)idata
+      read(11)idata
+      read(11, end=250)idata
+      call abort()
+ 250  continue
+      close(11, status="delete")
+      end
+
diff --git a/gcc/testsuite/gfortran.dg/write_check.f90 b/gcc/testsuite/gfortran.dg/write_check.f90
new file mode 100644
index 000000000..417230392
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/write_check.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-shouldfail "Compile-time specifier checking" }
+! Check keyword checking for specifiers
+! PR fortran/29452
+program test
+  implicit none
+  character(len=5) :: str
+  str = 'yes'
+  write(*,'(a)',advance=str) ''
+  str = 'no'
+  write(*,'(a)',advance=str) ''
+  str = 'NOT'
+  write(*,'(a)',advance=str) ''
+end program test
+! { dg-output "At line 13 of file.*" }
+! { dg-output "Bad ADVANCE parameter in data transfer statement" }
diff --git a/gcc/testsuite/gfortran.dg/write_check2.f90 b/gcc/testsuite/gfortran.dg/write_check2.f90
new file mode 100644
index 000000000..1447f8d14
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/write_check2.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! Check keyword checking for specifiers
+! PR fortran/29452
+  character(len=20) :: str
+  write(13,'(a)',advance='yes')  'Hello:'
+  write(13,'(a)',advance='no')   'Hello:'
+  write(13,'(a)',advance='y')    'Hello:' ! { dg-error "ADVANCE= specifier at \\(1\\) must have value = YES or NO." }
+  write(13,'(a)',advance='yet')  'Hello:' ! { dg-error "ADVANCE= specifier at \\(1\\) must have value = YES or NO." }
+  write(13,'(a)',advance='yess') 'Hello:' ! { dg-error "ADVANCE= specifier at \\(1\\) must have value = YES or NO." }
+  end
diff --git a/gcc/testsuite/gfortran.dg/write_check3.f90 b/gcc/testsuite/gfortran.dg/write_check3.f90
new file mode 100644
index 000000000..802a06d27
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/write_check3.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! PR29936 Missed constraint on RECL=specifier in unformatted sequential WRITE
+! Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program us_recl
+  real, dimension(5) :: array = 5.4321
+  integer :: istatus
+  open(unit=10, form="unformatted", access="sequential", RECL=16)
+  write(10, iostat=istatus) array
+  if (istatus == 0) call abort()
+  close(10, status="delete")
+end program us_recl
diff --git a/gcc/testsuite/gfortran.dg/write_check4.f90 b/gcc/testsuite/gfortran.dg/write_check4.f90
new file mode 100644
index 000000000..f418ba8fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/write_check4.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+!
+! PR fortran/35840 
+!
+! The asynchronous specifier for a data transfer statement shall be 
+! an initialization expression
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+  character(2) :: no
+  no = "no"
+  open (unit=10, asynchronous = no)              ! Ok, it isn't a transfer stmt
+  write(*,*, asynchronous="Y"//"E"//trim("S  ")) ! Ok, it is an init expr
+  write(*,*, asynchronous=no)  ! { dg-error "must be an initialization expression" } 
+  read (*,*, asynchronous="Y"//"e"//trim("S  "))
+  read (*,*, asynchronous=no)  ! { dg-error "must be an initialization expression" }
+end
diff --git a/gcc/testsuite/gfortran.dg/write_direct_eor.f90 b/gcc/testsuite/gfortran.dg/write_direct_eor.f90
new file mode 100644
index 000000000..9044642df
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/write_direct_eor.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! PR26509 : Writing beyond fixed length direct access records.
+! Test case derived from PR.
+! Submitted  by Jerry Delisle <jvdelisle@gcc.gnu.org>.
+program testrecl
+      implicit none
+      open(unit = 10, form = 'unformatted', access = 'direct', recl = 4)
+      write(unit=10,rec=1, err=100) 1d0
+      call abort()
+ 100  continue
+      close(unit=10, status='delete')
+      end
diff --git a/gcc/testsuite/gfortran.dg/write_fmt_trim.f90 b/gcc/testsuite/gfortran.dg/write_fmt_trim.f90
new file mode 100644
index 000000000..62f1af174
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/write_fmt_trim.f90
@@ -0,0 +1,10 @@
+! { dg-do run }
+! PR30200 write(*,myfmt="(1X,a,'xyz')") "A"  prints  Az' instead of Axyz
+! Test case from PR, submitted by <jvdelisle@gcc.gnu.org>
+program main
+  character (len=20) format
+  format = "(1X,a,'xyz')"
+  write(*,fmt=trim(format)) "A"  ! Problem arose when trim was included here
+end
+! { dg-output " Axyz" }
+
diff --git a/gcc/testsuite/gfortran.dg/write_invalid_format.f90 b/gcc/testsuite/gfortran.dg/write_invalid_format.f90
new file mode 100644
index 000000000..8de7bc25c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/write_invalid_format.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR fortran/35582 - ICE on invalid format
+! Testcase contributed by
+! Leandro Martinez <leandromartinez DOT spam AT gmail DOT com> 
+
+  real, parameter  :: a = 1.
+  write(*,a) 'test'           ! { dg-error "expression in FORMAT tag" }
+end
+
diff --git a/gcc/testsuite/gfortran.dg/write_padding.f90 b/gcc/testsuite/gfortran.dg/write_padding.f90
new file mode 100644
index 000000000..e1c37917d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/write_padding.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! PR25264 Verify that the internal unit, str, is not cleared
+! before it is needed elsewhere.  This is an extension.
+! Test derived from test case by JPR. Contributed by
+! Jerry DeLisle <jvdelisle@verizon.net>.
+program write_padding
+   character(len=10) :: str
+   real :: atime
+   str = '123'
+   write( str, '(a3,i1)' ) trim(str),4
+   if (str.ne."1234") call abort()
+end program write_padding
+
diff --git a/gcc/testsuite/gfortran.dg/write_recursive.f90 b/gcc/testsuite/gfortran.dg/write_recursive.f90
new file mode 100644
index 000000000..20014abd2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/write_recursive.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! PR26766 Recursive I/O with internal units
+! Test case derived from example in PR
+! Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program pr26766
+  implicit none
+  character (len=8) :: str, tmp
+  write (str, '(a)')  bar (1234)
+  if (str.ne."abcd") call abort()
+  str = "wxyz"
+  write (str, '(2a4)') foo (1), bar (1)
+  if (str.ne."abcdabcd") call abort()
+
+contains
+
+  function foo (i) result (s)
+    integer, intent(in) :: i
+    character (len=4)   :: s, t
+    if (i < 0) then
+       s = "1234"
+    else
+       ! Internal I/O, allowed recursive in f2003, see section 9.11
+       write (s, '(a)') "abcd"
+    end if
+  end function foo
+  
+  function bar (i) result (s)
+    integer, intent(in) :: i
+    character (len=4)   :: s, t
+    if (i < 0) then
+      s = "4567"
+    else
+      write (s, '(a)') foo(i)
+    end if
+  end function bar
+
+end program pr26766
+
+
diff --git a/gcc/testsuite/gfortran.dg/write_rewind_1.f b/gcc/testsuite/gfortran.dg/write_rewind_1.f
new file mode 100644
index 000000000..94fec99df
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/write_rewind_1.f
@@ -0,0 +1,24 @@
+! { dg-do run { target fd_truncate } }
+! PR 26499 : Positioning of EOF after  write and rewind.
+! Test case from Dale Ranta in PR.
+! Submitted by Jerry DeLisle <jvdelisle@verizon.net>.
+      program test
+      dimension idata(100)
+      idata = -42
+      open(unit=11,form='unformatted')
+      write(11)idata
+      write(11)idata
+      read(11,end=        1000 )idata
+      call abort()
+ 1000 continue
+      rewind 11
+      write(11)idata
+      close(11,status='keep')        
+      open(unit=11,form='unformatted')
+      rewind 11
+      read(11)idata
+      read(11, end=250)idata
+      call abort()
+ 250  continue
+      close(11,status='delete')  
+      end
diff --git a/gcc/testsuite/gfortran.dg/write_rewind_2.f b/gcc/testsuite/gfortran.dg/write_rewind_2.f
new file mode 100644
index 000000000..501995c6e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/write_rewind_2.f
@@ -0,0 +1,44 @@
+! { dg-do run }
+! PR 26499  Test write with rewind sequences to make sure buffering and
+! end-of-file conditions are handled correctly.  Derived from test case by Dale
+! Ranta.  Submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>.
+      program test
+      dimension idata(1011)
+      idata = -42
+      open(unit=11,form='unformatted')
+        idata(1)   = -705
+        idata(  1011)   = -706
+       write(11)idata
+        idata(1)   = -706
+        idata(  1011)   = -707
+       write(11)idata
+        idata(1)   = -707
+        idata(  1011)   = -708
+       write(11)idata
+       read(11,end=        1000 )idata
+       call abort()
+ 1000  continue
+       rewind 11
+       read(11,end=        1001 )idata
+        if(idata(1).ne. -705.or.idata(  1011).ne. -706)call abort()
+ 1001  continue
+       close(11,status='keep')        
+      open(unit=11,form='unformatted')
+      rewind 11
+      read(11)idata
+      if(idata(1).ne.-705)then
+      call abort()
+      endif
+      read(11)idata
+      if(idata(1).ne.-706)then
+      call abort()
+      endif
+      read(11)idata
+      if(idata(1).ne.-707)then
+      call abort()
+      endif
+      close(11,status='delete')  
+      stop
+      end
+
+
diff --git a/gcc/testsuite/gfortran.dg/write_to_null.F90 b/gcc/testsuite/gfortran.dg/write_to_null.F90
new file mode 100644
index 000000000..bce1db03a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/write_to_null.F90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! pr18983
+! could not write to /dev/null
+
+#if defined  _WIN32
+#define DEV_NULL "nul"
+#else
+#define DEV_NULL "/dev/null"
+#endif
+
+       integer i
+       open(10,file=DEV_NULL)
+       do i = 1,100
+         write(10,*) "Hello, world"
+       end do
+       end
diff --git a/gcc/testsuite/gfortran.dg/write_zero_array.f90 b/gcc/testsuite/gfortran.dg/write_zero_array.f90
new file mode 100644
index 000000000..da7afc142
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/write_zero_array.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! PR30145 write statement fails to ignore zero-sized array
+! Test case from PR, submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program zeros
+ implicit none
+ character(20) :: msg = ""
+ integer :: itemp(10) = 0
+ integer :: ics
+ !This was OK
+ write(msg,*) 'itemp(6:0) = ',itemp(6:0),'a'
+ if (msg /= " itemp(6:0) = a") call abort()
+ !This did not work before patch, segfaulted
+ ics=6
+ write(msg,*) 'itemp(ics:0) = ',itemp(ics:0),'a'
+ if (msg /= " itemp(ics:0) = a") call abort()
+end program zeros
+
diff --git a/gcc/testsuite/gfortran.dg/wtruncate.f b/gcc/testsuite/gfortran.dg/wtruncate.f
new file mode 100644
index 000000000..b7cac5d3c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/wtruncate.f
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-Wall" }
+
+! This long comment line should not trigger a line-truncation warning with -Wall
+
+      PROGRAM foo
+      WRITE (*,*) "Test"           ! Neither this comment which exceeds the 72 character limit, too
+      WRITE (*,*) "This exactly 72 character long soruce line not, too."
+      END
+
diff --git a/gcc/testsuite/gfortran.dg/wtruncate.f90 b/gcc/testsuite/gfortran.dg/wtruncate.f90
new file mode 100644
index 000000000..49b07d2b6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/wtruncate.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-Wall" }
+
+! This long comment line should not trigger a line-truncation warning with -Wall even for free-form 132 character line limit (blah blah)
+
+      PROGRAM foo
+      WRITE (*,*) "Test"           ! Neither this comment which exceeds the 132 character limit with some random words, too (blah blah)
+      WRITE (*,*) "This exactly 132 character long soruce line not, too.  How can people fill 132 characters without sensless stuff"
+      END
+
diff --git a/gcc/testsuite/gfortran.dg/wtruncate_fix.f b/gcc/testsuite/gfortran.dg/wtruncate_fix.f
new file mode 100644
index 000000000..082c70ff7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/wtruncate_fix.f
@@ -0,0 +1,12 @@
+c { dg-do compile }
+c { dg-options "-Wall" }
+c PR42852 -Wall warns about truncated lines when only a continuation character is truncated
+      print *, "Hello!"                                                  &   !xxxxx
+     & //   " World!"
+      print *, "Hello!"                                                  &   xxxxx
+     & //   " World!"
+      print *, "Hello!"                                                  //
+     & //   " World!"
+      end
+c { dg-warning "Line truncated" " " { target *-*-* } 6 }
+c { dg-warning "Line truncated" " " { target *-*-* } 8 }
diff --git a/gcc/testsuite/gfortran.dg/x_slash_1.f b/gcc/testsuite/gfortran.dg/x_slash_1.f
new file mode 100644
index 000000000..435e46122
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/x_slash_1.f
@@ -0,0 +1,118 @@
+c { dg-do run { target fd_truncate } }
+c { dg-options "-std=legacy" }
+c
+c This program tests the fixes to PR22570.
+c
+c Provided by Paul Thomas - pault@gcc.gnu.org
+c
+       program x_slash
+       character*60 a
+       character*1  b, c
+
+       open (10, status = "scratch")
+
+c Check that lines with only x-editing followed by a slash generate
+c spaces and that subsequent lines have spaces where they should.
+c Line 1 we ignore.
+c Line 2 has nothing but x editing, followed by a slash.
+c Line 3 has x editing finished off by a 1h*
+
+       write (10, 100)
+ 100   format (1h1,58x,1h!,/,60x,/,59x,1h*,/)
+       rewind (10)
+
+       read (10, 200) a
+       read (10, 200) a
+       do i = 1,60
+         if (ichar(a(i:i)).ne.32) call abort ()
+       end do
+       read (10, 200) a
+ 200   format (a60)
+       do i = 1,59
+         if (ichar(a(i:i)).ne.32) call abort ()
+       end do
+       if (a(60:60).ne."*") call abort ()
+       rewind (10)
+
+c Check that sequences of t- and x-editing generate the correct 
+c number of spaces.
+c Line 1 we ignore.
+c Line 2 has tabs to the right of present position.
+c Line 3 has tabs to the left of present position.
+
+       write (10, 101)
+ 101   format (1h1,58x,1h#,/,t38,2x,1h ,tr10,9x,1h$,/,
+     >         6habcdef,tl4,2x,6hghijkl,t1,59x,1h*)
+       rewind (10)
+
+       read (10, 200) a
+       read (10, 200) a
+       do i = 1,59
+         if (ichar(a(i:i)).ne.32) call abort ()
+       end do
+       if (a(60:60).ne."$") call abort ()
+       read (10, 200) a
+       if (a(1:10).ne."abcdghijkl") call abort ()
+       do i = 11,59
+         if (ichar(a(i:i)).ne.32) call abort ()
+       end do
+       if (a(60:60).ne."*") call abort ()
+       rewind (10)
+
+c Now repeat the first test, with the write broken up into three
+c separate statements. This checks that the position counters are
+c correctly reset for each statement.
+
+       write (10,102) "#"
+       write (10,103)
+       write (10,102) "$"
+ 102   format(59x,a1)
+ 103   format(60x)
+       rewind (10)
+       read (10, 200) a
+       read (10, 200) a
+       read (10, 200) a
+       do i = 11,59
+         if (ichar(a(i:i)).ne.32) call abort ()
+       end do
+       if (a(60:60).ne."$") call abort ()
+       rewind (10)
+
+c Next we check multiple read x- and t-editing.
+c First, tab to the right.
+
+       read (10, 201) b, c
+201    format (tr10,49x,a1,/,/,2x,t60,a1)
+       if ((b.ne."#").or.(c.ne."$")) call abort ()
+       rewind (10)
+
+c Now break it up into three reads and use left tabs.
+
+       read (10, 202) b
+202    format (10x,tl10,59x,a1)
+       read (10, 203)
+203    format ()
+       read (10, 204) c
+204    format (10x,t5,55x,a1)
+       if ((b.ne."#").or.(c.ne."$")) call abort ()
+       close (10)
+
+c Now, check that trailing spaces are not transmitted when we have
+c run out of data (Thanks to Jack Howarth for finding this one:
+c http://gcc.gnu.org/ml/fortran/2005-07/msg00395.html).
+
+       open (10, pad = "no", status = "scratch")
+       b = achar (0)
+       write (10, 105) 42
+  105  format (i10,1x,i10)
+       write (10, 106)
+  106  format ("============================")
+       rewind (10)
+       read (10, 205, iostat = ier) i, b
+  205  format (i10,a1)
+       if ((ier.eq.0).or.(ichar(b).ne.0)) call abort ()
+
+c That's all for now, folks! 
+
+       end
+
diff --git a/gcc/testsuite/gfortran.dg/x_slash_2.f b/gcc/testsuite/gfortran.dg/x_slash_2.f
new file mode 100644
index 000000000..6023b647d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/x_slash_2.f
@@ -0,0 +1,11 @@
+! { dg-do run }
+! PR 34887 - reverse tabs followed by a slash used to confuse I/O.
+      program main
+      character(len=2) :: b, a
+      open(10,form="formatted")
+      write (10,'(3X, A, T1, A,/)') 'aa', 'bb'
+      rewind(10)
+      read (10,'(A2,1X,A2)') b,a
+      if (a /= 'aa' .or. b /= 'bb') call abort
+      close(10,status="delete")
+      end
diff --git a/gcc/testsuite/gfortran.dg/zero_array_components_1.f90 b/gcc/testsuite/gfortran.dg/zero_array_components_1.f90
new file mode 100644
index 000000000..b1b8b5c69
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/zero_array_components_1.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+! Tests the fix for PR31620, in which zeroing the component a for the array,
+! would zero all the components of the array.
+!
+! David Ham <David@ham.dropbear.id.au>
+!
+program test_assign
+  type my_type
+     integer :: a
+     integer :: b
+  end type my_type
+  type(my_type), dimension(1) :: mine        ! note that MINE is an array
+  mine%b=4
+  mine%a=1
+  mine%a=0
+  if (any (mine%b .ne. 4)) call abort ()
+end program test_assign
diff --git a/gcc/testsuite/gfortran.dg/zero_length_1.f90 b/gcc/testsuite/gfortran.dg/zero_length_1.f90
new file mode 100644
index 000000000..c76d079e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/zero_length_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! PR libfortran/31210
+program test
+  implicit none
+  integer :: l = 0
+  character(len=20) :: s
+  
+  write(s,'(A,I1)') foo(), 0
+  if (trim(s) /= "0") call abort
+
+contains
+
+  function foo()
+    character(len=l) :: foo
+    foo = "XXXX"
+  end function
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/zero_length_2.f90 b/gcc/testsuite/gfortran.dg/zero_length_2.f90
new file mode 100644
index 000000000..2cc3f2938
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/zero_length_2.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+  character(len=1) :: s
+  character(len=0) :: s0
+  s = " "
+  s0 = ""
+  call bar ("")
+  call bar (s)
+  call bar (s0)
+  call bar (trim(s))
+  call bar (min(s0,s0))
+contains
+  subroutine bar (s)
+    character(len=*), optional :: s
+    if (.not. present (S)) call abort
+  end subroutine bar
+end
diff --git a/gcc/testsuite/gfortran.dg/zero_sized_1.f90 b/gcc/testsuite/gfortran.dg/zero_sized_1.f90
new file mode 100644
index 000000000..85167fcca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/zero_sized_1.f90
@@ -0,0 +1,187 @@
+! { dg-do run }
+! Transformational functions for zero-sized array and array sections
+! Contributed by Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+subroutine test_cshift
+  real :: tempn(1), tempm(1,2)
+  real,allocatable :: foo(:),bar(:,:),gee(:,:)
+  tempn = 2.0
+  tempm = 1.0
+  allocate(foo(0),bar(2,0),gee(0,7))
+  if (any(cshift(foo,dim=1,shift=1)/= 0)) call abort
+  if (any(cshift(tempn(2:1),dim=1,shift=1)/= 0)) call abort
+  if (any(cshift(bar,shift=(/1,-1/),dim=1)/= 0)) call abort
+  if (any(cshift(bar,shift=(/1,-1/),dim=2)/= 0)) call abort
+  if (any(cshift(gee,shift=(/1,-1/),dim=1)/= 0)) call abort
+  if (any(cshift(gee,shift=(/1,-1/),dim=2)/= 0)) call abort
+  if (any(cshift(tempm(5:4,:),shift=(/1,-1/),dim=1)/= 0)) call abort
+  deallocate(foo,bar,gee)
+end
+
+subroutine test_eoshift
+  real :: tempn(1), tempm(1,2)
+  real,allocatable :: foo(:),bar(:,:),gee(:,:)
+  tempn = 2.0
+  tempm = 1.0
+  allocate(foo(0),bar(2,0),gee(0,7))
+  if (any(eoshift(foo,dim=1,shift=1)/= 0)) call abort
+  if (any(eoshift(tempn(2:1),dim=1,shift=1)/= 0)) call abort
+  if (any(eoshift(bar,shift=(/1,-1/),dim=1)/= 0)) call abort
+  if (any(eoshift(bar,shift=(/1,-1/),dim=2)/= 0)) call abort
+  if (any(eoshift(gee,shift=(/1,-1/),dim=1)/= 0)) call abort
+  if (any(eoshift(gee,shift=(/1,-1/),dim=2)/= 0)) call abort
+  if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=1)/= 0)) call abort
+
+  if (any(eoshift(foo,dim=1,shift=1,boundary=42.0)/= 0)) call abort
+  if (any(eoshift(tempn(2:1),dim=1,shift=1,boundary=42.0)/= 0)) call abort
+  if (any(eoshift(bar,shift=(/1,-1/),dim=1,boundary=42.0)/= 0)) call abort
+  if (any(eoshift(bar,shift=(/1,-1/),dim=2,boundary=42.0)/= 0)) call abort
+  if (any(eoshift(gee,shift=(/1,-1/),dim=1,boundary=42.0)/= 0)) call abort
+  if (any(eoshift(gee,shift=(/1,-1/),dim=2,boundary=42.0)/= 0)) call abort
+  if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=1,boundary=42.0)/= 0)) call abort
+
+  if (any(eoshift(foo,dim=1,shift=1,boundary=42.0)/= 0)) call abort
+  if (any(eoshift(tempn(2:1),dim=1,shift=1,boundary=-7.0)/= 0)) call abort
+  if (any(eoshift(bar,shift=(/1,-1/),dim=1,boundary=(/42.0,-7.0/))/= 0)) call abort
+  if (any(eoshift(bar,shift=(/1,-1/),dim=2,boundary=(/42.0,-7.0/))/= 0)) call abort
+  if (any(eoshift(gee,shift=(/1,-1/),dim=1,boundary=(/42.0,-7.0/))/= 0)) call abort
+  if (any(eoshift(gee,shift=(/1,-1/),dim=2,boundary=(/42.0,-7.0/))/= 0)) call abort
+  if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=1,boundary=(/42.0,-7.0/))/= 0)) call abort
+  deallocate(foo,bar,gee)
+end
+
+subroutine test_transpose
+  character(len=1) :: tempn(1,2)
+  character(len=1),allocatable :: foo(:,:), bar(:,:)
+  integer :: tempm(1,2)
+  integer,allocatable :: x(:,:), y(:,:)
+  tempn = 'a'
+  allocate(foo(3,0),bar(-2:-4,7:9))
+  tempm = -42
+  allocate(x(3,0),y(-2:-4,7:9))
+  if (any(transpose(tempn(-7:-8,:)) /= 'b')) call abort
+  if (any(transpose(tempn(:,9:8)) /= 'b')) call abort
+  if (any(transpose(foo) /= 'b')) call abort
+  if (any(transpose(bar) /= 'b')) call abort
+  if (any(transpose(tempm(-7:-8,:)) /= 0)) call abort
+  if (any(transpose(tempm(:,9:8)) /= 0)) call abort
+  if (any(transpose(x) /= 0)) call abort
+  if (any(transpose(y) /= 0)) call abort
+  deallocate(foo,bar,x,y)
+end
+
+subroutine test_reshape
+  character(len=1) :: tempn(1,2)
+  character(len=1),allocatable :: foo(:,:), bar(:,:)
+  integer :: tempm(1,2)
+  integer,allocatable :: x(:,:), y(:,:)
+  tempn = 'b'
+  tempm = -42
+  allocate(foo(3,0),bar(-2:-4,7:9),x(3,0),y(-2:-4,7:9))
+  
+  if (size(reshape(tempn(-7:-8,:),(/3,3/),pad=(/'a'/))) /= 9 .or. &
+      any(reshape(tempn(-7:-8,:),(/3,3/),pad=(/'a'/)) /= 'a')) call abort
+  if (size(reshape(tempn(-7:-8,:),(/3,3,3/),pad=(/'a'/))) /= 27 .or. &
+      any(reshape(tempn(-7:-8,:),(/3,3,3/),pad=(/'a'/)) /= 'a')) call abort
+  if (size(reshape(tempn(-7:-8,:),(/3,3,3,3,3,3,3/),pad=(/'a'/))) /= 2187 .or. &
+      any(reshape(tempn(-7:-8,:),(/3,3,3,3,3,3,3/),pad=(/'a'/)) /= 'a')) call abort
+  if (size(reshape(foo,(/3,3/),pad=(/'a'/))) /= 9 .or. &
+      any(reshape(foo,(/3,3/),pad=(/'a'/)) /= 'a')) call abort
+  if (size(reshape(foo,(/3,3,3/),pad=(/'a'/))) /= 27 .or. &
+      any(reshape(foo,(/3,3,3/),pad=(/'a'/)) /= 'a')) call abort
+  if (size(reshape(foo,(/3,3,3,3,3,3,3/),pad=(/'a'/))) /= 2187 .or. &
+      any(reshape(foo,(/3,3,3,3,3,3,3/),pad=(/'a'/)) /= 'a')) call abort
+  if (size(reshape(bar,(/3,3/),pad=(/'a'/))) /= 9 .or. &
+      any(reshape(bar,(/3,3/),pad=(/'a'/)) /= 'a')) call abort
+  if (size(reshape(bar,(/3,3,3/),pad=(/'a'/))) /= 27 .or. &
+      any(reshape(bar,(/3,3,3/),pad=(/'a'/)) /= 'a')) call abort
+  if (size(reshape(bar,(/3,3,3,3,3,3,3/),pad=(/'a'/))) /= 2187 .or. &
+      any(reshape(bar,(/3,3,3,3,3,3,3/),pad=(/'a'/)) /= 'a')) call abort
+
+  if (size(reshape(tempm(-7:-8,:),(/3,3/),pad=(/7/))) /= 9 .or. &
+      any(reshape(tempm(-7:-8,:),(/3,3/),pad=(/7/)) /= 7)) call abort
+  if (size(reshape(tempm(-7:-8,:),(/3,3,3/),pad=(/7/))) /= 27 .or. &
+      any(reshape(tempm(-7:-8,:),(/3,3,3/),pad=(/7/)) /= 7)) call abort
+  if (size(reshape(tempm(-7:-8,:),(/3,3,3,3,3,3,3/),pad=(/7/))) /= 2187 .or. &
+      any(reshape(tempm(-7:-8,:),(/3,3,3,3,3,3,3/),pad=(/7/)) /= 7)) call abort
+  if (size(reshape(x,(/3,3/),pad=(/7/))) /= 9 .or. &
+      any(reshape(x,(/3,3/),pad=(/7/)) /= 7)) call abort
+  if (size(reshape(x,(/3,3,3/),pad=(/7/))) /= 27 .or. &
+      any(reshape(x,(/3,3,3/),pad=(/7/)) /= 7)) call abort
+  if (size(reshape(x,(/3,3,3,3,3,3,3/),pad=(/7/))) /= 2187 .or. &
+      any(reshape(x,(/3,3,3,3,3,3,3/),pad=(/7/)) /= 7)) call abort
+  if (size(reshape(y,(/3,3/),pad=(/7/))) /= 9 .or. &
+      any(reshape(y,(/3,3/),pad=(/7/)) /= 7)) call abort
+  if (size(reshape(y,(/3,3,3/),pad=(/7/))) /= 27 .or. &
+      any(reshape(y,(/3,3,3/),pad=(/7/)) /= 7)) call abort
+  if (size(reshape(y,(/3,3,3,3,3,3,3/),pad=(/7/))) /= 2187 .or. &
+      any(reshape(y,(/3,3,3,3,3,3,3/),pad=(/7/)) /= 7)) call abort
+
+  deallocate(foo,bar,x,y)
+end
+
+subroutine test_pack
+  integer :: tempn(1,5)
+  integer,allocatable :: foo(:,:)
+  tempn = 2 
+  allocate(foo(0,1:7))
+  if (size(pack(foo,foo/=0)) /= 0 .or. any(pack(foo,foo/=0) /= -42)) call abort
+  if (size(pack(foo,foo/=0,(/1,3,4,5,1,0,7,9/))) /= 8 .or. &
+      sum(pack(foo,foo/=0,(/1,3,4,5,1,0,7,9/))) /= 30) call abort
+  if (size(pack(tempn(:,-4:-5),tempn(:,-4:-5)/=0)) /= 0 .or. &
+      any(pack(tempn(:,-4:-5),tempn(:,-4:-5)/=0) /= -42)) call abort
+  if (size(pack(tempn(:,-4:-5),tempn(:,-4:-5)/=0,(/1,3,4,5,1,0,7,9/))) /= 8 .or. &
+      sum(pack(tempn(:,-4:-5),tempn(:,-4:-5)/=0,(/1,3,4,5,1,0,7,9/))) /= 30) &
+    call abort
+  if (size(pack(foo,.true.)) /= 0 .or. any(pack(foo,.true.) /= -42)) &
+    call abort
+  if (size(pack(foo,.true.,(/1,3,4,5,1,0,7,9/))) /= 8 .or. &
+      sum(pack(foo,.true.,(/1,3,4,5,1,0,7,9/))) /= 30) call abort
+  if (size(pack(tempn(:,-4:-5),.true.)) /= 0 .or. &
+      any(pack(foo,.true.) /= -42)) call abort
+  if (size(pack(tempn(:,-4:-5),.true.,(/1,3,4,5,1,0,7,9/))) /= 8 .or. &
+      sum(pack(tempn(:,-4:-5),.true.,(/1,3,4,5,1,0,7,9/))) /= 30) call abort
+  deallocate(foo)
+end
+
+subroutine test_unpack
+  integer :: tempn(1,5), tempv(5)
+  integer,allocatable :: foo(:,:), bar(:)
+  integer :: zero
+  tempn = 2 
+  tempv = 5
+  zero = 0
+  allocate(foo(0,1:7),bar(0:-1))
+  if (any(unpack(tempv,tempv/=0,tempv) /= 5) .or. &
+      size(unpack(tempv,tempv/=0,tempv)) /= 5) call abort
+  if (any(unpack(tempv(1:0),tempv/=0,tempv) /= 5) .or. &
+      size(unpack(tempv(1:0),tempv/=0,tempv)) /= 5) call abort
+  if (any(unpack(tempv,tempv(1:zero)/=0,tempv) /= -47)) call abort
+  if (any(unpack(tempv(5:4),tempv(1:zero)/=0,tempv) /= -47)) call abort
+  if (any(unpack(bar,foo==foo,foo) /= -47)) call abort
+  deallocate(foo,bar)
+end
+
+subroutine test_spread
+  real :: tempn(1)
+  real,allocatable :: foo(:)
+  tempn = 2.0 
+  allocate(foo(0))
+  if (any(spread(1,dim=1,ncopies=0) /= -17.0) .or. &
+      size(spread(1,dim=1,ncopies=0)) /= 0) call abort
+  if (any(spread(foo,dim=1,ncopies=1) /= -17.0) .or. &
+      size(spread(foo,dim=1,ncopies=1)) /= 0) call abort
+  if (any(spread(tempn(2:1),dim=1,ncopies=1) /= -17.0) .or. &
+      size(spread(tempn(2:1),dim=1,ncopies=1)) /= 0) call abort
+  deallocate(foo)
+end
+
+program test
+  call test_cshift
+  call test_eoshift
+  call test_transpose
+  call test_unpack
+  call test_spread
+  call test_pack
+  call test_reshape
+end
diff --git a/gcc/testsuite/gfortran.dg/zero_sized_2.f90 b/gcc/testsuite/gfortran.dg/zero_sized_2.f90
new file mode 100644
index 000000000..eda2de226
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/zero_sized_2.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! Tests the fix for PR30514 in which the bounds on m would cause an
+! error and the rest would cause the compiler to go into an infinite
+! loop.
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+integer :: i(2:0), j(1:0), m(1:-1)
+integer, parameter :: k(2:0) = 0, l(1:0) = 0
+i = k
+j = l
+m = 5
+end
+
diff --git a/gcc/testsuite/gfortran.dg/zero_sized_3.f90 b/gcc/testsuite/gfortran.dg/zero_sized_3.f90
new file mode 100644
index 000000000..e4e1c06d2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/zero_sized_3.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! Testcase for PR libfortran/31001
+  implicit none
+
+  integer :: i, j, k
+  integer, allocatable :: mm(:)
+  logical, allocatable :: mask(:)
+
+  do i = 2, -2, -1
+    do k = 0, 1
+      allocate (mm(i), mask(i))
+      mm(:) = k
+      mask(:) = (mm == 0)
+      j = count (mask)
+      print *, pack (mm, mask)
+      if (size (pack (mm, mask)) /= j) call abort
+      deallocate (mm, mask)
+    end do
+  end do
+end
diff --git a/gcc/testsuite/gfortran.dg/zero_sized_4.f90 b/gcc/testsuite/gfortran.dg/zero_sized_4.f90
new file mode 100644
index 000000000..fe5f5f682
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/zero_sized_4.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! PR35991 run-time abort for CSHIFT of zero sized array
+! Divide by zero exception before the patch.
+      program try_gf0045
+      call       gf0045(  9,  8)
+      end
+
+      subroutine GF0045(nf9,nf8)
+      REAL RDA(10)
+      REAL RDA1(0)
+
+      RDA(NF9:NF8) = CSHIFT ( RDA1 ,1)
+
+      END SUBROUTINE
diff --git a/gcc/testsuite/gfortran.dg/zero_sized_5.f90 b/gcc/testsuite/gfortran.dg/zero_sized_5.f90
new file mode 100644
index 000000000..49a5d548d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/zero_sized_5.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! These used to segfault.
+program main
+  real, dimension(1,0) :: a, b, c
+  integer, dimension(0) :: j
+  a = 0
+  c = 0
+  b = cshift (a,1)
+  b = cshift (a,j)
+  b = eoshift (a,1)
+  b = eoshift (a,1,boundary=c(1,:))
+  b = eoshift (a, j, boundary=c(1,:))
+end program main
diff --git a/gcc/testsuite/gfortran.dg/zero_sized_6.f90 b/gcc/testsuite/gfortran.dg/zero_sized_6.f90
new file mode 100644
index 000000000..f944fd914
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/zero_sized_6.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! PR38709 - ICE-on-invalid on zero-sized array in init-expr.
+
+  INTEGER, PARAMETER :: a(1) = (/ 1 /)
+  INTEGER, PARAMETER :: i = a(shape(1))   ! { dg-error "Incompatible ranks" }
+END
diff --git a/gcc/testsuite/gfortran.dg/zero_stride_1.f90 b/gcc/testsuite/gfortran.dg/zero_stride_1.f90
new file mode 100644
index 000000000..c5f6cc724
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/zero_stride_1.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+!  PR 50130 - this caused an ICE.  Test case supplied by Joost
+!  VandeVondele.
+integer, parameter :: a(10)=0
+integer, parameter :: b(10)=a(1:10:0) ! { dg-error "Illegal stride of zero" }
+END
+