PR 33870

[pf3gnuchains/gcc-fork.git] / gcc / ada / a-tags.adb

diff --git a/gcc/ada/a-tags.adb b/gcc/ada/a-tags.adb
index 5a0cf71..47e76ff 100644 (file)
--- a/gcc/ada/a-tags.adb
+++ b/gcc/ada/a-tags.adb
@@ -279,7 +279,7 @@ package body Ada.Tags is
          TSD     : constant Type_Specific_Data_Ptr :=
                      To_Type_Specific_Data_Ptr (TSD_Ptr.all);
       begin
-         return TSD.HT_Link;
+         return TSD.HT_Link.all;
       end Get_HT_Link;
 
       ----------
@@ -304,7 +304,7 @@ package body Ada.Tags is
          TSD     : constant Type_Specific_Data_Ptr :=
                      To_Type_Specific_Data_Ptr (TSD_Ptr.all);
       begin
-         TSD.HT_Link := Next;
+         TSD.HT_Link.all := Next;
       end Set_HT_Link;
 
    end HTable_Subprograms;
@@ -351,8 +351,8 @@ package body Ada.Tags is
                   Obj_Base := Obj_Base +
                     Iface_Table.Ifaces_Table (Id).Offset_To_Top_Value;
 
-               --  Otherwise we call the function generated by the expander
-               --  to provide us with this value
+               --  Otherwise call the function generated by the expander to
+               --  provide the value.
 
                else
                   Obj_Base := Obj_Base +
@@ -628,20 +628,60 @@ package body Ada.Tags is
             end loop;
 
             if Addr_Last <= External'Last then
-               Addr :=
-                 Integer_Address'Value (External (Addr_First .. Addr_Last));
-               return To_Tag (Addr);
+
+               --  Protect the run-time against wrong internal tags. We
+               --  cannot use exception handlers here because it would
+               --  disable the use of this run-time compiling with
+               --  restriction No_Exception_Handler.
+
+               declare
+                  C         : Character;
+                  Wrong_Tag : Boolean := False;
+
+               begin
+                  if External (Addr_First) /= '1'
+                    or else External (Addr_First + 1) /= '6'
+                    or else External (Addr_First + 2) /= '#'
+                  then
+                     Wrong_Tag := True;
+
+                  else
+                     for J in Addr_First + 3 .. Addr_Last - 1 loop
+                        C := External (J);
+
+                        if not (C in '0' .. '9')
+                          and then not (C in 'A' .. 'F')
+                          and then not (C in 'a' .. 'f')
+                        then
+                           Wrong_Tag := True;
+                           exit;
+                        end if;
+                     end loop;
+                  end if;
+
+                  --  Convert the numeric value into a tag
+
+                  if not Wrong_Tag then
+                     Addr := Integer_Address'Value
+                               (External (Addr_First .. Addr_Last));
+
+                     --  Internal tags never have value 0
+
+                     if Addr /= 0 then
+                        return To_Tag (Addr);
+                     end if;
+                  end if;
+               end;
             end if;
          end;
 
       --  Handle library-level tagged types
 
       else
-         --  Make a copy of the string representing the external tag with
-         --  a null at the end.
+         --  Make NUL-terminated copy of external tag string
 
          Ext_Copy (External'Range) := External;
-         Ext_Copy (Ext_Copy'Last) := ASCII.NUL;
+         Ext_Copy (Ext_Copy'Last)  := ASCII.NUL;
          Res := External_Tag_HTable.Get (Ext_Copy'Address);
       end if;