* [Patch, Fortran] Fix a coarray ICE on invalid code
@ 2014-06-23 18:27 Tobias Burnus
0 siblings, 0 replies; only message in thread
From: Tobias Burnus @ 2014-06-23 18:27 UTC (permalink / raw)
To: gcc-patches, gfortran
[-- Attachment #1: Type: text/plain, Size: 322 bytes --]
First, the following coarray patches are still awaiting review:
* https://gcc.gnu.org/ml/gcc-patches/2014-06/msg01662.html
* https://gcc.gnu.org/ml/fortran/2014-06/msg00183.html
The attached patch fixes an ICE on invalid code with polymorphic coarrays.
Build and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
[-- Attachment #2: caf.diff --]
[-- Type: text/x-patch, Size: 3477 bytes --]
gcc/fortran/
2014-06-21 Tobias Burnus <burnus@net-b.de>
* interface.c (check_intents): Fix diagnostic with
coindexed coarrays.
gcc/testsuite/
2014-06-21 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/coarray_33.f90: New.
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 67548c0..b210d18 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3170,17 +3170,26 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
for (;; f = f->next, a = a->next)
{
+ gfc_expr *expr;
+
if (f == NULL && a == NULL)
break;
if (f == NULL || a == NULL)
gfc_internal_error ("check_intents(): List mismatch");
- if (a->expr == NULL || a->expr->expr_type != EXPR_VARIABLE)
+ if (a->expr && a->expr->expr_type == EXPR_FUNCTION
+ && a->expr->value.function.isym
+ && a->expr->value.function.isym->id == GFC_ISYM_CAF_GET)
+ expr = a->expr->value.function.actual->expr;
+ else
+ expr = a->expr;
+
+ if (expr == NULL || expr->expr_type != EXPR_VARIABLE)
continue;
f_intent = f->sym->attr.intent;
- if (gfc_pure (NULL) && gfc_impure_variable (a->expr->symtree->n.sym))
+ if (gfc_pure (NULL) && gfc_impure_variable (expr->symtree->n.sym))
{
if ((f->sym->ts.type == BT_CLASS && f->sym->attr.class_ok
&& CLASS_DATA (f->sym)->attr.class_pointer)
@@ -3188,19 +3197,19 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
{
gfc_error ("Procedure argument at %L is local to a PURE "
"procedure and has the POINTER attribute",
- &a->expr->where);
+ &expr->where);
return false;
}
}
/* Fortran 2008, C1283. */
- if (gfc_pure (NULL) && gfc_is_coindexed (a->expr))
+ if (gfc_pure (NULL) && gfc_is_coindexed (expr))
{
if (f_intent == INTENT_INOUT || f_intent == INTENT_OUT)
{
gfc_error ("Coindexed actual argument at %L in PURE procedure "
"is passed to an INTENT(%s) argument",
- &a->expr->where, gfc_intent_string (f_intent));
+ &expr->where, gfc_intent_string (f_intent));
return false;
}
@@ -3210,18 +3219,18 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
{
gfc_error ("Coindexed actual argument at %L in PURE procedure "
"is passed to a POINTER dummy argument",
- &a->expr->where);
+ &expr->where);
return false;
}
}
/* F2008, Section 12.5.2.4. */
- if (a->expr->ts.type == BT_CLASS && f->sym->ts.type == BT_CLASS
- && gfc_is_coindexed (a->expr))
+ if (expr->ts.type == BT_CLASS && f->sym->ts.type == BT_CLASS
+ && gfc_is_coindexed (expr))
{
gfc_error ("Coindexed polymorphic actual argument at %L is passed "
"polymorphic dummy argument '%s'",
- &a->expr->where, f->sym->name);
+ &expr->where, f->sym->name);
return false;
}
}
diff --git a/gcc/testsuite/gfortran.dg/coarray_33.f90 b/gcc/testsuite/gfortran.dg/coarray_33.f90
new file mode 100644
index 0000000..9bd87f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_33.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+type t
+ integer :: x
+end type t
+
+class(t), allocatable :: a[:]
+allocate(t :: a[*])
+a%x = this_image()
+
+call foo(a[i]) ! { dg-error "Coindexed polymorphic actual argument at .1. is passed polymorphic dummy argument" }
+contains
+subroutine foo(y)
+ class(t) :: y
+ print *, y%x
+end subroutine foo
+end
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2014-06-23 18:27 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2014-06-23 18:27 [Patch, Fortran] Fix a coarray ICE on invalid code Tobias Burnus
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).