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-intrinsic.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-intrinsic.c')
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 28 |
1 files changed, 20 insertions, 8 deletions
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 9cf3642..5e53d11 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -8006,8 +8006,10 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr) { symbol_attribute attr; char *msg; + tree temp; + tree cond; - attr = gfc_expr_attr (e); + attr = sym ? sym->attr : gfc_expr_attr (e); if (attr.allocatable) msg = xasprintf ("Allocatable argument '%s' is not allocated", e->symtree->n.sym->name); @@ -8017,14 +8019,24 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr) else goto end_arg_check; - argse.descriptor_only = 1; - gfc_conv_expr_descriptor (&argse, actual->expr); - tree temp = gfc_conv_descriptor_data_get (argse.expr); - tree cond = fold_build2_loc (input_location, EQ_EXPR, - logical_type_node, temp, - fold_convert (TREE_TYPE (temp), - null_pointer_node)); + if (sym) + { + temp = gfc_class_data_get (sym->backend_decl); + temp = gfc_conv_descriptor_data_get (temp); + } + else + { + argse.descriptor_only = 1; + gfc_conv_expr_descriptor (&argse, actual->expr); + temp = gfc_conv_descriptor_data_get (argse.expr); + } + + cond = fold_build2_loc (input_location, EQ_EXPR, + logical_type_node, temp, + fold_convert (TREE_TYPE (temp), + null_pointer_node)); gfc_trans_runtime_check (true, false, cond, &argse.pre, &e->where, msg); + free (msg); } end_arg_check: |