diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2020-11-16 22:00:58 +0100 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2020-11-16 22:00:58 +0100 |
| commit | 0c81ccc3d87098b93b0e6a2dd76815e4d6e78ff0 (patch) | |
| tree | 5ffcbfe00738b49706f8003bd3fb49e13badfba9 /gcc/fortran/trans-intrinsic.c | |
| parent | a71a2255bc692e41341ad04360925a3c7443ba16 (diff) | |
| download | gcc-0c81ccc3d87098b93b0e6a2dd76815e4d6e78ff0.zip gcc-0c81ccc3d87098b93b0e6a2dd76815e4d6e78ff0.tar.gz gcc-0c81ccc3d87098b93b0e6a2dd76815e4d6e78ff0.tar.bz2 | |
PR fortran/48958 - Add runtime diagnostics for SIZE intrinsic function
Add code for runtime checking of status of ALLOCATABLE and POINTER
arguments to the SIZE intrinsic when -fcheck=pointer is specified.
gcc/fortran/ChangeLog:
* trans-intrinsic.c (gfc_conv_intrinsic_size): Generate runtime
checking code for status of argument.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr48958.f90: New test.
Diffstat (limited to 'gcc/fortran/trans-intrinsic.c')
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 29 |
1 files changed, 29 insertions, 0 deletions
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index e0afc10..d17b623 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -7929,6 +7929,35 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr) && strcmp (e->ref->u.c.component->name, "_data") == 0) sym = e->symtree->n.sym; + if ((gfc_option.rtcheck & GFC_RTCHECK_POINTER) + && e + && (e->expr_type == EXPR_VARIABLE || e->expr_type == EXPR_FUNCTION)) + { + symbol_attribute attr; + char *msg; + + attr = gfc_expr_attr (e); + if (attr.allocatable) + msg = xasprintf ("Allocatable argument '%s' is not allocated", + e->symtree->n.sym->name); + else if (attr.pointer) + msg = xasprintf ("Pointer argument '%s' is not associated", + e->symtree->n.sym->name); + 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)); + gfc_trans_runtime_check (true, false, cond, &argse.pre, &e->where, msg); + free (msg); + } + end_arg_check: + argse.data_not_needed = 1; if (gfc_is_class_array_function (e)) { |