Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(Revision 218978)
+++ gcc/fortran/resolve.c	(Arbeitskopie)
@@ -414,6 +414,15 @@ resolve_formal_arglist (gfc_symbol *proc)
 			       &sym->declared_at);
 		}
 	    }
+
+	  /* F08:C1278a.  */
+	  if (sym->ts.type == BT_CLASS && sym->attr.intent == INTENT_OUT)
+	    {
+	      gfc_error ("INTENT(OUT) argument '%s' of pure procedure %qs at %L"
+			 " may not be polymorphic", sym->name, proc->name,
+			 &sym->declared_at);
+	      continue;
+	    }
 	}
 
       if (proc->attr.implicit_pure)
Index: gcc/testsuite/gfortran.dg/class_array_3.f03
===================================================================
--- gcc/testsuite/gfortran.dg/class_array_3.f03	(Revision 218978)
+++ gcc/testsuite/gfortran.dg/class_array_3.f03	(Arbeitskopie)
@@ -29,7 +29,7 @@ module m_qsort
    end function lt_cmp
  end interface
  interface
-   elemental subroutine assign(a,b)
+   impure elemental subroutine assign(a,b)
      import
      class(sort_t), intent(out) :: a
      class(sort_t), intent(in) :: b
@@ -100,7 +100,7 @@ contains
      class(sort_int_t), intent(in) :: a
      disp_int = a%i
  end function disp_int
- elemental subroutine assign_int (a, b)
+ impure elemental subroutine assign_int (a, b)
    class(sort_int_t), intent(out) :: a
    class(sort_t), intent(in) :: b         ! TODO: gfortran does not throw 'class(sort_int_t)'
    select type (b)
Index: gcc/testsuite/gfortran.dg/class_array_7.f03
===================================================================
--- gcc/testsuite/gfortran.dg/class_array_7.f03	(Revision 218978)
+++ gcc/testsuite/gfortran.dg/class_array_7.f03	(Arbeitskopie)
@@ -19,7 +19,7 @@ module realloc
 
 contains
 
-  elemental subroutine assign (a, b)
+  impure elemental subroutine assign (a, b)
     class(base_type), intent(out) :: a
     type(base_type), intent(in) :: b
     a%i = b%i
Index: gcc/testsuite/gfortran.dg/class_dummy_4.f03
===================================================================
--- gcc/testsuite/gfortran.dg/class_dummy_4.f03	(Revision 218978)
+++ gcc/testsuite/gfortran.dg/class_dummy_4.f03	(Arbeitskopie)
@@ -11,7 +11,7 @@ module m1
   procedure, pass(x) :: source
  end type c_stv
 contains
- pure subroutine source(y,x)
+ subroutine source(y,x)
   class(c_stv), intent(in)               :: x
   class(c_stv), allocatable, intent(out) :: y
  end subroutine source
Index: gcc/testsuite/gfortran.dg/defined_assignment_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/defined_assignment_3.f90	(Revision 218978)
+++ gcc/testsuite/gfortran.dg/defined_assignment_3.f90	(Arbeitskopie)
@@ -17,7 +17,7 @@ module m0
     integer :: j
   end type
 contains
-  elemental subroutine assign0(lhs,rhs)
+  impure elemental subroutine assign0(lhs,rhs)
     class(component), intent(out) :: lhs
     class(component), intent(in) :: rhs
     lhs%i = 20
Index: gcc/testsuite/gfortran.dg/defined_assignment_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/defined_assignment_5.f90	(Revision 218978)
+++ gcc/testsuite/gfortran.dg/defined_assignment_5.f90	(Arbeitskopie)
@@ -38,7 +38,7 @@ module m1
     integer :: j = 7
   end type
 contains
-  elemental subroutine assign1(lhs,rhs)
+  impure elemental subroutine assign1(lhs,rhs)
     class(component1), intent(out) :: lhs
     class(component1), intent(in) :: rhs
     lhs%i = 30
Index: gcc/testsuite/gfortran.dg/elemental_subroutine_10.f90
===================================================================
--- gcc/testsuite/gfortran.dg/elemental_subroutine_10.f90	(Revision 218978)
+++ gcc/testsuite/gfortran.dg/elemental_subroutine_10.f90	(Arbeitskopie)
@@ -15,7 +15,7 @@ module m_assertion_character
     procedure :: write => assertion_array_write
   end type t_assertion_character
 contains
-  elemental subroutine assertion_character( ast, name )
+  impure elemental subroutine assertion_character( ast, name )
     class(t_assertion_character), intent(out) :: ast
     character(len=*), intent(in) :: name
     ast%name = name
@@ -37,7 +37,7 @@ module m_assertion_array_character
     procedure :: write => assertion_array_character_write
   end type t_assertion_array_character
 contains
-  pure subroutine assertion_array_character( ast, name, nast )
+  subroutine assertion_array_character( ast, name, nast )
     class(t_assertion_array_character), intent(out) :: ast
     character(len=*), intent(in) :: name
     integer, intent(in) :: nast
Index: gcc/testsuite/gfortran.dg/typebound_operator_4.f03
===================================================================
--- gcc/testsuite/gfortran.dg/typebound_operator_4.f03	(Revision 218978)
+++ gcc/testsuite/gfortran.dg/typebound_operator_4.f03	(Arbeitskopie)
@@ -34,7 +34,7 @@ CONTAINS
     add_int = myint (a%value + b)
   END FUNCTION add_int
 
-  PURE SUBROUTINE assign_int (dest, from)
+  SUBROUTINE assign_int (dest, from)
     CLASS(myint), INTENT(OUT) :: dest
     INTEGER, INTENT(IN) :: from
     dest%value = from
@@ -62,7 +62,6 @@ CONTAINS
   PURE SUBROUTINE iampure ()
     TYPE(myint) :: x
 
-    x = 0 ! { dg-bogus "is not PURE" }
     x = x + 42 ! { dg-bogus "to a impure procedure" }
     x = x .PLUS. 5 ! { dg-bogus "to a impure procedure" }
   END SUBROUTINE iampure
Index: gcc/testsuite/gfortran.dg/typebound_proc_16.f03
===================================================================
--- gcc/testsuite/gfortran.dg/typebound_proc_16.f03	(Revision 218978)
+++ gcc/testsuite/gfortran.dg/typebound_proc_16.f03	(Arbeitskopie)
@@ -27,7 +27,7 @@ MODULE rational_numbers
       r = REAL(this%n)/this%d
     END FUNCTION
 
-    ELEMENTAL SUBROUTINE rat_asgn_i(a,b)
+    impure ELEMENTAL SUBROUTINE rat_asgn_i(a,b)
       CLASS(rational),INTENT(OUT) :: a
       INTEGER,INTENT(IN) :: b
       a%n = b
Index: gcc/testsuite/gfortran.dg/unlimited_polymorphic_19.f90
===================================================================
--- gcc/testsuite/gfortran.dg/unlimited_polymorphic_19.f90	(Revision 218978)
+++ gcc/testsuite/gfortran.dg/unlimited_polymorphic_19.f90	(Arbeitskopie)
@@ -12,7 +12,7 @@ MODULE m
     PROCEDURE :: copy
   END TYPE t
   INTERFACE 
-    PURE SUBROUTINE copy_proc_intr(a,b)
+    SUBROUTINE copy_proc_intr(a,b)
       CLASS(*), INTENT(IN) :: a
       CLASS(*), INTENT(OUT) :: b
     END SUBROUTINE copy_proc_intr
@@ -40,7 +40,7 @@ PROGRAM main
   CALL test%copy(copy_int,copy_x)
 !   PRINT '(*(I0,:2X))', copy_x
 CONTAINS
-  PURE SUBROUTINE copy_int(a,b)
+  SUBROUTINE copy_int(a,b)
     CLASS(*), INTENT(IN) :: a
     CLASS(*), INTENT(OUT) :: b
     SELECT TYPE(a); TYPE IS(integer) 
