* [Patch, Fortran] PR55763 - reject "type is(INTEGER)" with non-class(*) selector in SELECT TYPE
@ 2013-01-06 15:32 Tobias Burnus
2013-01-07 5:57 ` Paul Richard Thomas
0 siblings, 1 reply; 2+ messages in thread
From: Tobias Burnus @ 2013-01-06 15:32 UTC (permalink / raw)
To: gcc patches, gfortran
[-- Attachment #1: Type: text/plain, Size: 143 bytes --]
A rather obvious fix, though one can think about the error wording.
Bootstrapped and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
[-- Attachment #2: select-type-ice.diff --]
[-- Type: text/x-patch, Size: 2333 bytes --]
2012-01-06 Tobias Burnus <burnus@net-b.de>
PR fortran/55763
* resolve.c (resolve_select_type): Reject intrinsic types for
a non-unlimited-polymorphic selector.
2012-01-06 Tobias Burnus <burnus@net-b.de>
PR fortran/55763
* gfortran.dg/select_type_32.f90: New.
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 54ac3c6..a3f0485 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8388,12 +8388,16 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
}
/* Check F03:C816. */
- if ((c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
- && !selector_type->attr.unlimited_polymorphic
- && !gfc_type_is_extension_of (selector_type, c->ts.u.derived))
+ if (c->ts.type != BT_UNKNOWN && !selector_type->attr.unlimited_polymorphic
+ && ((c->ts.type != BT_DERIVED && c->ts.type != BT_CLASS)
+ || !gfc_type_is_extension_of (selector_type, c->ts.u.derived)))
{
- gfc_error ("Derived type '%s' at %L must be an extension of '%s'",
- c->ts.u.derived->name, &c->where, selector_type->name);
+ if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
+ gfc_error ("Derived type '%s' at %L must be an extension of '%s'",
+ c->ts.u.derived->name, &c->where, selector_type->name);
+ else
+ gfc_error ("Unexpected intrinsic type '%s' at %L",
+ gfc_basic_typename (c->ts.type), &c->where);
error++;
continue;
}
diff --git a/gcc/testsuite/gfortran.dg/select_type_32.f90 b/gcc/testsuite/gfortran.dg/select_type_32.f90
new file mode 100644
index 0000000..5e36639
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_32.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+! PR fortran/55763
+!
+! Contributed by Harald Anlauf
+!
+
+module gfcbug122
+ implicit none
+ type myobj
+ class(*), allocatable :: x
+ contains
+ procedure :: print
+ end type myobj
+contains
+ subroutine print(this)
+ class(myobj) :: this
+ select type (this)
+ type is (integer) ! { dg-error "Unexpected intrinsic type 'INTEGER'" }
+ type is (real) ! { dg-error "Unexpected intrinsic type 'REAL'" }
+ type is (complex) ! { dg-error "Unexpected intrinsic type 'COMPLEX'" }
+ type is (character(len=*)) ! { dg-error "Unexpected intrinsic type 'CHARACTER'" }
+ end select
+ end subroutine print
+end module gfcbug122
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: [Patch, Fortran] PR55763 - reject "type is(INTEGER)" with non-class(*) selector in SELECT TYPE
2013-01-06 15:32 [Patch, Fortran] PR55763 - reject "type is(INTEGER)" with non-class(*) selector in SELECT TYPE Tobias Burnus
@ 2013-01-07 5:57 ` Paul Richard Thomas
0 siblings, 0 replies; 2+ messages in thread
From: Paul Richard Thomas @ 2013-01-07 5:57 UTC (permalink / raw)
To: Tobias Burnus; +Cc: gcc patches, gfortran
Dear Tobias,
This, as you say, is obvious. OKfor trunk.
Thanks for the patch.
Paul
On 6 January 2013 16:32, Tobias Burnus <burnus@net-b.de> wrote:
> A rather obvious fix, though one can think about the error wording.
>
> Bootstrapped 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-07 5:57 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2013-01-06 15:32 [Patch, Fortran] PR55763 - reject "type is(INTEGER)" with non-class(*) selector in SELECT TYPE Tobias Burnus
2013-01-07 5:57 ` 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).