The second of two commits to import the gfortran test suite.

This contains the test files themselves. They have been imported without
modification from the gcc repository: https://github.com/gcc-mirror/gcc.
The files are current as of this commit in GCC:

0d94c6df183375caaa7f672e288a2094ca813749

Author: tarunprabhu

Fortran/gfortran/regression/20181025-1.f

@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-options "-Ofast" }
+! { dg-additional-options "-mavx2" { target { x86_64-*-* i?86-*-* } } }
+      SUBROUTINE FOO(EF3,CA,ZA,NATA,IC4,NFRGPT)
+      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+      PARAMETER (MXATM=500)
+      COMMON DE(3,MXATM)
+      DIMENSION CA(3,NATA)
+      DIMENSION ZA(NATA)
+      DIMENSION EF3(3,NFRGPT)
+      DO II = 1,NATA
+         XII = XJ - CA(1,II)
+         YII = YJ - CA(2,II)
+         ZII = ZJ - CA(3,II)
+         RJII = SQRT(XII*XII + YII*YII + ZII*ZII)
+         R3 = RJII*RJII*RJII
+         IF (IC4.EQ.0) THEN
+            DE(1,II) = DE(1,II) - S2*ZA(II)*XII/R3
+            DE(2,II) = DE(2,II) - S2*ZA(II)*YII/R3
+            DE(3,II) = DE(3,II) - S2*ZA(II)*ZII/R3
+         ELSE 
+            EF3(1,IC4+II) = EF3(1,IC4+II) - S2*ZA(II)*XII/R3
+            EF3(2,IC4+II) = EF3(2,IC4+II) - S2*ZA(II)*YII/R3
+            EF3(3,IC4+II) = EF3(3,IC4+II) - S2*ZA(II)*ZII/R3
+         END IF
+      END DO
+      RETURN
+      END           

Fortran/gfortran/regression/ISO_Fortran_binding_1.c

@@ -0,0 +1,232 @@
+/* Test F2008 18.5: ISO_Fortran_binding.h functions.  */
+
+#include <ISO_Fortran_binding.h>
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <complex.h>
+
+/* Test the example in F2008 C.12.9: Processing assumed-shape arrays in C,
+   modified to use CFI_address instead of pointer arithmetic.  */
+
+int elemental_mult_c(CFI_cdesc_t * a_desc, CFI_cdesc_t * b_desc,
+		     CFI_cdesc_t * c_desc)
+{
+  CFI_index_t idx[2];
+  int *res_addr;
+  int err = 1; /* this error code represents all errors */
+
+  if (a_desc->rank == 0)
+    {
+      err = *(int*)a_desc->base_addr;
+      *(int*)a_desc->base_addr = 0;
+      return err;
+    }
+
+  if (a_desc->type != CFI_type_int
+      || b_desc->type != CFI_type_int
+      || c_desc->type != CFI_type_int)
+    return err;
+
+  /* Only support two dimensions. */
+  if (a_desc->rank != 2
+      || b_desc->rank != 2
+      || c_desc->rank != 2)
+    return err;
+
+  if (a_desc->attribute == CFI_attribute_other)
+    {
+      assert (a_desc->dim[0].lower_bound == 0);
+      assert (a_desc->dim[1].lower_bound == 0);
+      for (idx[0] = 0; idx[0] < a_desc->dim[0].extent; idx[0]++)
+	for (idx[1] = 0; idx[1] < a_desc->dim[1].extent; idx[1]++)
+	  {
+	    res_addr = CFI_address (a_desc, idx);
+	    *res_addr = *(int*)CFI_address (b_desc, idx)
+			* *(int*)CFI_address (c_desc, idx);
+	  }
+    }
+  else
+    {
+      assert (a_desc->attribute == CFI_attribute_allocatable
+	      || a_desc->attribute == CFI_attribute_pointer);
+      for (idx[0] = a_desc->dim[0].lower_bound;
+	   idx[0] < a_desc->dim[0].extent + a_desc->dim[0].lower_bound;
+	   idx[0]++)
+	for (idx[1] = a_desc->dim[1].lower_bound;
+	     idx[1] < a_desc->dim[1].extent + a_desc->dim[1].lower_bound;
+	     idx[1]++)
+	  {
+	    res_addr = CFI_address (a_desc, idx);
+	    *res_addr = *(int*)CFI_address (b_desc, idx)
+			* *(int*)CFI_address (c_desc, idx);
+	  }
+    }
+
+  return 0;
+}
+
+
+int deallocate_c(CFI_cdesc_t * dd)
+{
+  return CFI_deallocate(dd);
+}
+
+
+int allocate_c(CFI_cdesc_t * da, CFI_index_t lower[], CFI_index_t upper[])
+{
+  int err = 1;
+  CFI_index_t idx[2];
+  int *res_addr;
+
+  if (da->attribute == CFI_attribute_other) return err;
+  if (CFI_allocate(da, lower, upper, 0)) return err;
+  assert (da->dim[0].lower_bound == lower[0]);
+  assert (da->dim[1].lower_bound == lower[1]);
+
+  for (idx[0] = lower[0]; idx[0] < da->dim[0].extent + lower[0]; idx[0]++)
+    for (idx[1] = lower[1]; idx[1] < da->dim[1].extent + lower[1]; idx[1]++)
+      {
+	res_addr = CFI_address (da, idx);
+	*res_addr = (int)(idx[0] * idx[1]);
+      }
+
+  return 0;
+}
+
+int establish_c(CFI_cdesc_t * desc)
+{
+  typedef struct {double x; double _Complex y;} t;
+  int err;
+  CFI_index_t idx[1], extent[1];
+  t *res_addr;
+  double value = 1.0;
+  double complex z_value = 0.0 + 2.0 * I;
+
+  extent[0] = 10;
+  err = CFI_establish((CFI_cdesc_t *)desc,
+		      malloc ((size_t)(extent[0] * sizeof(t))),
+		      CFI_attribute_pointer,
+		      CFI_type_struct,
+		      sizeof(t), 1, extent);
+  assert (desc->dim[0].lower_bound == 0);
+  for (idx[0] = 0; idx[0] < extent[0]; idx[0]++)
+    {
+      res_addr = (t*)CFI_address (desc, idx);
+      res_addr->x = value++;
+      res_addr->y = z_value * (idx[0] + 1);
+    }
+  return err;
+}
+
+int contiguous_c(CFI_cdesc_t * desc)
+{
+  return CFI_is_contiguous(desc);
+}
+
+float section_c(int *std_case, CFI_cdesc_t * source, int *low, int *str)
+{
+  CFI_index_t idx[CFI_MAX_RANK], lower[CFI_MAX_RANK],
+		  strides[CFI_MAX_RANK], upper[CFI_MAX_RANK];
+  CFI_CDESC_T(1) section;
+  int ind;
+  float *ret_addr;
+  float ans = 0.0;
+
+  /* Case (i) from F2018:18.5.5.7. */
+  if (*std_case == 1)
+    {
+      lower[0] = (CFI_index_t)low[0];
+      strides[0] = (CFI_index_t)str[0];
+      ind = CFI_establish((CFI_cdesc_t *)&section, NULL, CFI_attribute_other,
+			  CFI_type_float, 0, 1, NULL);
+      if (ind) return -1.0;
+      ind = CFI_section((CFI_cdesc_t *)&section, source, lower, NULL, strides);
+      if (ind) return -2.0;
+
+      /* Sum over the section  */
+      for (idx[0] = section.dim[0].lower_bound;
+	   idx[0] < section.dim[0].extent + section.dim[0].lower_bound;
+	   idx[0]++)
+        ans += *(float*)CFI_address ((CFI_cdesc_t*)&section, idx);
+      return ans;
+    }
+  else if (*std_case == 2)
+    {
+      int ind;
+      lower[0] = source->dim[0].lower_bound;
+      upper[0] = source->dim[0].lower_bound + source->dim[0].extent - 1;
+      strides[0] = str[0];
+      lower[1] = upper[1] = source->dim[1].lower_bound + low[1] - 1;
+      strides[1] = 0;
+      ind = CFI_establish((CFI_cdesc_t *)&section, NULL, CFI_attribute_other,
+			  CFI_type_float, 0, 1, NULL);
+      if (ind) return -1.0;
+      ind = CFI_section((CFI_cdesc_t *)&section, source,
+			lower, upper, strides);
+      assert (section.rank == 1);
+      if (ind) return -2.0;
+
+      /* Sum over the section  */
+      for (idx[0] = section.dim[0].lower_bound;
+	   idx[0] < section.dim[0].extent + section.dim[0].lower_bound;
+	   idx[0]++)
+        ans += *(float*)CFI_address ((CFI_cdesc_t*)&section, idx);
+      return ans;
+    }
+
+  return 0.0;
+}
+
+
+double select_part_c (CFI_cdesc_t * source)
+{
+  typedef struct {
+    double x; double _Complex y;
+    } t;
+  CFI_CDESC_T(2) component;
+  CFI_cdesc_t * comp_cdesc = (CFI_cdesc_t *)&component;
+  CFI_index_t extent[] = {10,10};
+  CFI_index_t idx[] = {4,0};
+  double ans = 0.0;
+  int size;
+
+  (void)CFI_establish(comp_cdesc, NULL, CFI_attribute_other,
+		      CFI_type_double_Complex, sizeof(double _Complex),
+		      2, extent);
+  (void)CFI_select_part(comp_cdesc, source, offsetof(t,y), 0);
+  assert (comp_cdesc->dim[0].lower_bound == 0);
+  assert (comp_cdesc->dim[1].lower_bound == 0);
+
+  /* Sum over comp_cdesc[4,:]  */
+  size = comp_cdesc->dim[1].extent;
+  for (idx[1] = 0; idx[1] < size; idx[1]++)
+    ans += cimag (*(double _Complex*)CFI_address ((CFI_cdesc_t*)comp_cdesc,
+						  idx));
+  return ans;
+}
+
+
+int setpointer_c(CFI_cdesc_t * ptr, int lbounds[])
+{
+  CFI_index_t lower_bounds[] = {lbounds[0],lbounds[1]};
+  int ind;
+  ind = CFI_setpointer(ptr, ptr, lower_bounds);
+  return ind;
+}
+
+
+int assumed_size_c(CFI_cdesc_t * desc)
+{
+  int res;
+
+  res = CFI_is_contiguous(desc);
+  if (!res)
+    return 1;
+  if (desc->rank)
+    res = 2 * (desc->dim[desc->rank-1].extent
+				!= (CFI_index_t)(long long)(-1));
+  else
+    res = 3;
+  return res;
+}