aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/c-interop/allocatable-dummy-c.c
blob: 0ed09b5043fcd96c4d7ed674766e782a1514cfa3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
#include <stdlib.h>
#include <stddef.h>
#include <stdio.h>

#include <ISO_Fortran_binding.h>
#include "dump-descriptors.h"

struct t {
  float xyz[3];
  int id;
};

extern void testit_f_bind_c (CFI_cdesc_t *a, float x, float y, float z);
extern void testit_c (CFI_cdesc_t *a, float x, float y, float z);

void testit_c (CFI_cdesc_t *a, float x, float y, float z)
{
  struct t *tp;

  /* Check that the allocatable dummy is unallocated on entry and do
     some other sanity checks.  */
  dump_CFI_cdesc_t (a);
  if (a->attribute != CFI_attribute_allocatable)
    abort ();
  if (a->rank)
    abort ();
  if (a->base_addr)
    abort ();

  /* Allocate and initialize the output argument.  */
  CFI_allocate (a, NULL, NULL, 0);
  if (!a->base_addr)
    abort ();
  tp = (struct t *) CFI_address (a, NULL);
  tp->id = 42;
  tp->xyz[0] = 0.0;
  tp->xyz[1] = 0.0;
  tp->xyz[2] = 0.0;

  /* Now call the Fortran function, which is supposed to automatically
     deallocate the object we just created above and point the descriptor
     at a different object.  */
  testit_f_bind_c (a, x, y, z);

  /* Make sure we've got an allocated object, initialized as we
     expect.  */
  if (!a->base_addr)
    abort ();
  tp = (struct t *) CFI_address (a, NULL);
  if (tp->id != -1)
    abort ();
  if (tp->xyz[0] != x || tp->xyz[1] != y || tp->xyz[2] != z)
    abort ();
}