diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2021-03-14 20:39:58 +0100 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2021-03-14 20:39:58 +0100 |
| commit | c2d7c39fcb8a3cb67600cdb6fde49ecb0e951589 (patch) | |
| tree | bc438cfdc6425aab5410aaf00f19c1adfe53a2cd /gcc/fortran/trans-expr.c | |
| parent | 553488851dd150c09c245ee64b2c0c3c15f75bbd (diff) | |
| download | gcc-c2d7c39fcb8a3cb67600cdb6fde49ecb0e951589.zip gcc-c2d7c39fcb8a3cb67600cdb6fde49ecb0e951589.tar.gz gcc-c2d7c39fcb8a3cb67600cdb6fde49ecb0e951589.tar.bz2 | |
PR fortran/99112 - ICE with runtime diagnostics for SIZE intrinsic function
Add/fix handling of runtime checks for CLASS arguments with ALLOCATABLE
or POINTER attribute.
gcc/fortran/ChangeLog:
* trans-expr.c (gfc_conv_procedure_call): Fix runtime checks for
CLASS arguments.
* trans-intrinsic.c (gfc_conv_intrinsic_size): Likewise.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr99112.f90: New test.
Co-authored-by: Paul Thomas <pault@gcc.gnu.org>
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 14 |
1 files changed, 12 insertions, 2 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index f6ef5c0..bffe080 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -6662,6 +6662,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, symbol_attribute attr; char *msg; tree cond; + tree tmp; if (e->expr_type == EXPR_VARIABLE || e->expr_type == EXPR_FUNCTION) attr = gfc_expr_attr (e); @@ -6732,11 +6733,20 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, else goto end_pointer_check; - tmp = parmse.expr; + if (fsym && fsym->ts.type == BT_CLASS) + { + tmp = build_fold_indirect_ref_loc (input_location, + parmse.expr); + tmp = gfc_class_data_get (tmp); + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))) + tmp = gfc_conv_descriptor_data_get (tmp); + } + else + tmp = parmse.expr; /* If the argument is passed by value, we need to strip the INDIRECT_REF. */ - if (!POINTER_TYPE_P (TREE_TYPE (parmse.expr))) + if (!POINTER_TYPE_P (TREE_TYPE (tmp))) tmp = gfc_build_addr_expr (NULL_TREE, tmp); cond = fold_build2_loc (input_location, EQ_EXPR, |