diff --git a/gcc/ada/libgnat/g-cppexc.adb b/gcc/ada/libgnat/g-cppexc.adb
index 11022880670b281458e199822c7f1bc76e182ade..bad748fdfe35cc19073399139e72620d7baf8d00 100644
--- a/gcc/ada/libgnat/g-cppexc.adb
+++ b/gcc/ada/libgnat/g-cppexc.adb
@@ -267,44 +267,4 @@ package body GNAT.CPP_Exceptions is
end Get_Type_Info;
- function Convert_Caught_Object (Choice, Except : Type_Info_Ptr;
- Thrown : in out Address;
- Lang : Character)
- return Interfaces.C.C_bool;
- pragma Export (Cpp, Convert_Caught_Object, "__gnat_convert_caught_object");
- -- Convert the exception object at Thrown, under Lang convention,
- -- from type Except to type Choice, adjusting Thrown as needed and
- -- returning True, or returning False in case the conversion fails.
-
- ---------------------------
- -- Convert_Caught_Object --
- ---------------------------
-
- function Convert_Caught_Object (Choice, Except : Type_Info_Ptr;
- Thrown : in out Address;
- Lang : Character)
- return Interfaces.C.C_bool is
- begin
- if Equals (Choice, Except) then
- return C_bool'(True);
- end if;
-
- if Lang = 'B' then
- if Is_Pointer_P (Except) then
- declare
- Thrown_Indirect : Address;
- for Thrown_Indirect'Address use Thrown;
- begin
- Thrown := Thrown_Indirect;
- end;
- end if;
-
- if Do_Catch (Choice, Except, Thrown, 1) then
- return C_bool'(True);
- end if;
- end if;
-
- return C_bool'(False);
- end Convert_Caught_Object;
-
end GNAT.CPP_Exceptions;
diff --git a/gcc/ada/libgnat/g-cppstd.adb b/gcc/ada/libgnat/g-cppstd.adb
index 000dd474c5cd5fe742a35bbe9fec192593c571ca..8cb64edaffe98856bd24c2167b7fd622ed8e6194 100644
--- a/gcc/ada/libgnat/g-cppstd.adb
+++ b/gcc/ada/libgnat/g-cppstd.adb
@@ -34,6 +34,7 @@
with GNAT.CPP.Std.Type_Info;
with Ada.Unchecked_Conversion;
+with Interfaces.C.Strings; use Interfaces.C.Strings;
package body GNAT.CPP.Std is
----------------------
@@ -53,7 +54,7 @@ package body GNAT.CPP.Std is
function Name (this : Type_Info_Ptr)
return String
- is (this.all.Name);
+ is (Value (this.all.Name));
---------------
-- Before ---
diff --git a/gcc/ada/libgnat/g-cppstd.ads b/gcc/ada/libgnat/g-cppstd.ads
index 63ef03e43ddc05d44e45cb5d1b6ced74cf1f7340..be8907c4f77d6eadad68c5c5e899dc9f68017e3f 100644
--- a/gcc/ada/libgnat/g-cppstd.ads
+++ b/gcc/ada/libgnat/g-cppstd.ads
@@ -50,7 +50,8 @@ package GNAT.CPP.Std is
function Name (this : Type_Info_Ptr)
-- return Interfaces.C.Strings.chars_ptr;
return String;
- -- Exposed std::type_info member function.
+ -- Exposed std::type_info member function. ??? Would it ever be
+ -- desirable to get direct access to the internal chars_ptr?
function Before (this, that : Type_Info_Ptr)
-- return Interfaces.C.Extensions.bool;
@@ -89,6 +90,7 @@ private
type Type_Info_Ptr is access constant Type_Info.type_info'Class;
pragma No_Strict_Aliasing (Type_Info_Ptr);
+ pragma No_Heap_Finalization (Type_Info_Ptr);
No_Type_Info : constant Type_Info_Ptr := null;
diff --git a/gcc/ada/libgnat/g-cstyin.adb b/gcc/ada/libgnat/g-cstyin.adb
index 8036ed52762eaf59da02cd0625e1fc6c5ca2f6bb..b194f7f62b7ddd0d48b0afba423dc285b226be40 100644
--- a/gcc/ada/libgnat/g-cstyin.adb
+++ b/gcc/ada/libgnat/g-cstyin.adb
@@ -30,14 +30,17 @@
------------------------------------------------------------------------------
with System; use System;
+with System.Storage_Elements; use System.Storage_Elements;
with Interfaces.C; use Interfaces.C;
-with Interfaces.C.Pointers;
with Interfaces.C.Extensions; use Interfaces.C.Extensions;
with Interfaces.C.Strings; use Interfaces.C.Strings;
with Ada.Unchecked_Conversion;
package body GNAT.CPP.Std.Type_Info is
+ function strcmp (L, R : chars_ptr) return Interfaces.C.int;
+ pragma Import (Intrinsic, strcmp, "__builtin_strcmp");
+
function Name_Starts_With_Asterisk (this : access constant type_info'Class)
return Boolean;
@@ -46,35 +49,27 @@ package body GNAT.CPP.Std.Type_Info is
function To_Address is
new Ada.Unchecked_Conversion (chars_ptr, System.Address);
-
- type Char_Arr is array (Natural range <>) of aliased char;
- package CharPtr is
- new Interfaces.C.Pointers (Natural, char, Char_Arr, nul);
- type Char_Pointer is new CharPtr.Pointer;
-
function To_Pointer is
- new Ada.Unchecked_Conversion (chars_ptr, Char_Pointer);
- function To_chars_ptr is
- new Ada.Unchecked_Conversion (Char_Pointer, chars_ptr);
+ new Ada.Unchecked_Conversion (System.Address, chars_ptr);
function Name_Starts_With_Asterisk (this : access constant type_info'Class)
return Boolean is
- A : constant Address := To_Address (this.Raw_Name);
+ Addr : constant System.Address := To_Address (this.Raw_Name);
C : aliased char;
- for C'Address use A;
+ for C'Address use Addr;
begin
return C = '*';
end Name_Starts_With_Asterisk;
function Name_Past_Asterisk (this : access constant type_info'Class)
return chars_ptr is
- Addr : Char_Pointer := To_Pointer (this.Raw_Name);
+ Addr : System.Address := To_Address (this.Raw_Name);
begin
if this.Name_Starts_With_Asterisk then
- Increment (Addr);
+ Addr := Addr + Storage_Offset (1);
end if;
- return To_chars_ptr (Addr);
+ return To_Pointer (Addr);
end Name_Past_Asterisk;
------------
@@ -82,8 +77,8 @@ package body GNAT.CPP.Std.Type_Info is
------------
function Name (this : access constant type_info'Class)
- return String
- is (Value (this.Name_Past_Asterisk));
+ return chars_ptr
+ is (this.Name_Past_Asterisk);
--------------
-- Before --
@@ -92,10 +87,10 @@ package body GNAT.CPP.Std.Type_Info is
function Before (this, that : access constant type_info'Class)
return Boolean is
begin
- if this.Name_Starts_With_Asterisk
- or else that.Name_Starts_With_Asterisk
+ if not this.Name_Starts_With_Asterisk
+ or else not that.Name_Starts_With_Asterisk
then
- return this.Name < that.Name;
+ return strcmp (this.Raw_Name, that.Raw_Name) < 0;
end if;
return To_Address (this.Raw_Name) < To_Address (that.Raw_Name);
@@ -116,7 +111,50 @@ package body GNAT.CPP.Std.Type_Info is
return False;
end if;
- return this.Name = that.Name;
+ return strcmp (this.Raw_Name, that.Raw_Name) = 0;
end Equals;
+ function Convert_Caught_Object (Choice, Except : access type_info'Class;
+ Thrown : in out Address;
+ Lang : Character)
+ return Interfaces.C.C_bool;
+ pragma Export (Cpp, Convert_Caught_Object, "__gnat_convert_caught_object");
+ -- Convert the exception object at Thrown, under Lang convention,
+ -- from type Except to type Choice, adjusting Thrown as needed and
+ -- returning True, or returning False in case the conversion
+ -- fails. This is called from raise-gcc, and it is placed here
+ -- rather than in GNAT.CPP_Exceptions to avoid dragging all that
+ -- in when the program doesn't use C++ exceptions.
+
+ ---------------------------
+ -- Convert_Caught_Object --
+ ---------------------------
+
+ function Convert_Caught_Object (Choice, Except : access type_info'Class;
+ Thrown : in out Address;
+ Lang : Character)
+ return Interfaces.C.C_bool is
+ begin
+ if Choice.Equals (Except) then
+ return C_bool'(True);
+ end if;
+
+ if Lang = 'B' then
+ if Except.Is_Pointer_P then
+ declare
+ Thrown_Indirect : Address;
+ for Thrown_Indirect'Address use Thrown;
+ begin
+ Thrown := Thrown_Indirect;
+ end;
+ end if;
+
+ if Choice.Do_Catch (Except, Thrown, 1) then
+ return C_bool'(True);
+ end if;
+ end if;
+
+ return C_bool'(False);
+ end Convert_Caught_Object;
+
end GNAT.CPP.Std.Type_Info;
diff --git a/gcc/ada/libgnat/g-cstyin.ads b/gcc/ada/libgnat/g-cstyin.ads
index 06ed9588d536b15be75b8e5c04832fadca39bf3e..37dad4544f4c2ca349e5230a76c7edadf160a0aa 100644
--- a/gcc/ada/libgnat/g-cstyin.ads
+++ b/gcc/ada/libgnat/g-cstyin.ads
@@ -71,7 +71,7 @@ private package GNAT.CPP.Std.Type_Info is
-- Reimplemented in Ada, using Ada types.
function Name (this : access constant type_info'Class)
-- return Interfaces.C.Strings.chars_ptr;
- return String;
+ return Interfaces.C.Strings.chars_ptr;
-- pragma Import (CPP, Name, "_ZNKSt9type_info4nameEv");
pragma Machine_Attribute (Name, "nothrow");