summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog27
-rw-r--r--gcc/fortran/gfortran.h1
-rw-r--r--gcc/fortran/intrinsic.c1
-rw-r--r--gcc/fortran/iresolve.c38
-rw-r--r--gcc/fortran/resolve.c31
-rw-r--r--gcc/fortran/trans-array.c95
-rw-r--r--gcc/fortran/trans-array.h2
-rw-r--r--gcc/fortran/trans-expr.c6
-rw-r--r--gcc/fortran/trans-intrinsic.c2
-rw-r--r--gcc/fortran/trans-stmt.c43
-rw-r--r--gcc/fortran/trans.c10
-rw-r--r--gcc/fortran/trans.h3
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/mvbits_4.f9033
14 files changed, 242 insertions, 55 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f4f82e2875d..a7baab24526 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,30 @@
+2008-11-01 Daniel Kraft <d@domob.eu>
+
+ PR fortran/35681
+ * gfortran.h (struct gfc_code): New field `resolved_isym'.
+ * trans.h (gfc_build_memcpy_call): Made public.
+ * trans-array.h (gfc_trans_create_temp_array): New argument `initial'.
+ * intrinsic.c (gfc_intrinsic_sub_interface): Set resolved_isym.
+ * iresolve.c (create_formal_for_intents): New helper method.
+ (gfc_resolve_mvbits): Put dummy formal arglist on resolved_sym.
+ * resolve.c (resolve_call): Initialize resolved_isym to NULL.
+ * trans-array.c (gfc_trans_allocate_array_storage): New argument
+ `initial' to allow initializing the allocated storage to some initial
+ value copied from another array.
+ (gfc_trans_create_temp_array): Allow initialization of the temporary
+ with a copy of some other array by using the new extension.
+ (gfc_trans_array_constructor): Pass NULL_TREE for initial argument.
+ (gfc_conv_loop_setup): Ditto.
+ * trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): Ditto.
+ * trans-expr.c (gfc_conv_function_call): Ditto.
+ (gfc_build_memcpy_call): Made public.
+ * trans-stmt.c (gfc_conv_elemental_dependencies): Initialize created
+ temporary for INTENT(INOUT) arguments to the value of the mirrored
+ array and clean up the temporary as very last intructions in the created
+ block.
+ * trans.c (gfc_trans_code): For EXEC_CALL, see if we have a MVBITS call
+ and enable elemental dependency checking if we have.
+
2008-11-01 Janus Weil <janus@gcc.gnu.org>
PR fortran/36322
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index d2c415a47a7..5f4880eebf2 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1886,6 +1886,7 @@ typedef struct gfc_code
symbol for the interface definition.
const char *sub_name; */
gfc_symbol *resolved_sym;
+ gfc_intrinsic_sym *resolved_isym;
union
{
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 7acdcb05e60..1864785a318 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -3746,6 +3746,7 @@ gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
if (!error_flag)
gfc_pop_suppress_errors ();
+ c->resolved_isym = isym;
if (isym->resolve.s1 != NULL)
isym->resolve.s1 (c);
else
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index f447ba279cf..619d7e9546a 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -2608,9 +2608,43 @@ gfc_resolve_cpu_time (gfc_code *c)
}
+/* Create a formal arglist based on an actual one and set the INTENTs given. */
+
+static gfc_formal_arglist*
+create_formal_for_intents (gfc_actual_arglist* actual, const sym_intent* ints)
+{
+ gfc_formal_arglist* head;
+ gfc_formal_arglist* tail;
+ int i;
+
+ if (!actual)
+ return NULL;
+
+ head = tail = gfc_get_formal_arglist ();
+ for (i = 0; actual; actual = actual->next, tail = tail->next, ++i)
+ {
+ gfc_symbol* sym;
+
+ sym = gfc_new_symbol ("dummyarg", NULL);
+ sym->ts = actual->expr->ts;
+
+ sym->attr.intent = ints[i];
+ tail->sym = sym;
+
+ if (actual->next)
+ tail->next = gfc_get_formal_arglist ();
+ }
+
+ return head;
+}
+
+
void
gfc_resolve_mvbits (gfc_code *c)
{
+ static const sym_intent INTENTS[] = {INTENT_IN, INTENT_IN, INTENT_IN,
+ INTENT_INOUT, INTENT_IN};
+
const char *name;
gfc_typespec ts;
gfc_clear_ts (&ts);
@@ -2632,6 +2666,10 @@ gfc_resolve_mvbits (gfc_code *c)
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
/* Mark as elemental subroutine as this does not happen automatically. */
c->resolved_sym->attr.elemental = 1;
+
+ /* Create a dummy formal arglist so the INTENTs are known later for purpose
+ of creating temporaries. */
+ c->resolved_sym->formal = create_formal_for_intents (c->ext.actual, INTENTS);
}
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index bccb46ab218..c03f6a629d8 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2913,23 +2913,26 @@ resolve_call (gfc_code *c)
t = SUCCESS;
if (c->resolved_sym == NULL)
- switch (procedure_kind (csym))
- {
- case PTYPE_GENERIC:
- t = resolve_generic_s (c);
- break;
+ {
+ c->resolved_isym = NULL;
+ switch (procedure_kind (csym))
+ {
+ case PTYPE_GENERIC:
+ t = resolve_generic_s (c);
+ break;
- case PTYPE_SPECIFIC:
- t = resolve_specific_s (c);
- break;
+ case PTYPE_SPECIFIC:
+ t = resolve_specific_s (c);
+ break;
- case PTYPE_UNKNOWN:
- t = resolve_unknown_s (c);
- break;
+ case PTYPE_UNKNOWN:
+ t = resolve_unknown_s (c);
+ break;
- default:
- gfc_internal_error ("resolve_subroutine(): bad function type");
- }
+ default:
+ gfc_internal_error ("resolve_subroutine(): bad function type");
+ }
+ }
/* Some checks of elemental subroutine actual arguments. */
if (resolve_elemental_actual (NULL, c) == FAILURE)
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 5080e0fa5cc..db43a40d82d 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -493,14 +493,17 @@ gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping,
callee will allocate the array. If DEALLOC is true, also generate code to
free the array afterwards.
+ If INITIAL is not NULL, it is packed using internal_pack and the result used
+ as data instead of allocating a fresh, unitialized area of memory.
+
Initialization code is added to PRE and finalization code to POST.
DYNAMIC is true if the caller may want to extend the array later
using realloc. This prevents us from putting the array on the stack. */
static void
gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
- gfc_ss_info * info, tree size, tree nelem,
- bool dynamic, bool dealloc)
+ gfc_ss_info * info, tree size, tree nelem,
+ tree initial, bool dynamic, bool dealloc)
{
tree tmp;
tree desc;
@@ -517,7 +520,8 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
else
{
/* Allocate the temporary. */
- onstack = !dynamic && gfc_can_put_var_on_stack (size);
+ onstack = !dynamic && initial == NULL_TREE
+ && gfc_can_put_var_on_stack (size);
if (onstack)
{
@@ -534,9 +538,53 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
}
else
{
- /* Allocate memory to hold the data. */
- tmp = gfc_call_malloc (pre, NULL, size);
- tmp = gfc_evaluate_now (tmp, pre);
+ /* Allocate memory to hold the data or call internal_pack. */
+ if (initial == NULL_TREE)
+ {
+ tmp = gfc_call_malloc (pre, NULL, size);
+ tmp = gfc_evaluate_now (tmp, pre);
+ }
+ else
+ {
+ tree packed;
+ tree source_data;
+ tree was_packed;
+ stmtblock_t do_copying;
+
+ tmp = TREE_TYPE (initial); /* Pointer to descriptor. */
+ gcc_assert (TREE_CODE (tmp) == POINTER_TYPE);
+ tmp = TREE_TYPE (tmp); /* The descriptor itself. */
+ tmp = gfc_get_element_type (tmp);
+ gcc_assert (tmp == gfc_get_element_type (TREE_TYPE (desc)));
+ packed = gfc_create_var (build_pointer_type (tmp), "data");
+
+ tmp = build_call_expr (gfor_fndecl_in_pack, 1, initial);
+ tmp = fold_convert (TREE_TYPE (packed), tmp);
+ gfc_add_modify (pre, packed, tmp);
+
+ tmp = build_fold_indirect_ref (initial);
+ source_data = gfc_conv_descriptor_data_get (tmp);
+
+ /* internal_pack may return source->data without any allocation
+ or copying if it is already packed. If that's the case, we
+ need to allocate and copy manually. */
+
+ gfc_start_block (&do_copying);
+ tmp = gfc_call_malloc (&do_copying, NULL, size);
+ tmp = fold_convert (TREE_TYPE (packed), tmp);
+ gfc_add_modify (&do_copying, packed, tmp);
+ tmp = gfc_build_memcpy_call (packed, source_data, size);
+ gfc_add_expr_to_block (&do_copying, tmp);
+
+ was_packed = fold_build2 (EQ_EXPR, boolean_type_node,
+ packed, source_data);
+ tmp = gfc_finish_block (&do_copying);
+ tmp = build3_v (COND_EXPR, was_packed, tmp, build_empty_stmt ());
+ gfc_add_expr_to_block (pre, tmp);
+
+ tmp = fold_convert (pvoid_type_node, packed);
+ }
+
gfc_conv_descriptor_data_set (pre, desc, tmp);
}
}
@@ -567,14 +615,15 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
fields of info if known. Returns the size of the array, or NULL for a
callee allocated array.
- PRE, POST, DYNAMIC and DEALLOC are as for gfc_trans_allocate_array_storage.
+ PRE, POST, INITIAL, DYNAMIC and DEALLOC are as for
+ gfc_trans_allocate_array_storage.
*/
tree
gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
gfc_loopinfo * loop, gfc_ss_info * info,
- tree eltype, bool dynamic, bool dealloc,
- bool callee_alloc, locus * where)
+ tree eltype, tree initial, bool dynamic,
+ bool dealloc, bool callee_alloc, locus * where)
{
tree type;
tree desc;
@@ -600,8 +649,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
else
{
/* Callee allocated arrays may not have a known bound yet. */
- if (loop->to[n])
- loop->to[n] = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+ if (loop->to[n])
+ loop->to[n] = fold_build2 (MINUS_EXPR, gfc_array_index_type,
loop->to[n], loop->from[n]);
loop->from[n] = gfc_index_zero_node;
}
@@ -635,7 +684,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
{
stride[n] = size
delta = ubound[n] + 1 - lbound[n];
- size = size * delta;
+ size = size * delta;
}
size = size * sizeof(element);
*/
@@ -654,17 +703,17 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
for (n = 0; n < info->dimen; n++)
{
if (size == NULL_TREE)
- {
+ {
/* For a callee allocated array express the loop bounds in terms
of the descriptor fields. */
- tmp =
+ tmp =
fold_build2 (MINUS_EXPR, gfc_array_index_type,
gfc_conv_descriptor_ubound (desc, gfc_rank_cst[n]),
gfc_conv_descriptor_lbound (desc, gfc_rank_cst[n]));
- loop->to[n] = tmp;
- continue;
- }
-
+ loop->to[n] = tmp;
+ continue;
+ }
+
/* Store the stride and bound components in the descriptor. */
tmp = gfc_conv_descriptor_stride (desc, gfc_rank_cst[n]);
gfc_add_modify (pre, tmp, size);
@@ -712,8 +761,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
size = NULL_TREE;
}
- gfc_trans_allocate_array_storage (pre, post, info, size, nelem, dynamic,
- dealloc);
+ gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial,
+ dynamic, dealloc);
if (info->dimen > loop->temp_dim)
loop->temp_dim = info->dimen;
@@ -1811,7 +1860,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
}
gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info,
- type, dynamic, true, false, where);
+ type, NULL_TREE, dynamic, true, false, where);
desc = ss->data.info.descriptor;
offset = gfc_index_zero_node;
@@ -3523,8 +3572,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
loop->temp_ss->type = GFC_SS_SECTION;
loop->temp_ss->data.info.dimen = n;
gfc_trans_create_temp_array (&loop->pre, &loop->post, loop,
- &loop->temp_ss->data.info, tmp, false, true,
- false, where);
+ &loop->temp_ss->data.info, tmp, NULL_TREE,
+ false, true, false, where);
}
for (n = 0; n < loop->temp_dim; n++)
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 2cc9d5caf28..49818d4fe6d 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -32,7 +32,7 @@ void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *,
/* Generate code to create a temporary array. */
tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_loopinfo *,
- gfc_ss_info *, tree, bool, bool, bool,
+ gfc_ss_info *, tree, tree, bool, bool, bool,
locus *);
/* Generate function entry code for allocation of compiler allocated array
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 1c14ac15dc1..a3265ace756 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2863,8 +2863,8 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
mustn't be deallocated. */
callee_alloc = sym->attr.allocatable || sym->attr.pointer;
gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp,
- false, !sym->attr.pointer, callee_alloc,
- &se->ss->expr->where);
+ NULL_TREE, false, !sym->attr.pointer,
+ callee_alloc, &se->ss->expr->where);
/* Pass the temporary as the first argument. */
tmp = info->descriptor;
@@ -4384,7 +4384,7 @@ gfc_trans_zero_assign (gfc_expr * expr)
/* Helper for gfc_trans_array_copy and gfc_trans_array_constructor_copy
that constructs the call to __builtin_memcpy. */
-static tree
+tree
gfc_build_memcpy_call (tree dst, tree src, tree len)
{
tree tmp;
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index ffe1e5b913e..acf0b73a760 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -3787,7 +3787,7 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
FIXME callee_alloc is not set! */
gfc_trans_create_temp_array (&se->pre, &se->post, se->loop,
- info, mold_type, false, true, false,
+ info, mold_type, NULL_TREE, false, true, false,
&expr->where);
/* Cast the pointer to the result. */
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index da227523e72..343d5359d28 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -251,6 +251,9 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
&& gfc_check_fncall_dependency (e, fsym->attr.intent,
sym, arg0))
{
+ tree initial;
+ stmtblock_t temp_post;
+
/* Make a local loopinfo for the temporary creation, so that
none of the other ss->info's have to be renormalized. */
gfc_init_loopinfo (&tmp_loop);
@@ -261,27 +264,38 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
tmp_loop.order[n] = loopse->loop->order[n];
}
+ /* Obtain the argument descriptor for unpacking. */
+ gfc_init_se (&parmse, NULL);
+ parmse.want_pointer = 1;
+ gfc_conv_expr_descriptor (&parmse, e, gfc_walk_expr (e));
+ gfc_add_block_to_block (&se->pre, &parmse.pre);
+
+ /* If we've got INTENT(INOUT), initialize the array temporary with
+ a copy of the values. */
+ if (fsym->attr.intent == INTENT_INOUT)
+ initial = parmse.expr;
+ else
+ initial = NULL_TREE;
+
/* Generate the temporary. Merge the block so that the
- declarations are put at the right binding level. */
+ declarations are put at the right binding level. Cleaning up the
+ temporary should be the very last thing done, so we add the code to
+ a new block and add it to se->post as last instructions. */
size = gfc_create_var (gfc_array_index_type, NULL);
data = gfc_create_var (pvoid_type_node, NULL);
gfc_start_block (&block);
+ gfc_init_block (&temp_post);
tmp = gfc_typenode_for_spec (&e->ts);
- tmp = gfc_trans_create_temp_array (&se->pre, &se->post,
- &tmp_loop, info, tmp,
- false, true, false,
- & arg->expr->where);
+ tmp = gfc_trans_create_temp_array (&se->pre, &temp_post,
+ &tmp_loop, info, tmp,
+ initial,
+ false, true, false,
+ &arg->expr->where);
gfc_add_modify (&se->pre, size, tmp);
tmp = fold_convert (pvoid_type_node, info->data);
gfc_add_modify (&se->pre, data, tmp);
gfc_merge_block_scope (&block);
- /* Obtain the argument descriptor for unpacking. */
- gfc_init_se (&parmse, NULL);
- parmse.want_pointer = 1;
- gfc_conv_expr_descriptor (&parmse, e, gfc_walk_expr (e));
- gfc_add_block_to_block (&se->pre, &parmse.pre);
-
/* Calculate the offset for the temporary. */
offset = gfc_index_zero_node;
for (n = 0; n < info->dimen; n++)
@@ -296,11 +310,16 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
info->offset = gfc_create_var (gfc_array_index_type, NULL);
gfc_add_modify (&se->pre, info->offset, offset);
+
/* Copy the result back using unpack. */
tmp = build_call_expr (gfor_fndecl_in_unpack, 2, parmse.expr, data);
gfc_add_expr_to_block (&se->post, tmp);
+ /* XXX: This is possibly not needed; but isn't it cleaner this way? */
+ gfc_add_block_to_block (&se->pre, &parmse.pre);
+
gfc_add_block_to_block (&se->post, &parmse.post);
+ gfc_add_block_to_block (&se->post, &temp_post);
}
}
}
@@ -367,7 +386,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check)
gfc_se loopse;
/* gfc_walk_elemental_function_args renders the ss chain in the
- reverse order to the actual argument order. */
+ reverse order to the actual argument order. */
ss = gfc_reverse_ss (ss);
/* Initialize the loop. */
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index b8f0d2dd35b..628c2a08346 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1102,7 +1102,15 @@ gfc_trans_code (gfc_code * code)
break;
case EXEC_CALL:
- res = gfc_trans_call (code, false);
+ /* For MVBITS we've got the special exception that we need a
+ dependency check, too. */
+ {
+ bool is_mvbits = false;
+ if (code->resolved_isym
+ && code->resolved_isym->id == GFC_ISYM_MVBITS)
+ is_mvbits = true;
+ res = gfc_trans_call (code, is_mvbits);
+ }
break;
case EXEC_ASSIGN_CALL:
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index b3a0368160f..23d61ea04d9 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -464,6 +464,9 @@ tree gfc_call_free (tree);
/* Allocate memory after performing a few checks. */
tree gfc_call_malloc (stmtblock_t *, tree, tree);
+/* Build a memcpy call. */
+tree gfc_build_memcpy_call (tree, tree, tree);
+
/* Allocate memory for arrays, with optional status variable. */
tree gfc_allocate_array_with_status (stmtblock_t*, tree, tree, tree, gfc_expr*);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b1ee98871d0..bd150932b10 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-11-01 Daniel Kraft <d@domob.eu>
+
+ PR fortran/35681
+ * gfortran.dg/mvbits_4.f90: New test.
+
2008-11-01 Janus Weil <janus@gcc.gnu.org>
PR fortran/36322
diff --git a/gcc/testsuite/gfortran.dg/mvbits_4.f90 b/gcc/testsuite/gfortran.dg/mvbits_4.f90
new file mode 100644
index 00000000000..b8d32140c78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mvbits_4.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+
+! PR fortran/35681
+! Check that dependencies of MVBITS arguments are resolved correctly by using
+! temporaries if both arguments refer to the same variable.
+
+ integer, dimension(10) :: ila1 = (/1,2,3,4,5,6,7,8,9,10/)
+ integer, dimension(20) :: ila2
+ integer, dimension(10), target :: ila3
+ integer, pointer :: ila3_ptr(:)
+ integer, parameter :: SHOULD_BE(10) = (/17,18,11,4,13,22,7,16,9,18/)
+ integer, parameter :: INDEX_VECTOR(10) = (/9,9,6,2,4,9,2,9,6,10/)
+
+ ila2(2:20:2) = ila1
+ ila3 = ila1
+
+ ! Argument is already packed.
+ call mvbits (ila1(INDEX_VECTOR), 2, 4, ila1, 3)
+ write (*,'(10(I3))') ila1
+ if (any (ila1 /= SHOULD_BE)) call abort ()
+
+ ! Argument is not packed.
+ call mvbits (ila2(2*INDEX_VECTOR), 2, 4, ila2(2:20:2), 3)
+ write (*,'(10(I3))') ila2(2:20:2)
+ if (any (ila2(2:20:2) /= SHOULD_BE)) call abort ()
+
+ ! Pointer and target
+ ila3_ptr => ila3
+ call mvbits (ila3(INDEX_VECTOR), 2, 4, ila3_ptr, 3)
+ write (*,'(10(I3))') ila3
+ if (any (ila3 /= SHOULD_BE)) call abort ()
+
+ end
View Lorry Controller Status