From fc27115d6107f219e6f3dc610c99210005fe9dc5 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sat, 3 Apr 2021 12:49:50 +0100 Subject: Fortran: Fix ICE on wrong code [PR99818]. 2021-04-03 Paul Thomas gcc/fortran/ChangeLog PR fortran/99818 * interface.c (compare_parameter): The codimension attribute is applied to the _data field of class formal arguments. gcc/testsuite/ChangeLog PR fortran/99818 * gfortran.dg/coarray_48.f90: New test. --- gcc/fortran/interface.c | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) (limited to 'gcc/fortran/interface.c') diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index f7ca52e..6073612 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2327,6 +2327,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, bool rank_check, is_pointer; char err[200]; gfc_component *ppc; + bool codimension = false; /* If the formal arg has type BT_VOID, it's to one of the iso_c_binding procs c_f_pointer or c_f_procpointer, and we need to accept most @@ -2490,7 +2491,12 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, return false; } - if (formal->attr.codimension && !gfc_is_coarray (actual)) + if (formal->ts.type == BT_CLASS && formal->attr.class_ok) + codimension = CLASS_DATA (formal)->attr.codimension; + else + codimension = formal->attr.codimension; + + if (codimension && !gfc_is_coarray (actual)) { if (where) gfc_error ("Actual argument to %qs at %L must be a coarray", @@ -2498,7 +2504,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, return false; } - if (formal->attr.codimension && formal->attr.allocatable) + if (codimension && formal->attr.allocatable) { gfc_ref *last = NULL; @@ -2520,7 +2526,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, } } - if (formal->attr.codimension) + if (codimension) { /* F2008, 12.5.2.8 + Corrig 2 (IR F08/0048). */ /* F2018, 12.5.2.8. */ @@ -2586,7 +2592,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, return false; } - if (formal->attr.allocatable && !formal->attr.codimension + if (formal->attr.allocatable && !codimension && actual_attr.codimension) { if (formal->attr.intent == INTENT_OUT) -- cgit v1.1 From a8b79cc939d6786293f654c42a2d1b0ab040de0e Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Wed, 5 May 2021 15:25:50 +0200 Subject: PR fortran/100274 - ICE in gfc_conv_procedure_call, at fortran/trans-expr.c:6131 When the check for the length of formal and actual character arguments found a mismatch and emitted a warning, it would skip further checks like that could lead to errors. Fix that by continuing the checking. Also catch a NULL pointer dereference. gcc/fortran/ChangeLog: PR fortran/100274 * interface.c (gfc_compare_actual_formal): Continue checks after emitting warning for argument length mismatch. * trans-expr.c (gfc_conv_procedure_call): Check for NULL pointer dereference. gcc/testsuite/ChangeLog: PR fortran/100274 * gfortran.dg/argument_checking_25.f90: New test. --- gcc/fortran/interface.c | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'gcc/fortran/interface.c') diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 6073612..9e3e8aa 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -3255,10 +3255,13 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, && f->sym->attr.flavor != FL_PROCEDURE) { if (a->expr->ts.type == BT_CHARACTER && !f->sym->as && where) - gfc_warning (0, "Character length of actual argument shorter " - "than of dummy argument %qs (%lu/%lu) at %L", - f->sym->name, actual_size, formal_size, - &a->expr->where); + { + gfc_warning (0, "Character length of actual argument shorter " + "than of dummy argument %qs (%lu/%lu) at %L", + f->sym->name, actual_size, formal_size, + &a->expr->where); + goto skip_size_check; + } else if (where) { /* Emit a warning for -std=legacy and an error otherwise. */ -- cgit v1.1