File: ISO_Fortran_binding_10.c

package info (click to toggle)
gcc-arm-none-eabi 15%3A14.2.rel1-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 1,099,328 kB
  • sloc: cpp: 3,627,108; ansic: 2,571,498; ada: 834,230; f90: 235,082; makefile: 79,231; asm: 74,984; xml: 51,692; exp: 39,736; sh: 33,298; objc: 15,629; python: 15,069; fortran: 14,429; pascal: 7,003; awk: 5,070; perl: 3,106; ml: 285; lisp: 253; lex: 204; haskell: 135
file content (73 lines) | stat: -rw-r--r-- 1,596 bytes parent folder | download | duplicates (2)
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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
/* Test the fix of PR89843.  */

/* Contributed by Reinhold Bader  <Bader@lrz.de> */

#include <ISO_Fortran_binding.h>
#include <stdlib.h>
#include <stdio.h>
#include <stdbool.h>

void sa(CFI_cdesc_t *, int, int *);

void si(CFI_cdesc_t *this, int flag, int *status)
{
  int value, sum;
  bool err;
  CFI_CDESC_T(1) that;
  CFI_index_t lb[] = { 0, 0 };
  CFI_index_t ub[] = { 4, 0 };
  CFI_index_t st[] = { 2, 0 };
  int chksum[] = { 9, 36, 38 };

  if (flag == 1)
    {
      lb[0] = 0; lb[1] = 2;
      ub[0] = 2; ub[1] = 2;
      st[0] = 1; st[1] = 0;
    }
  else if (flag == 2)
    {
      lb[0] = 1; lb[1] = 0;
      ub[0] = 1; ub[1] = 3;
      st[0] = 0; st[1] = 1;
    }

  CFI_establish((CFI_cdesc_t *) &that, NULL, CFI_attribute_other,
		CFI_type_float, 0, 1, NULL);

  *status = CFI_section((CFI_cdesc_t *) &that, this, lb, ub, st);

  if (*status != CFI_SUCCESS)
    {
      printf("FAIL C: status is %i\n",status);
      return;
    }

  value = CFI_is_contiguous((CFI_cdesc_t *) &that);
  err = ((flag == 0 && value != 0)
	 || (flag == 1 && value != 1)
	 || (flag == 2 && value != 0));

  if (err)
    {
      printf("FAIL C: contiguity for flag value %i - is %i\n", flag, value);
      *status = 10;
      return;
    }

  sum = 0;
  for (int i = 0; i < that.dim[0].extent; i++)
    {
      CFI_index_t idx[] = {i};
      sum += (int)(*(float *)CFI_address ((CFI_cdesc_t *)&that, idx));
    }

  if (sum != chksum[flag])
    {
      printf ("FAIL C: check sum = %d(%d)\n", sum, chksum[flag]);
      *status = 11;
      return;
    }

    sa((CFI_cdesc_t *) &that, flag, status);
}