1 #include <stdlib.h>
2 #include <stdio.h>
3
4 #include <ISO_Fortran_binding.h>
5 #include "dump-descriptors.h"
6
7 extern void ctest (int imagic, int jmagic);
8 extern void ftest (CFI_cdesc_t *a, CFI_cdesc_t *b, int initp);
9
10 struct m {
11 int i;
12 int j;
13 };
14
15 void
ctest(int imagic,int jmagic)16 ctest (int imagic, int jmagic)
17 {
18 CFI_CDESC_T(0) adesc;
19 CFI_CDESC_T(0) bdesc;
20 CFI_cdesc_t *a = (CFI_cdesc_t *) &adesc;
21 CFI_cdesc_t *b = (CFI_cdesc_t *) &bdesc;
22 struct m* mp;
23
24 /* Create the descriptor for a, then sanity-check it. */
25 check_CFI_status ("CFI_establish",
26 CFI_establish (a, NULL, CFI_attribute_allocatable,
27 CFI_type_struct,
28 sizeof (struct m), 0, NULL));
29 dump_CFI_cdesc_t (a);
30 if (a->version != CFI_VERSION)
31 abort ();
32 if (a->rank != 0)
33 abort ();
34 if (a->attribute != CFI_attribute_allocatable)
35 abort ();
36 if (a->base_addr)
37 abort ();
38 if (a->elem_len != sizeof (struct m))
39 abort ();
40
41 /* Likewise for b. */
42 check_CFI_status ("CFI_establish",
43 CFI_establish (b, NULL, CFI_attribute_pointer,
44 CFI_type_struct,
45 sizeof (struct m), 0, NULL));
46 dump_CFI_cdesc_t (b);
47 if (b->version != CFI_VERSION)
48 abort ();
49 if (b->rank != 0)
50 abort ();
51 if (b->attribute != CFI_attribute_pointer)
52 abort ();
53 if (b->base_addr)
54 abort ();
55 if (b->elem_len != sizeof (struct m))
56 abort ();
57
58 /* Call back into Fortran, passing the unallocated descriptors. */
59 ftest (a, b, 0);
60
61 /* Allocate and initialize both variables, and try again. */
62 check_CFI_status ("CFI_allocate",
63 CFI_allocate (a, NULL, NULL, 0));
64 dump_CFI_cdesc_t (a);
65 if (!a->base_addr)
66 abort ();
67 if (a->elem_len != sizeof (struct m))
68 abort ();
69 ((struct m *)a->base_addr)->i = imagic;
70 ((struct m *)a->base_addr)->j = jmagic;
71
72 check_CFI_status ("CFI_allocate",
73 CFI_allocate (b, NULL, NULL, 0));
74 dump_CFI_cdesc_t (b);
75 if (!b->base_addr)
76 abort ();
77 if (b->elem_len != sizeof (struct m))
78 abort ();
79 ((struct m *)b->base_addr)->i = imagic + 1;
80 ((struct m *)b->base_addr)->j = jmagic + 1;
81
82 ftest (a, b, 1);
83
84 /* Deallocate both objects and try again. */
85 check_CFI_status ("CFI_deallocate", CFI_deallocate (a));
86 if (a->base_addr)
87 abort ();
88 check_CFI_status ("CFI_deallocate", CFI_deallocate (b));
89 if (b->base_addr)
90 abort ();
91 ftest (a, b, 0);
92 }
93