OSDN Git Service

78bf0ef04afb79f3db5782924bf94afebebd1938
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / c_by_val.c
1 /*  Passing from fortran to C by value, using %VAL.  */
2
3 #include <inttypes.h>
4
5 typedef struct { float r, i; } complex;
6 typedef struct { double r, i; } complex8;
7 extern void f_to_f__ (float*, float, float*, float**);
8 extern void f_to_f8__ (double*, double, double*, double**);
9 extern void i_to_i__ (int*, int, int*, int**);
10 extern void i_to_i8__ (int64_t*, int64_t, int64_t*, int64_t**);
11 extern void c_to_c__ (complex*, complex, complex*, complex**);
12 extern void c_to_c8__ (complex8*, complex8, complex8*, complex8**);
13 extern void abort (void);
14
15 void
16 f_to_f__(float *retval, float a1, float *a2, float **a3)
17 {
18   if ( a1 != *a2 ) abort();
19   if ( a1 != **a3 ) abort();
20   a1 = 0.0;
21   *retval = *a2 * 2.0;
22   return;
23 }
24
25 void
26 f_to_f8__(double *retval, double a1, double *a2, double **a3)
27 {
28   if ( a1 != *a2 ) abort();
29   if ( a1 != **a3 ) abort();
30   a1 = 0.0;
31   *retval = *a2 * 2.0;
32   return;
33 }
34
35 void
36 i_to_i__(int *retval, int i1, int *i2, int **i3)
37 {
38   if ( i1 != *i2 ) abort();
39   if ( i1 != **i3 ) abort();
40   i1 = 0;
41   *retval = *i2 * 3;
42   return;
43 }
44
45 void
46 i_to_i8__(int64_t *retval, int64_t i1, int64_t *i2, int64_t **i3)
47 {
48   if ( i1 != *i2 ) abort();
49   if ( i1 != **i3 ) abort();
50   i1 = 0;
51   *retval = *i2 * 3;
52   return;
53 }
54
55 void
56 c_to_c__(complex *retval, complex c1, complex *c2, complex **c3)
57 {
58   if ( c1.r != c2->r ) abort();
59   if ( c1.i != c2->i ) abort();
60   if ( c1.r != (*c3)->r ) abort();
61   if ( c1.i != (*c3)->i ) abort();
62   c1.r = 0.0;
63   c1.i = 0.0;
64   retval->r = c2->r * 4.0;
65   retval->i = c2->i * 4.0;
66   return;
67 }
68
69 void
70 c_to_c8__(complex8 *retval, complex8 c1, complex8 *c2, complex8 **c3)
71 {
72   if ( c1.r != c2->r ) abort();
73   if ( c1.i != c2->i ) abort();
74   if ( c1.r != (*c3)->r ) abort();
75   if ( c1.i != (*c3)->i ) abort();
76   c1.r = 0.0;
77   c1.i = 0.0;
78   retval->r = c2->r * 4.0;
79   retval->i = c2->i * 4.0;
80   return;
81 }