* *
* C Implementation File *
* *
- * Copyright (C) 1992-2016, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2017, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
#include "fold-const.h"
#include "stor-layout.h"
#include "tree-inline.h"
+#include "demangle.h"
#include "ada.h"
#include "types.h"
bool
is_cplusplus_method (Entity_Id gnat_entity)
{
- /* Check that the subprogram has C++ convention. */
- if (Convention (gnat_entity) != Convention_CPP)
- return false;
-
/* A constructor is a method on the C++ side. We deal with it now because
it is declared without the 'this' parameter in the sources and, although
the front-end will create a version with the 'this' parameter for code
if (Is_Constructor (gnat_entity))
return true;
+ /* Check that the subprogram has C++ convention. */
+ if (Convention (gnat_entity) != Convention_CPP)
+ return false;
+
/* And that the type of the first parameter (indirectly) has it too. */
Entity_Id gnat_first = First_Formal (gnat_entity);
if (No (gnat_first))
if (Convention (gnat_type) != Convention_CPP)
return false;
- /* This is the main case: C++ method imported as a primitive operation.
- Note that a C++ class with no virtual functions can be imported as a
- limited record type so the operation is not necessarily dispatching. */
- if (Is_Primitive (gnat_entity))
+ /* This is the main case: a C++ virtual method imported as a primitive
+ operation of a tagged type. */
+ if (Is_Dispatching_Operation (gnat_entity))
+ return true;
+
+ /* This is set on the E_Subprogram_Type built for a dispatching call. */
+ if (Is_Dispatch_Table_Entity (gnat_entity))
return true;
/* A thunk needs to be handled like its associated primitive operation. */
if (Is_Subprogram (gnat_entity) && Is_Thunk (gnat_entity))
return true;
- /* This is set on the E_Subprogram_Type built for a dispatching call. */
- if (Is_Dispatch_Table_Entity (gnat_entity))
- return true;
+ /* Now on to the annoying case: a C++ non-virtual method, imported either
+ as a non-primitive operation of a tagged type or as a primitive operation
+ of an untagged type. We cannot reliably differentiate these cases from
+ their static member or regular function equivalents in Ada, so we ask
+ the C++ side through the mangled name of the function, as the implicit
+ 'this' parameter is not encoded in the mangled name of a method. */
+ if (Is_Subprogram (gnat_entity) && Present (Interface_Name (gnat_entity)))
+ {
+ String_Pointer sp = { NULL, NULL };
+ Get_External_Name (gnat_entity, false, sp);
+
+ void *mem;
+ struct demangle_component *cmp
+ = cplus_demangle_v3_components (Name_Buffer,
+ DMGL_GNU_V3
+ | DMGL_TYPES
+ | DMGL_PARAMS
+ | DMGL_RET_DROP,
+ &mem);
+ if (!cmp)
+ return false;
+
+ /* We need to release MEM once we have a successful demangling. */
+ bool ret = false;
+
+ if (cmp->type == DEMANGLE_COMPONENT_TYPED_NAME
+ && cmp->u.s_binary.right->type == DEMANGLE_COMPONENT_FUNCTION_TYPE
+ && (cmp = cmp->u.s_binary.right->u.s_binary.right) != NULL
+ && cmp->type == DEMANGLE_COMPONENT_ARGLIST)
+ {
+ /* Make sure there is at least one parameter in C++ too. */
+ if (cmp->u.s_binary.left)
+ {
+ unsigned int n_ada_args = 0;
+ do {
+ n_ada_args++;
+ gnat_first = Next_Formal (gnat_first);
+ } while (Present (gnat_first));
+
+ unsigned int n_cpp_args = 0;
+ do {
+ n_cpp_args++;
+ cmp = cmp->u.s_binary.right;
+ } while (cmp);
+
+ if (n_cpp_args < n_ada_args)
+ ret = true;
+ }
+ else
+ ret = true;
+ }
+
+ free (mem);
+
+ return ret;
+ }
return false;
}
dump_generic_ada_node (buffer, TREE_VALUE (arg), node, spc, 0, true);
}
- if (TREE_TYPE (arg) && TREE_TYPE (TREE_TYPE (arg))
- && is_tagged_type (TREE_TYPE (TREE_TYPE (arg))))
- {
- if (!is_method
- || (num != 1 || (!DECL_VINDEX (func) && !is_constructor)))
- pp_string (buffer, "'Class");
- }
+ /* If the type is a pointer to a tagged type, we need to differentiate
+ virtual methods from the rest (non-virtual methods, static member
+ or regular functions) and import only them as primitive operations,
+ because they make up the virtual table which is mirrored on the Ada
+ side by the dispatch table. So we add 'Class to the type of every
+ parameter that is not the first one of a method which either has a
+ slot in the virtual table or is a constructor. */
+ if (TREE_TYPE (arg)
+ && POINTER_TYPE_P (TREE_TYPE (arg))
+ && is_tagged_type (TREE_TYPE (TREE_TYPE (arg)))
+ && !(num == 1 && is_method && (DECL_VINDEX (func) || is_constructor)))
+ pp_string (buffer, "'Class");
arg = TREE_CHAIN (arg);
}
/* Dump in BUFFER NODE's methods. SPC is the indentation level. Return 1 if
- methods were printed, 0 otherwise.
-
- We do it in 2 passes: first, the regular methods, i.e. non-static member
- functions, are output immediately within the package created for the class
- so that they are considered as primitive operations in Ada; second, the
- static member functions are output in a nested package so that they are
- _not_ considered as primitive operations in Ada.
-
- This approach is necessary because the formers have the implicit 'this'
- pointer whereas the latters don't and, on 32-bit x86/Windows, the calling
- conventions for the 'this' pointer are special. Therefore, the compiler
- needs to be able to differentiate regular methods (with 'this' pointer)
- from static member functions that take a pointer to the class as first
- parameter. */
+ methods were printed, 0 otherwise. */
static int
print_ada_methods (pretty_printer *buffer, tree node, int spc)
{
- bool has_static_methods = false;
tree t;
int res;
pp_semicolon (buffer);
- /* First pass: the regular methods. */
res = 1;
for (t = TYPE_METHODS (node); t; t = TREE_CHAIN (t))
{
- if (TREE_CODE (TREE_TYPE (t)) != METHOD_TYPE)
- {
- has_static_methods = true;
- continue;
- }
-
if (res)
{
pp_newline (buffer);
res = print_ada_declaration (buffer, t, node, spc);
}
- if (!has_static_methods)
- return 1;
-
- pp_newline (buffer);
- newline_and_indent (buffer, spc);
-
- /* Second pass: the static member functions. */
- pp_string (buffer, "package Static is");
- pp_newline (buffer);
- spc += INDENT_INCR;
-
- res = 0;
- for (t = TYPE_METHODS (node); t; t = TREE_CHAIN (t))
- {
- if (TREE_CODE (TREE_TYPE (t)) == METHOD_TYPE)
- continue;
-
- if (res)
- {
- pp_newline (buffer);
- pp_newline (buffer);
- }
-
- res = print_ada_declaration (buffer, t, node, spc);
- }
-
- spc -= INDENT_INCR;
- newline_and_indent (buffer, spc);
- pp_string (buffer, "end;");
-
- /* In order to save the clients from adding a second use clause for the
- nested package, we generate renamings for the static member functions
- in the package created for the class. */
- for (t = TYPE_METHODS (node); t; t = TREE_CHAIN (t))
- {
- bool is_function;
-
- if (TREE_CODE (TREE_TYPE (t)) == METHOD_TYPE)
- continue;
-
- pp_newline (buffer);
- newline_and_indent (buffer, spc);
-
- if (VOID_TYPE_P (TREE_TYPE (TREE_TYPE (t))))
- {
- pp_string (buffer, "procedure ");
- is_function = false;
- }
- else
- {
- pp_string (buffer, "function ");
- is_function = true;
- }
-
- dump_ada_decl_name (buffer, t, false);
- dump_ada_function_declaration (buffer, t, false, false, false, spc);
-
- if (is_function)
- {
- pp_string (buffer, " return ");
- dump_generic_ada_node (buffer, TREE_TYPE (TREE_TYPE (t)), node,
- spc, false, true);
- }
-
- pp_string (buffer, " renames Static.");
- dump_ada_decl_name (buffer, t, false);
- pp_semicolon (buffer);
- }
-
return 1;
}