]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fix random class_allocate_18.f90 failure
authorMikael Morin <mikael@gcc.gnu.org>
Wed, 5 Aug 2015 16:42:00 +0000 (16:42 +0000)
committerMikael Morin <mikael@gcc.gnu.org>
Wed, 5 Aug 2015 16:42:00 +0000 (16:42 +0000)
PR fortran/64921
gcc/fortran/
* class.c (generate_finalization_wrapper): Set finalization
procedure symbol's always_explicit attribute.
gcc/testsuite/
* gfortran.dg/class_allocate_20.f90: New.

From-SVN: r226639

gcc/fortran/ChangeLog
gcc/fortran/class.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/class_allocate_20.f90 [new file with mode: 0644]

index e0a8816a75d74611bd6e98832bf1be6be16f790e..34d61244115690bc66aca99dfa7c54c33bc1ac2d 100644 (file)
@@ -1,3 +1,9 @@
+2015-08-05  Mikael Morin  <mikael@gcc.gnu.org>
+
+       PR fortran/64921
+       * class.c (generate_finalization_wrapper): Set finalization
+       procedure symbol's always_explicit attribute.
+
 2015-06-26  Release Manager
 
        * GCC 4.9.3 released.
index cd0330a0c54be7b0a5c9ad8c5499c9184e5bbe6e..f83a24bd1b002a9170a4078502b9f7c0abd6c53b 100644 (file)
@@ -1596,6 +1596,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
   final->ts.type = BT_INTEGER;
   final->ts.kind = 4;
   final->attr.artificial = 1;
+  final->attr.always_explicit = 1;
   final->attr.if_source = expr_null_wrapper ? IFSRC_IFBODY : IFSRC_DECL;
   if (ns->proc_name->attr.flavor == FL_MODULE)
     final->module = ns->proc_name->name;
index 64920695bf4f04afabf2eeefe6c1c0242de1de7c..c69841a296f5cc826dc6237c756d7b2f64271a7b 100644 (file)
@@ -1,3 +1,8 @@
+2015-08-05  Mikael Morin  <mikael@gcc.gnu.org>
+
+       PR fortran/64921
+       * gfortran.dg/class_allocate_20.f90: New.
+
 2015-08-04  Szabolcs Nagy  <szabolcs.nagy@arm.com>
 
        Backport from mainline r225450:
diff --git a/gcc/testsuite/gfortran.dg/class_allocate_20.f90 b/gcc/testsuite/gfortran.dg/class_allocate_20.f90
new file mode 100644 (file)
index 0000000..defe9df
--- /dev/null
@@ -0,0 +1,32 @@
+! { dg-do run }
+!
+! PR fortran/64921
+! Test that the finalization wrapper procedure get the always_explicit
+! attribute so that the array is not passed without descriptor from 
+! T3's finalization wrapper procedure to T2's one.
+!
+! Contributed by Mat Cross  <mathewc@nag.co.uk>
+
+Program test
+  Implicit None
+  Type :: t1
+    Integer, Allocatable :: i
+  End Type
+  Type :: t2
+    Integer, Allocatable :: i
+  End Type
+  Type, Extends (t1) :: t3
+    Type (t2) :: j
+  End Type
+  Type, Extends (t3) :: t4
+    Integer, Allocatable :: k
+  End Type
+  Call s
+  Print *, 'ok'
+Contains
+  Subroutine s
+    Class (t1), Allocatable :: x
+    Allocate (t4 :: x)
+  End Subroutine
+End Program
+! { dg-output "ok" }