C++ Ada machine vector types

/* { dg-do compile } */
/* { dg-options "-fdump-ada-spec-slim" } */
/* { dg-final { scan-file vector_types_c.ads "type Int_Vector is array \(0 .. 3\) of int;" } } */
/* { dg-final { scan-file vector_types_c.ads "for Int_Vector'Alignment use 16;" } } */
/* { dg-final { scan-file vector_types_c.ads "pragma Machine_Attribute \(Int_Vector, \"vector_type\"\);" } } */
/* { dg-final { scan-file vector_types_c.ads "type Double_Vector is array \(0 .. 1\) of double;" } } */
/* { dg-final { scan-file-times vector_types_c.ads "Convention => Ada" 3 } } */
/* { dg-final { scan-file vector_types_c.ads "function cpp_transform_vector" } } */
/* { dg-final { scan-file vector_types_c.ads "function transform" } } */

typedef int Int_Vector __attribute__((vector_size(16)));
typedef double Double_Vector __attribute__((vector_size(16)));

Int_Vector
vector_identity (Int_Vector value)
{
  return value;
}

Double_Vector
double_vector_identity (Double_Vector value)
{
  return value;
}

class Vector_Object
{
public:
  virtual ~Vector_Object () = default;
  virtual Int_Vector transform (Int_Vector value) { return value; }
};

extern "C" Vector_Object *create_vector_object ()
{
  return new Vector_Object;
}

extern "C" void delete_vector_object (Vector_Object *object)
{
  delete object;
}

extern "C" Int_Vector
cpp_transform_vector (Vector_Object *object, Int_Vector value)
{
  return object->transform (value);
}

/* { dg-final { cleanup-ada-spec } } */

with Interfaces.C; use Interfaces.C;
with Vector_Types_C;

procedure Vector_Types_Consumer is
   package Bindings renames Vector_Types_C;
   use type Bindings.Int_Vector;
   use type Bindings.Double_Vector;

   Int_Input : constant Bindings.Int_Vector := (1, -2, 3, -4);
   Double_Input : constant Bindings.Double_Vector := (1.25, -2.5);
   Object : access Bindings.Class_Vector_Object.Vector_Object :=
     Bindings.create_vector_object;
   Int_Free_Result : constant Bindings.Int_Vector :=
     Bindings.vector_identity (Int_Input);
   Double_Free_Result : constant Bindings.Double_Vector :=
     Bindings.double_vector_identity (Double_Input);
   Wrapper_Result : constant Bindings.Int_Vector :=
     Bindings.cpp_transform_vector (Object, Int_Input);
begin
   if Int_Free_Result /= Int_Input then
      raise Program_Error with "free integer vector ABI mismatch";
   elsif Double_Free_Result /= Double_Input then
      raise Program_Error with "free double vector ABI mismatch";
   elsif Wrapper_Result /= Int_Input then
      raise Program_Error with "C wrapper vector ABI mismatch";
   end if;

   Bindings.delete_vector_object (Object);
end Vector_Types_Consumer;

#!/usr/bin/env bash
set -euo pipefail

if [[ $# -ne 3 ]]; then
  echo "usage: $0 TOOLCHAIN_ROOT GCC_VERSION unpatched|patched" >&2
  exit 2
fi

root=$(cd "$(dirname "${BASH_SOURCE[0]}")/../.." && pwd)
source "$root/scripts/regression-common.sh"
resolve_regression_toolchain "$1"
version=$2
state=$3
[[ "$state" == unpatched || "$state" == patched ]] || {
  echo "error: state must be unpatched or patched" >&2
  exit 2
}

gxx="$REGRESSION_TOOLCHAIN/bin/g++"
[[ -x "$gxx" ]] || {
  echo "error: no g++ in $REGRESSION_TOOLCHAIN" >&2
  exit 1
}

cxx_fixture="$root/bundles/cxx-ada-vector-types/tests/vector-types.C"
ada_fixture="$root/bundles/cxx-ada-vector-types/tests/vector_types_consumer.adb"
work=$(mktemp -d "${TMPDIR:-/tmp}/gnat-cxx-ada-vector-types.XXXXXX")
trap 'rm -rf "$work"' EXIT

for optimization in 0 2; do
  case_dir="$work/O$optimization"
  mkdir -p "$case_dir"
  cp "$cxx_fixture" "$ada_fixture" "$case_dir/"
  (
    cd "$case_dir"
    "${REGRESSION_ENV[@]}" "$gxx" -c "-O$optimization" \
      -fdump-ada-spec-slim vector-types.C
  )

  spec="$case_dir/vector_types_c.ads"
  [[ -f "$spec" ]] || {
    echo "error: g++ did not generate $spec" >&2
    exit 1
  }

  set +e
  (
    cd "$case_dir"
    "${REGRESSION_ENV[@]}" "$REGRESSION_GNATMAKE" -q -f \
      "-O$optimization" vector_types_consumer.adb \
      -largs vector-types.o -lstdc++
    "${REGRESSION_ENV[@]}" ./vector_types_consumer
  ) >"$case_dir/run.log" 2>&1
  run_status=$?
  set -e

  if [[ "$state" == unpatched ]]; then
    [[ $run_status -ne 0 ]] || {
      echo "error: unpatched vector regression unexpectedly passed" >&2
      exit 1
    }
    grep -Eiq 'subtype indication expected|identifier expected' \
      "$case_dir/run.log" || {
      cat "$case_dir/run.log"
      exit 1
    }
    echo "cxx-ada-vector-types -O$optimization: expected invalid Ada (GCC $version)"
    continue
  fi

  [[ $run_status -eq 0 ]] || {
    cat "$case_dir/run.log"
    exit 1
  }
  grep -Eq 'type Int_Vector is array \(0 \.\. 3\) of int;' "$spec"
  grep -Eq 'type Double_Vector is array \(0 \.\. 1\) of double;' "$spec"
  grep -Eq 'pragma Machine_Attribute \(Int_Vector, "vector_type"\);' "$spec"
  [[ $(grep -Fc 'Convention => Ada' "$spec") -eq 3 ]]
  grep -Eq 'function transform' "$spec"
  echo "cxx-ada-vector-types -O$optimization: patched (GCC $version)"
done