* [Patch, Fortran] PR55854/PR55763 - CLASS(*) fixes
@ 2013-01-03 16:39 Tobias Burnus
2013-01-04 5:00 ` Paul Richard Thomas
0 siblings, 1 reply; 2+ messages in thread
From: Tobias Burnus @ 2013-01-03 16:39 UTC (permalink / raw)
To: gcc patches, gfortran
[-- Attachment #1: Type: text/plain, Size: 291 bytes --]
The attached patch fixes two ICE.
Regarding the unlimited_polymorphic_3.f03 change: "null(x)" is invalid
as initialization expression (null-init). Using "ptr2 => x" would be
valid, but it ICEs. (Cf. PR55763, comment 13)
Build and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
[-- Attachment #2: unlimited-fixes.diff --]
[-- Type: text/x-patch, Size: 3827 bytes --]
2013-01-03 Tobias Burnus <burnus@net-b.de>
PR fortran/55854
PR fortran/55763
* class.c (gfc_class_null_initializer): Fix finding the vtab.
(gfc_find_intrinsic_vtab): Use BT_VOID for some components.
2013-01-03 Tobias Burnus <burnus@net-b.de>
PR fortran/55854
PR fortran/55763
* gfortran.dg/unlimited_polymorphic_3.f03: Remove invalid code.
* gfortran.dg/unlimited_polymorphic_7.f90: New.
* gfortran.dg/unlimited_polymorphic_8.f90: New.
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 61d65e7..5cbdd31 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -414,7 +414,7 @@ gfc_class_null_initializer (gfc_typespec *ts, gfc_expr *init_expr)
&& ts->u.derived->components->ts.u.derived->attr.unlimited_polymorphic;
if (is_unlimited_polymorphic && init_expr)
- vtab = gfc_find_intrinsic_vtab (&(init_expr->ts));
+ vtab = gfc_find_intrinsic_vtab (&ts->u.derived->components->ts);
else
vtab = gfc_find_derived_vtab (ts->u.derived);
@@ -2224,9 +2224,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
goto cleanup;
c->attr.pointer = 1;
c->attr.access = ACCESS_PRIVATE;
- /* Avoid segfaults because due to character length. */
- c->ts.type = ts->type == BT_CHARACTER ? BT_VOID : ts->type;
- c->ts.kind = ts->kind;
+ c->ts.type = BT_VOID;
c->initializer = gfc_get_null_expr (NULL);
/* Add component _def_init. */
@@ -2234,9 +2232,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
goto cleanup;
c->attr.pointer = 1;
c->attr.access = ACCESS_PRIVATE;
- /* Avoid segfaults due to missing character length. */
- c->ts.type = ts->type == BT_CHARACTER ? BT_VOID : ts->type;
- c->ts.kind = ts->kind;
+ c->ts.type = BT_VOID;
c->initializer = gfc_get_null_expr (NULL);
/* Add component _copy. */
diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03
index 5ed9897..05a4b3f 100644
--- a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03
@@ -28,9 +28,7 @@ contains
end type t
type(t), pointer :: x
class(*), pointer :: ptr1 => null() ! pointer initialization
- class(*), pointer :: ptr2 => null(x) ! pointer initialization
if (same_type_as (ptr1, x) .neqv. .FALSE.) call abort
- if (same_type_as (ptr2, x) .neqv. .TRUE.) call abort
end subroutine bar
end program main
diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_7.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_7.f90
new file mode 100644
index 0000000..3bd4d4d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_7.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! PR fortran/55763
+!
+! Contributed by Harald Anlauf
+!
+
+module gfcbug121
+ implicit none
+ type myobj
+ class(*), allocatable :: x
+ contains
+ procedure :: print
+ end type myobj
+contains
+ subroutine print(this)
+ class(myobj) :: this
+ end subroutine print
+end module gfcbug121
diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_8.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_8.f90
new file mode 100644
index 0000000..e0fa931
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_8.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/55854
+!
+! Contributed by Damian Rouson
+!
+
+ type foo
+ class(*), allocatable :: x
+ end type
+contains
+ subroutine bar(this)
+ type(foo), intent(out) :: this
+ end
+end
+
+! { dg-final { scan-tree-dump-times "foo.0.x._data = 0B;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo.0.x._vptr = .* &__vtab__.tar;" 1 "original" } }
+! { dg-final { cleanup-tree-dump "optimized" } }
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: [Patch, Fortran] PR55854/PR55763 - CLASS(*) fixes
2013-01-03 16:39 [Patch, Fortran] PR55854/PR55763 - CLASS(*) fixes Tobias Burnus
@ 2013-01-04 5:00 ` Paul Richard Thomas
0 siblings, 0 replies; 2+ messages in thread
From: Paul Richard Thomas @ 2013-01-04 5:00 UTC (permalink / raw)
To: Tobias Burnus; +Cc: gcc patches, gfortran
Dear Tobias,
Hah! You are right about null(x). It is an odd constraint, though,
since all that is used is the type/kind information.
OK for trunk
Thanks for the patch.
Paul
On 3 January 2013 17:38, Tobias Burnus <burnus@net-b.de> wrote:
> The attached patch fixes two ICE.
>
> Regarding the unlimited_polymorphic_3.f03 change: "null(x)" is invalid as
> initialization expression (null-init). Using "ptr2 => x" would be valid, but
> it ICEs. (Cf. PR55763, comment 13)
>
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?
>
> Tobias
--
The knack of flying is learning how to throw yourself at the ground and miss.
--Hitchhikers Guide to the Galaxy
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2013-01-04 5:00 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2013-01-03 16:39 [Patch, Fortran] PR55854/PR55763 - CLASS(*) fixes Tobias Burnus
2013-01-04 5:00 ` Paul Richard Thomas
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).