diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2021-05-06 14:41:33 +0100 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2021-05-06 14:42:59 +0100 |
| commit | a2c593009fef1564dbef2237ee71e9fd08f5361e (patch) | |
| tree | 131946c90eb097b53e49ef36e78730199828d238 /gcc/fortran/trans-array.c | |
| parent | eb1aa9ad2afbcd8f3e939310d5785ff8563a8c5c (diff) | |
| download | gcc-a2c593009fef1564dbef2237ee71e9fd08f5361e.zip gcc-a2c593009fef1564dbef2237ee71e9fd08f5361e.tar.gz gcc-a2c593009fef1564dbef2237ee71e9fd08f5361e.tar.bz2 | |
Fortran: Assumed and explicit size class arrays [PR46691/99819].
2021-05-06 Paul Thomas <pault@gcc.gnu.org>
gcc/fortran/ChangeLog
PR fortran/46691
PR fortran/99819
* class.c (gfc_build_class_symbol): Remove the error that
disables assumed size class arrays. Class array types that are
not deferred shape or assumed rank are given a unique name and
placed in the procedure namespace.
* trans-array.c (gfc_trans_g77_array): Obtain the data pointer
for class arrays.
(gfc_trans_dummy_array_bias): Suppress the runtime error for
extent violations in explicit shape class arrays because it
always fails.
* trans-expr.c (gfc_conv_procedure_call): Handle assumed size
class actual arguments passed to non-descriptor formal args by
using the data pointer, stored as the symbol's backend decl.
gcc/testsuite/ChangeLog
PR fortran/46691
PR fortran/99819
* gfortran.dg/class_dummy_6.f90: New test.
* gfortran.dg/class_dummy_7.f90: New test.
Diffstat (limited to 'gcc/fortran/trans-array.c')
| -rw-r--r-- | gcc/fortran/trans-array.c | 12 |
1 files changed, 10 insertions, 2 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index e99980f..6d38ea7 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -6524,7 +6524,14 @@ gfc_trans_g77_array (gfc_symbol * sym, gfc_wrapped_block * block) /* Set the pointer itself if we aren't using the parameter directly. */ if (TREE_CODE (parm) != PARM_DECL) { - tmp = convert (TREE_TYPE (parm), GFC_DECL_SAVED_DESCRIPTOR (parm)); + tmp = GFC_DECL_SAVED_DESCRIPTOR (parm); + if (sym->ts.type == BT_CLASS) + { + tmp = build_fold_indirect_ref_loc (input_location, tmp); + tmp = gfc_class_data_get (tmp); + tmp = gfc_conv_descriptor_data_get (tmp); + } + tmp = convert (TREE_TYPE (parm), tmp); gfc_add_modify (&init, parm, tmp); } stmt = gfc_finish_block (&init); @@ -6626,7 +6633,8 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, && VAR_P (sym->ts.u.cl->backend_decl)) gfc_conv_string_length (sym->ts.u.cl, NULL, &init); - checkparm = (as->type == AS_EXPLICIT + /* TODO: Fix the exclusion of class arrays from extent checking. */ + checkparm = (as->type == AS_EXPLICIT && !is_classarray && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)); no_repack = !(GFC_DECL_PACKED_ARRAY (tmpdesc) |