Viewing file:  cf-descriptor-4-c.c (2.56 KB) -rw-r--r--
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
#include <stdlib.h>
#include <stdio.h>
#include <ISO_Fortran_binding.h>
#include "dump-descriptors.h"
extern void ctest (int imagic, int jmagic);
extern void ftest (CFI_cdesc_t *a, CFI_cdesc_t *b, int initp);
struct m {
int i;
int j;
};
void
ctest (int imax, int jmax)
{
CFI_CDESC_T(2) adesc;
CFI_CDESC_T(2) bdesc;
CFI_cdesc_t *a = (CFI_cdesc_t *) &adesc;
CFI_cdesc_t *b = (CFI_cdesc_t *) &bdesc;
struct m* mp;
CFI_index_t lower[2], upper[2], subscripts[2];
CFI_index_t i, j;
/* Create the descriptor for a, then sanity-check it. */
check_CFI_status ("CFI_establish",
CFI_establish (a, NULL, CFI_attribute_allocatable,
CFI_type_struct,
sizeof (struct m), 2, NULL));
dump_CFI_cdesc_t (a);
if (a->version != CFI_VERSION)
abort ();
if (a->rank != 2)
abort ();
if (a->attribute != CFI_attribute_allocatable)
abort ();
if (a->base_addr)
abort ();
if (a->elem_len != sizeof (struct m))
abort ();
/* Likewise for b. */
check_CFI_status ("CFI_establish",
CFI_establish (b, NULL, CFI_attribute_pointer,
CFI_type_struct,
sizeof (struct m), 2, NULL));
dump_CFI_cdesc_t (b);
if (b->version != CFI_VERSION)
abort ();
if (b->rank != 2)
abort ();
if (b->attribute != CFI_attribute_pointer)
abort ();
if (b->base_addr)
abort ();
if (b->elem_len != sizeof (struct m))
abort ();
/* Call back into Fortran, passing the unallocated descriptors. */
ftest (a, b, 0);
/* Allocate and initialize both variables, and try again. */
lower[0] = 1;
lower[1] = 1;
upper[0] = imax;
upper[1] = jmax;
check_CFI_status ("CFI_allocate",
CFI_allocate (a, lower, upper, 0));
dump_CFI_cdesc_t (a);
if (!a->base_addr)
abort ();
if (a->elem_len != sizeof (struct m))
abort ();
upper[0] = jmax;
upper[1] = imax;
check_CFI_status ("CFI_allocate",
CFI_allocate (b, lower, upper, 0));
dump_CFI_cdesc_t (b);
if (!b->base_addr)
abort ();
if (b->elem_len != sizeof (struct m))
abort ();
for (i = 1; i <= imax; i++)
for (j = 1; j <= jmax; j++)
{
subscripts[0] = i;
subscripts[1] = j;
mp = (struct m *) CFI_address (a, subscripts);
mp->i = i;
mp->j = j;
subscripts[0] = j;
subscripts[1] = i;
mp = (struct m *) CFI_address (b, subscripts);
mp->i = i;
mp->j = j;
}
ftest (a, b, 1);
/* Deallocate both objects and try again. */
check_CFI_status ("CFI_deallocate", CFI_deallocate (a));
if (a->base_addr)
abort ();
check_CFI_status ("CFI_deallocate", CFI_deallocate (b));
if (b->base_addr)
abort ();
ftest (a, b, 0);
}
|
