From: Tobias Burnus <burnus@net-b.de>
Date: Wed, 23 Oct 2013 05:44:02 +0000 (+0200)
Subject: re PR fortran/58793 (Wrong value for _vtab for intrinsic types with CLASS(*): storage... 
X-Git-Tag: releases/gcc-4.9.0~3291
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=3d54e576483fe7a746ec6a9f5c4a42e743f27d13;p=thirdparty%2Fgcc.git

re PR fortran/58793 (Wrong value for _vtab for intrinsic types with CLASS(*): storage_size of class(*) gives wrong result)

2013-10-23  Tobias Burnus  <burnus@net-b.de>

        PR fortran/58793
        * interface.c (compare_parameter): Reject passing TYPE(*)
        to CLASS(*).

2013-10-23  Tobias Burnus  <burnus@net-b.de>

        PR fortran/58793
        * gfortran.dg/assumed_type_8.f90: New.

From-SVN: r203945
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 3539d2cbebdd..def8b05c132a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2013-10-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/58793
+	* interface.c (compare_parameter): Reject passing TYPE(*)
+	to CLASS(*).
+
 2013-10-22  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran 57893
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index b3ddf5f08b33..0504c904b96d 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1972,6 +1972,15 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
       return 0;
     }
 
+  if (actual->ts.type == BT_ASSUMED && formal->ts.type != BT_ASSUMED)
+    {
+      if (where)
+	gfc_error ("Assumed-type actual argument at %L requires that dummy "
+		   "argument '%s' is of assumed type", &actual->where,
+		   formal->name);
+      return 0;
+    }
+
   /* F2008, 12.5.2.5; IR F08/0073.  */
   if (formal->ts.type == BT_CLASS && formal->attr.class_ok
       && actual->expr_type != EXPR_NULL
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 58639a21e769..28a379e65213 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2013-10-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/58793
+	* gfortran.dg/assumed_type_8.f90: New.
+
 2013-10-22  Uros Bizjak  <ubizjak@gmail.com>
 
 	PR target/58779
diff --git a/gcc/testsuite/gfortran.dg/assumed_type_8.f90 b/gcc/testsuite/gfortran.dg/assumed_type_8.f90
new file mode 100644
index 000000000000..543e693bb4b5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_type_8.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! Issue came up during the review of PR fortran/58793
+!
+! Test for TS29113:2012's C407b.
+! 
+program test
+  use iso_c_binding
+  integer,target ::aa
+  call up(c_loc(aa))
+contains
+  subroutine up(x)
+    class(*) :: x
+  end subroutine
+  subroutine bar(x)
+   type(*) :: x
+   call up(x) ! { dg-error "Assumed-type actual argument at .1. requires that dummy argument 'x' is of assumed type" }
+  end subroutine bar
+end program test