C++ Ada inherited tail padding

--  { dg-do compile }
--  { dg-require-effective-target lp64 }

procedure Cpp_Tail_Padding is
   pragma Warnings (Off);

   type Tail_Base is tagged limited record
      Value : Integer;
   end record
   with Import => True,
        Convention => CPP;

   for Tail_Base'Size use 96;
   for Tail_Base'Object_Size use 128;
   for Tail_Base use record
      Value at 8 range 0 .. 31;
   end record;

   type Tail_Derived is limited new Tail_Base with record
      Extra : Integer;
   end record
   with Import => True,
        Convention => CPP;

   for Tail_Derived'Size use 128;
   for Tail_Derived'Object_Size use 128;
   for Tail_Derived use record
      Extra at 12 range 0 .. 31;
   end record;
begin
   null;
end Cpp_Tail_Padding;

/* { dg-do compile } */
/* { dg-require-effective-target lp64 } */
/* { dg-options "-fdump-ada-spec-slim" } */
/* { dg-final { scan-file inherited_tail_padding_c.ads "for Tail_Base'Size use 96;" } } */
/* { dg-final { scan-file inherited_tail_padding_c.ads "for Tail_Base'Object_Size use 128;" } } */
/* { dg-final { scan-file inherited_tail_padding_c.ads "value_u at 8 range 0 .. 31;" } } */
/* { dg-final { scan-file inherited_tail_padding_c.ads "extra_u at 12 range 0 .. 31;" } } */
/* { dg-final { scan-file inherited_tail_padding_c.ads "for Plain_Base'Size use 24;" } } */
/* { dg-final { scan-file inherited_tail_padding_c.ads "derived_char at 3 range 0 .. 7;" } } */
/* { dg-final { scan-file inherited_tail_padding_c.ads "extra at 7 range 0 .. 7;" } } */

class Tail_Base
{
public:
  Tail_Base (int value);
  virtual ~Tail_Base ();
  int value () const { return value_; }

protected:
  int value_;
};

class Tail_Derived : public Tail_Base
{
public:
  Tail_Derived (int value, int extra);
  ~Tail_Derived () override;
  int extra () const { return extra_; }

private:
  int extra_;
};

Tail_Base::Tail_Base (int value) : value_ (value) {}
Tail_Base::~Tail_Base () = default;
Tail_Derived::Tail_Derived (int value, int extra)
  : Tail_Base (value), extra_ (extra) {}
Tail_Derived::~Tail_Derived () = default;

extern "C" unsigned long
cpp_base_size ()
{
  return sizeof (Tail_Base);
}

extern "C" unsigned long
cpp_derived_size ()
{
  return sizeof (Tail_Derived);
}

extern "C" int
cpp_value (const Tail_Derived *object)
{
  return object->value ();
}

extern "C" int
cpp_extra (const Tail_Derived *object)
{
  return object->extra ();
}

struct Plain_Base
{
  short base_short;
  char base_char;
  Plain_Base () : base_short (1), base_char (2) {}
};

struct Plain_Derived : Plain_Base
{
  char derived_char;
  Plain_Derived () : derived_char (3) {}
};

struct Plain_Left
{
  short left_short;
  char left_char;
  Plain_Left () : left_short (4), left_char (5) {}
};

struct Plain_Right
{
  short right_short;
  char right_char;
  Plain_Right () : right_short (6), right_char (7) {}
};

struct Plain_Both : Plain_Left, Plain_Right
{
  char extra;
  Plain_Both () : extra (8) {}
};

extern "C" Plain_Derived *cpp_plain_create () { return new Plain_Derived; }
extern "C" void cpp_plain_delete (Plain_Derived *p) { delete p; }
extern "C" unsigned long cpp_plain_size () { return sizeof (Plain_Derived); }
extern "C" int cpp_plain_values (const Plain_Derived *p)
{
  return p->base_short + p->base_char + p->derived_char;
}

extern "C" Plain_Both *cpp_both_create () { return new Plain_Both; }
extern "C" void cpp_both_delete (Plain_Both *p) { delete p; }
extern "C" unsigned long cpp_both_plain_size () { return sizeof (Plain_Both); }
extern "C" int cpp_both_values (const Plain_Both *p)
{
  return p->left_short + p->left_char + p->right_short
    + p->right_char + p->extra;
}

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

with Ada.Text_IO;
with Inherited_Tail_Padding_C;
with Interfaces.C; use Interfaces.C;
with System;

procedure Inherited_Tail_Padding_Consumer is
   package Bindings renames Inherited_Tail_Padding_C;

   Object : aliased Bindings.Class_Tail_Derived.Tail_Derived :=
     Bindings.Class_Tail_Derived.New_Tail_Derived (31, 47);
   Ada_Base_Bytes : constant unsigned_long :=
     unsigned_long
       (Bindings.Class_Tail_Base.Tail_Base'Object_Size /
        System.Storage_Unit);
   Ada_Derived_Bytes : constant unsigned_long :=
     unsigned_long
       (Bindings.Class_Tail_Derived.Tail_Derived'Object_Size /
        System.Storage_Unit);
   Plain : access Bindings.Class_Plain_Derived.Plain_Derived :=
     Bindings.cpp_plain_create;
   Both : access Bindings.Class_Plain_Both.Plain_Both :=
     Bindings.cpp_both_create;
begin
   Object.parent.value_u := 211;
   Object.extra_u := 307;

   if Ada_Base_Bytes = Bindings.cpp_base_size
     and then Ada_Derived_Bytes = Bindings.cpp_derived_size
     and then Bindings.cpp_value (Object'Access) = 211
     and then Bindings.cpp_extra (Object'Access) = 307
     and then unsigned_long
       (Bindings.Class_Plain_Derived.Plain_Derived'Object_Size /
        System.Storage_Unit) = Bindings.cpp_plain_size
     and then unsigned_long
       (Bindings.Class_Plain_Both.Plain_Both'Object_Size /
        System.Storage_Unit) = Bindings.cpp_both_plain_size
   then
      Plain.parent.base_short := 11;
      Plain.parent.base_char := Interfaces.C.char'Val (13);
      Plain.derived_char := Interfaces.C.char'Val (17);
      Both.parent.left_short := 19;
      Both.parent.left_char := Interfaces.C.char'Val (23);
      Both.field_2.right_short := 29;
      Both.field_2.right_char := Interfaces.C.char'Val (31);
      Both.extra := Interfaces.C.char'Val (37);

      if Bindings.cpp_plain_values (Plain) /= 41
        or else Bindings.cpp_both_values (Both) /= 139
      then
         raise Program_Error with "non-polymorphic tail padding mismatch";
      end if;

      Ada.Text_IO.Put_Line ("MATCH C++ Ada inherited tail padding");
   else
      Ada.Text_IO.Put_Line ("MISMATCH C++ Ada inherited tail padding");
   end if;

   Bindings.cpp_plain_delete (Plain);
   Bindings.cpp_both_delete (Both);
end Inherited_Tail_Padding_Consumer;

with Ada.Text_IO;
with Inherited_Tail_Padding_C;
with Interfaces.C; use Interfaces.C;
with System;

procedure Inherited_Tail_Padding_Consumer is
   package Bindings renames Inherited_Tail_Padding_C;

   Object : aliased Bindings.Class_Tail_Derived.Tail_Derived :=
     Bindings.Class_Tail_Derived.New_Tail_Derived (31, 47);
   Ada_Base_Bytes : constant unsigned_long :=
     unsigned_long
       (Bindings.Class_Tail_Base.Tail_Base'Object_Size /
        System.Storage_Unit);
   Ada_Derived_Bytes : constant unsigned_long :=
     unsigned_long
       (Bindings.Class_Tail_Derived.Tail_Derived'Object_Size /
        System.Storage_Unit);
begin
   Object.value_u := 211;
   Object.extra_u := 307;

   if Ada_Base_Bytes = Bindings.cpp_base_size
     and then Ada_Derived_Bytes = Bindings.cpp_derived_size
     and then Bindings.cpp_value (Object'Access) = 211
     and then Bindings.cpp_extra (Object'Access) = 307
   then
      Ada.Text_IO.Put_Line ("MATCH C++ Ada inherited tail padding");
   else
      Ada.Text_IO.Put_Line ("MISMATCH C++ Ada inherited tail padding");
   end if;
end Inherited_Tail_Padding_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-inherited-tail-padding/tests/inherited-tail-padding.C"
if [[ "$state" == unpatched ]]; then
  ada_fixture="$root/bundles/cxx-ada-inherited-tail-padding/tests/inherited_tail_padding_unpatched_consumer.adb"
else
  ada_fixture="$root/bundles/cxx-ada-inherited-tail-padding/tests/inherited_tail_padding_consumer.adb"
fi
work=$(mktemp -d "${TMPDIR:-/tmp}/gnat-cxx-ada-tail-padding.XXXXXX")
trap 'rm -rf "$work"' EXIT

for optimization in 0 2; do
  case_dir="$work/O$optimization"
  mkdir -p "$case_dir"
  cp "$cxx_fixture" "$case_dir/"
  cp "$ada_fixture" "$case_dir/inherited_tail_padding_consumer.adb"
  (
    cd "$case_dir"
    "${REGRESSION_ENV[@]}" "$gxx" -c "-O$optimization" \
      -fdump-ada-spec-slim inherited-tail-padding.C
    "${REGRESSION_ENV[@]}" "$REGRESSION_GNATMAKE" -q -f \
      "-O$optimization" inherited_tail_padding_consumer.adb \
      -largs inherited-tail-padding.o -lstdc++
    "${REGRESSION_ENV[@]}" ./inherited_tail_padding_consumer
  ) >"$case_dir/output.log" 2>&1 || {
    cat "$case_dir/output.log"
    exit 1
  }

  spec="$case_dir/inherited_tail_padding_c.ads"
  if [[ "$state" == unpatched ]]; then
    grep -F "MISMATCH C++ Ada inherited tail padding" "$case_dir/output.log"
    if grep -Fq "for Tail_Base'Size use" "$spec"; then
      echo "error: unpatched mapper unexpectedly emitted tail-padding layout" >&2
      exit 1
    fi
    echo "cxx-ada-inherited-tail-padding -O$optimization: expected mismatch (GCC $version)"
    continue
  fi

  grep -F "for Tail_Base'Size use" "$spec"
  grep -F "for Tail_Base'Object_Size use" "$spec"
  grep -F "value_u at" "$spec"
  grep -F "extra_u at" "$spec"
  grep -F "for Plain_Base'Size use 24;" "$spec"
  grep -F "derived_char at 3 range 0 .. 7;" "$spec"
  grep -F "extra at 7 range 0 .. 7;" "$spec"
  grep -F "MATCH C++ Ada inherited tail padding" "$case_dir/output.log"
  echo "cxx-ada-inherited-tail-padding -O$optimization: patched (GCC $version)"
done