Skip to content

R
riscv-gcc-1
Commit 8255bc9d by Arnaud Charlet
Options

[multiple changes] 

2010-06-14  Jerome Lambourg  <lambourg@adacore.com>

	* sem_prag.adb (Check_Duplicated_Export_Name): Remove check for
	CLI_Target as this prevents proper detection of exported names
	duplicates when the exported language is different to CIL.
	(Process_Interface_Name): Add check for CIL convention exports,
	replacing the old one from Check_Duplicated_Export_Name.

2010-06-14  Matthew Heaney  <heaney@adacore.com>

	* a-coinve.adb, a-convec.adb (operator "&"): Check both that new length
	and new last satisfy constraints.
	(Delete_Last): prevent overflow for subtraction of index values
	(To_Vector): prevent overflow for addition of index values

From-SVN: r160710
parent 438ff97c
Showing with 315 additions and 108 deletions
gcc/ada/ChangeLog
2010-06-14 Jerome Lambourg <lambourg@adacore.com>
* sem_prag.adb (Check_Duplicated_Export_Name): Remove check for
CLI_Target as this prevents proper detection of exported names
duplicates when the exported language is different to CIL.
(Process_Interface_Name): Add check for CIL convention exports,
replacing the old one from Check_Duplicated_Export_Name.
2010-06-14 Matthew Heaney <heaney@adacore.com>
* a-coinve.adb, a-convec.adb (operator "&"): Check both that new length
and new last satisfy constraints.
(Delete_Last): prevent overflow for subtraction of index values
(To_Vector): prevent overflow for addition of index values
2010-06-14 Ed Schonberg <schonberg@adacore.com> 2010-06-14 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Complete_Object_Operation): After analyzing the * sem_ch4.adb (Complete_Object_Operation): After analyzing the
......
gcc/ada/a-coinve.adb
...@@ -118,21 +118,62 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -118,21 +118,62 @@ package body Ada.Containers.Indefinite_Vectors is
declare declare
N : constant Int'Base := Int (LN) + Int (RN); N : constant Int'Base := Int (LN) + Int (RN);
Last_As_Int : Int'Base; J : Int'Base;
begin begin
if Int (No_Index) > Int'Last - N then -- There are two constraints we need to satisfy. The first constraint
-- is that a container cannot have more than Count_Type'Last
-- elements, so we must check the sum of the combined lengths. (It
-- would be rare for vectors to have such a large number of elements,
-- so we would normally expect this first check to succeed.) The
-- second constraint is that the new Last index value cannot exceed
-- Index_Type'Last.
if N > Count_Type'Pos (Count_Type'Last) then
raise Constraint_Error with "new length is out of range"; raise Constraint_Error with "new length is out of range";
end if; end if;
Last_As_Int := Int (No_Index) + N; -- We now check whether the new length would create a Last index
-- value greater than Index_Type'Last. This calculation requires
-- care, because overflow can occur when Index_Type'First is near the
-- end of the range of Int.
if Index_Type'First <= 0 then
-- Compute the potential Last index value in the normal way, using
-- Int as the type in which to perform intermediate
-- calculations. Int is a 64-bit type, and Count_Type is a 32-bit
-- type, so no overflow can occur.
if Last_As_Int > Int (Index_Type'Last) then J := Int (Index_Type'First - 1) + N;
if J > Int (Index_Type'Last) then
raise Constraint_Error with "new length is out of range"; raise Constraint_Error with "new length is out of range";
end if; end if;
else
-- If Index_Type'First is within N of Int'Last, then overflow
-- would occur if we simply computed Last directly. So instead of
-- computing Last, and then determining whether its value is
-- greater than Index_Type'Last (as we do above), we work
-- backwards by computing the potential First index value, and
-- then checking whether that value is less than Index_Type'First.
J := Int (Index_Type'Last) - N + 1;
if J < Int (Index_Type'First) then
raise Constraint_Error with "new length is out of range";
end if;
-- We have determined that Length would not create a Last index
-- value outside of the range of Index_Type, so we can now safely
-- compute its value.
J := Int (Index_Type'First - 1) + N;
end if;
declare declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Index_Type (J);
LE : Elements_Array renames LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last); Left.Elements.EA (Index_Type'First .. Left.Last);
...@@ -189,10 +230,8 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -189,10 +230,8 @@ package body Ada.Containers.Indefinite_Vectors is
end "&"; end "&";
function "&" (Left : Vector; Right : Element_Type) return Vector is function "&" (Left : Vector; Right : Element_Type) return Vector is
LN : constant Count_Type := Length (Left);
begin begin
if LN = 0 then if Left.Is_Empty then
declare declare
Elements : Elements_Access := new Elements_Type (Index_Type'First); Elements : Elements_Access := new Elements_Type (Index_Type'First);
...@@ -209,22 +248,20 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -209,22 +248,20 @@ package body Ada.Containers.Indefinite_Vectors is
end; end;
end if; end if;
declare -- We must satisfy two constraints: the new length cannot exceed
Last_As_Int : Int'Base; -- Count_Type'Last, and the new Last index cannot exceed
-- Index_Type'Last.
begin if Left.Length = Count_Type'Last then
if Int (Index_Type'First) > Int'Last - Int (LN) then
raise Constraint_Error with "new length is out of range"; raise Constraint_Error with "new length is out of range";
end if; end if;
Last_As_Int := Int (Index_Type'First) + Int (LN); if Left.Last >= Index_Type'Last then
if Last_As_Int > Int (Index_Type'Last) then
raise Constraint_Error with "new length is out of range"; raise Constraint_Error with "new length is out of range";
end if; end if;
declare declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Left.Last + 1;
LE : Elements_Array renames LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last); Left.Elements.EA (Index_Type'First .. Left.Last);
...@@ -265,14 +302,11 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -265,14 +302,11 @@ package body Ada.Containers.Indefinite_Vectors is
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, 0, 0);
end; end;
end;
end "&"; end "&";
function "&" (Left : Element_Type; Right : Vector) return Vector is function "&" (Left : Element_Type; Right : Vector) return Vector is
RN : constant Count_Type := Length (Right);
begin begin
if RN = 0 then if Right.Is_Empty then
declare declare
Elements : Elements_Access := new Elements_Type (Index_Type'First); Elements : Elements_Access := new Elements_Type (Index_Type'First);
...@@ -289,22 +323,20 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -289,22 +323,20 @@ package body Ada.Containers.Indefinite_Vectors is
end; end;
end if; end if;
declare -- We must satisfy two constraints: the new length cannot exceed
Last_As_Int : Int'Base; -- Count_Type'Last, and the new Last index cannot exceed
-- Index_Type'Last.
begin if Right.Length = Count_Type'Last then
if Int (Index_Type'First) > Int'Last - Int (RN) then
raise Constraint_Error with "new length is out of range"; raise Constraint_Error with "new length is out of range";
end if; end if;
Last_As_Int := Int (Index_Type'First) + Int (RN); if Right.Last >= Index_Type'Last then
if Last_As_Int > Int (Index_Type'Last) then
raise Constraint_Error with "new length is out of range"; raise Constraint_Error with "new length is out of range";
end if; end if;
declare declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Right.Last + 1;
RE : Elements_Array renames RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last); Right.Elements.EA (Index_Type'First .. Right.Last);
...@@ -344,7 +376,6 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -344,7 +376,6 @@ package body Ada.Containers.Indefinite_Vectors is
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, 0, 0);
end; end;
end;
end "&"; end "&";
function "&" (Left, Right : Element_Type) return Vector is function "&" (Left, Right : Element_Type) return Vector is
...@@ -2498,52 +2529,125 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2498,52 +2529,125 @@ package body Ada.Containers.Indefinite_Vectors is
--------------- ---------------
function To_Vector (Length : Count_Type) return Vector is function To_Vector (Length : Count_Type) return Vector is
Index : Int'Base;
Last : Index_Type;
Elements : Elements_Access;
begin begin
if Length = 0 then if Length = 0 then
return Empty_Vector; return Empty_Vector;
end if; end if;
declare -- We create a vector object with a capacity that matches the specified
First : constant Int := Int (Index_Type'First); -- Length. We do not allow the vector capacity (the length of the
Last_As_Int : constant Int'Base := First + Int (Length) - 1; -- internal array) to exceed the number of values in Index_Type'Range
Last : Index_Type; -- (otherwise, there would be no way to refer to those components via an
Elements : Elements_Access; -- index), so we must check whether the specified Length would create a
-- Last index value greater than Index_Type'Last. This calculation
-- requires care, because overflow can occur when Index_Type'First is
-- near the end of the range of Int.
begin if Index_Type'First <= 0 then
if Last_As_Int > Index_Type'Pos (Index_Type'Last) then -- Compute the potential Last index value in the normal way, using
-- Int as the type in which to perform intermediate calculations. Int
-- is a 64-bit type, and Count_Type is a 32-bit type, so no overflow
-- can occur.
Index := Int (Index_Type'First - 1) + Int (Length);
if Index > Int (Index_Type'Last) then
raise Constraint_Error with "Length is out of range";
end if;
else
-- If Index_Type'First is within Length of Int'Last, then overflow
-- would occur if we simply computed Last directly. So instead of
-- computing Last, and then determining whether its value is greater
-- than Index_Type'Last, we work backwards by computing the potential
-- First index value, and then checking whether that value is less
-- than Index_Type'First.
Index := Int (Index_Type'Last) - Int (Length) + 1;
if Index < Int (Index_Type'First) then
raise Constraint_Error with "Length is out of range"; raise Constraint_Error with "Length is out of range";
end if; end if;
Last := Index_Type (Last_As_Int); -- We have determined that Length would not create a Last index value
-- outside of the range of Index_Type, so we can now safely compute
-- its value.
Index := Int (Index_Type'First - 1) + Int (Length);
end if;
Last := Index_Type (Index);
Elements := new Elements_Type (Last); Elements := new Elements_Type (Last);
return (Controlled with Elements, Last, 0, 0); return Vector'(Controlled with Elements, Last, 0, 0);
end;
end To_Vector; end To_Vector;
function To_Vector function To_Vector
(New_Item : Element_Type; (New_Item : Element_Type;
Length : Count_Type) return Vector Length : Count_Type) return Vector
is is
Index : Int'Base;
Last : Index_Type;
Elements : Elements_Access;
begin begin
if Length = 0 then if Length = 0 then
return Empty_Vector; return Empty_Vector;
end if; end if;
declare -- We create a vector object with a capacity that matches the specified
First : constant Int := Int (Index_Type'First); -- Length. We do not allow the vector capacity (the length of the
Last_As_Int : constant Int'Base := First + Int (Length) - 1; -- internal array) to exceed the number of values in Index_Type'Range
Last : Index_Type'Base; -- (otherwise, there would be no way to refer to those components via an
Elements : Elements_Access; -- index), so we must check whether the specified Length would create a
-- Last index value greater than Index_Type'Last. This calculation
-- requires care, because overflow can occur when Index_Type'First is
-- near the end of the range of Int.
begin if Index_Type'First <= 0 then
if Last_As_Int > Index_Type'Pos (Index_Type'Last) then -- Compute the potential Last index value in the normal way, using
-- Int as the type in which to perform intermediate calculations. Int
-- is a 64-bit type, and Count_Type is a 32-bit type, so no overflow
-- can occur.
Index := Int (Index_Type'First - 1) + Int (Length);
if Index > Int (Index_Type'Last) then
raise Constraint_Error with "Length is out of range";
end if;
else
-- If Index_Type'First is within Length of Int'Last, then overflow
-- would occur if we simply computed Last directly. So instead of
-- computing Last, and then determining whether its value is greater
-- than Index_Type'Last, we work backwards by computing the potential
-- First index value, and then checking whether that value is less
-- than Index_Type'First.
Index := Int (Index_Type'Last) - Int (Length) + 1;
if Index < Int (Index_Type'First) then
raise Constraint_Error with "Length is out of range"; raise Constraint_Error with "Length is out of range";
end if; end if;
Last := Index_Type (Last_As_Int); -- We have determined that Length would not create a Last index value
-- outside of the range of Index_Type, so we can now safely compute
-- its value.
Index := Int (Index_Type'First - 1) + Int (Length);
end if;
Last := Index_Type (Index);
Elements := new Elements_Type (Last); Elements := new Elements_Type (Last);
-- We use Last as the index of the loop used to populate the internal
-- array with items. In general, we prefer to initialize the loop index
-- immediately prior to entering the loop. However, Last is also used in
-- the exception handler (it reclaims elements that have been allocated,
-- before propagating the exception), and the initialization of Last
-- after entering the block containing the handler confuses some static
-- analysis tools, with respect to whether Last has been properly
-- initialized when the handler executes. So here we initialize our loop
-- variable earlier than we prefer, before entering the block, so there
-- is no ambiguity.
Last := Index_Type'First; Last := Index_Type'First;
begin begin
...@@ -2564,7 +2668,6 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2564,7 +2668,6 @@ package body Ada.Containers.Indefinite_Vectors is
end; end;
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, 0, 0);
end;
end To_Vector; end To_Vector;
-------------------- --------------------
......
gcc/ada/a-convec.adb
...@@ -82,21 +82,58 @@ package body Ada.Containers.Vectors is ...@@ -82,21 +82,58 @@ package body Ada.Containers.Vectors is
declare declare
N : constant Int'Base := Int (LN) + Int (RN); N : constant Int'Base := Int (LN) + Int (RN);
Last_As_Int : Int'Base; J : Int'Base;
begin begin
if Int (No_Index) > Int'Last - N then -- There are two constraints we need to satisfy. The first constraint
-- is that a container cannot have more than Count_Type'Last
-- elements, so we must check the sum of the combined lengths. (It
-- would be rare for vectors to have such a large number of elements,
-- so we would normally expect this first check to succeed.) The
-- second constraint is that the new Last index value cannot exceed
-- Index_Type'Last.
if N > Count_Type'Pos (Count_Type'Last) then
raise Constraint_Error with "new length is out of range"; raise Constraint_Error with "new length is out of range";
end if; end if;
Last_As_Int := Int (No_Index) + N; -- We now check whether the new length would create a Last index
-- value greater than Index_Type'Last. This calculation requires
-- care, because overflow can occur when Index_Type'First is near the
-- end of the range of Int.
if Index_Type'First <= 0 then
-- Compute the potential Last index value in the normal way, using
-- Int as the type in which to perform intermediate
-- calculations. Int is a 64-bit type, and Count_Type is a 32-bit
-- type, so no overflow can occur.
J := Int (Index_Type'First - 1) + N;
if J > Int (Index_Type'Last) then
raise Constraint_Error with "new length is out of range";
end if;
if Last_As_Int > Int (Index_Type'Last) then else
-- If Index_Type'First is within N of Int'Last, then overflow
-- would occur if we simply computed Last directly. So instead of
-- computing Last, and then determining whether its value is
-- greater than Index_Type'Last (as we do above), we work
-- backwards by computing the potential First index value, and
-- then checking whether that value is less than Index_Type'First.
J := Int (Index_Type'Last) - N + 1;
if J < Int (Index_Type'First) then
raise Constraint_Error with "new length is out of range"; raise Constraint_Error with "new length is out of range";
end if; end if;
-- We have determined that Length would not create a Last index
-- value outside of the range of Index_Type, so we can now safely
-- compute its value.
J := Int (Index_Type'First - 1) + N;
end if;
declare declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Index_Type (J);
LE : Elements_Array renames LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last); Left.Elements.EA (Index_Type'First .. Left.Last);
...@@ -114,10 +151,8 @@ package body Ada.Containers.Vectors is ...@@ -114,10 +151,8 @@ package body Ada.Containers.Vectors is
end "&"; end "&";
function "&" (Left : Vector; Right : Element_Type) return Vector is function "&" (Left : Vector; Right : Element_Type) return Vector is
LN : constant Count_Type := Length (Left);
begin begin
if LN = 0 then if Left.Is_Empty then
declare declare
Elements : constant Elements_Access := Elements : constant Elements_Access :=
new Elements_Type' new Elements_Type'
...@@ -129,22 +164,20 @@ package body Ada.Containers.Vectors is ...@@ -129,22 +164,20 @@ package body Ada.Containers.Vectors is
end; end;
end if; end if;
declare -- We must satisfy two constraints: the new length cannot exceed
Last_As_Int : Int'Base; -- Count_Type'Last, and the new Last index cannot exceed
-- Index_Type'Last.
begin if Left.Length = Count_Type'Last then
if Int (Index_Type'First) > Int'Last - Int (LN) then
raise Constraint_Error with "new length is out of range"; raise Constraint_Error with "new length is out of range";
end if; end if;
Last_As_Int := Int (Index_Type'First) + Int (LN); if Left.Last >= Index_Type'Last then
if Last_As_Int > Int (Index_Type'Last) then
raise Constraint_Error with "new length is out of range"; raise Constraint_Error with "new length is out of range";
end if; end if;
declare declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Left.Last + 1;
LE : Elements_Array renames LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last); Left.Elements.EA (Index_Type'First .. Left.Last);
...@@ -157,14 +190,11 @@ package body Ada.Containers.Vectors is ...@@ -157,14 +190,11 @@ package body Ada.Containers.Vectors is
begin begin
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, 0, 0);
end; end;
end;
end "&"; end "&";
function "&" (Left : Element_Type; Right : Vector) return Vector is function "&" (Left : Element_Type; Right : Vector) return Vector is
RN : constant Count_Type := Length (Right);
begin begin
if RN = 0 then if Right.Is_Empty then
declare declare
Elements : constant Elements_Access := Elements : constant Elements_Access :=
new Elements_Type' new Elements_Type'
...@@ -176,22 +206,20 @@ package body Ada.Containers.Vectors is ...@@ -176,22 +206,20 @@ package body Ada.Containers.Vectors is
end; end;
end if; end if;
declare -- We must satisfy two constraints: the new length cannot exceed
Last_As_Int : Int'Base; -- Count_Type'Last, and the new Last index cannot exceed
-- Index_Type'Last.
begin if Right.Length = Count_Type'Last then
if Int (Index_Type'First) > Int'Last - Int (RN) then
raise Constraint_Error with "new length is out of range"; raise Constraint_Error with "new length is out of range";
end if; end if;
Last_As_Int := Int (Index_Type'First) + Int (RN); if Right.Last >= Index_Type'Last then
if Last_As_Int > Int (Index_Type'Last) then
raise Constraint_Error with "new length is out of range"; raise Constraint_Error with "new length is out of range";
end if; end if;
declare declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Right.Last + 1;
RE : Elements_Array renames RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last); Right.Elements.EA (Index_Type'First .. Right.Last);
...@@ -204,7 +232,6 @@ package body Ada.Containers.Vectors is ...@@ -204,7 +232,6 @@ package body Ada.Containers.Vectors is
begin begin
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, 0, 0);
end; end;
end;
end "&"; end "&";
function "&" (Left, Right : Element_Type) return Vector is function "&" (Left, Right : Element_Type) return Vector is
...@@ -488,12 +515,13 @@ package body Ada.Containers.Vectors is ...@@ -488,12 +515,13 @@ package body Ada.Containers.Vectors is
"attempt to tamper with elements (vector is busy)"; "attempt to tamper with elements (vector is busy)";
end if; end if;
Index := Int'Base (Container.Last) - Int'Base (Count); if Count >= Container.Length then
Container.Last := No_Index;
Container.Last := else
(if Index < Index_Type'Pos (Index_Type'First) Index := Int (Container.Last) - Int (Count);
then No_Index Container.Last := Index_Type (Index);
else Index_Type (Index)); end if;
end Delete_Last; end Delete_Last;
------------- -------------
...@@ -2135,54 +2163,116 @@ package body Ada.Containers.Vectors is ...@@ -2135,54 +2163,116 @@ package body Ada.Containers.Vectors is
--------------- ---------------
function To_Vector (Length : Count_Type) return Vector is function To_Vector (Length : Count_Type) return Vector is
Index : Int'Base;
Last : Index_Type;
Elements : Elements_Access;
begin begin
if Length = 0 then if Length = 0 then
return Empty_Vector; return Empty_Vector;
end if; end if;
declare -- We create a vector object with a capacity that matches the specified
First : constant Int := Int (Index_Type'First); -- Length, but we do not allow the vector capacity (the length of the
Last_As_Int : constant Int'Base := First + Int (Length) - 1; -- internal array) to exceed the number of values in Index_Type'Range
Last : Index_Type; -- (otherwise, there would be no way to refer to those components via an
Elements : Elements_Access; -- index). We must therefore check whether the specified Length would
-- create a Last index value greater than Index_Type'Last. This
-- calculation requires care, because overflow can occur when
-- Index_Type'First is near the end of the range of Int.
begin if Index_Type'First <= 0 then
if Last_As_Int > Index_Type'Pos (Index_Type'Last) then -- Compute the potential Last index value in the normal way, using
-- Int as the type in which to perform intermediate calculations. Int
-- is a 64-bit type, and Count_Type is a 32-bit type, so no overflow
-- can occur.
Index := Int (Index_Type'First - 1) + Int (Length);
if Index > Int (Index_Type'Last) then
raise Constraint_Error with "Length is out of range";
end if;
else
-- If Index_Type'First is within Length of Int'Last, then overflow
-- would occur if we simply computed Last directly. So instead of
-- computing Last, and then determining whether its value is greater
-- than Index_Type'Last, we work backwards by computing the potential
-- First index value, and then checking whether that value is less
-- than Index_Type'First.
Index := Int (Index_Type'Last) - Int (Length) + 1;
if Index < Int (Index_Type'First) then
raise Constraint_Error with "Length is out of range"; raise Constraint_Error with "Length is out of range";
end if; end if;
Last := Index_Type (Last_As_Int); -- We have determined that Length would not create a Last index value
-- outside of the range of Index_Type, so we can now safely compute
-- its value.
Index := Int (Index_Type'First - 1) + Int (Length);
end if;
Last := Index_Type (Index);
Elements := new Elements_Type (Last); Elements := new Elements_Type (Last);
return Vector'(Controlled with Elements, Last, 0, 0); return Vector'(Controlled with Elements, Last, 0, 0);
end;
end To_Vector; end To_Vector;
function To_Vector function To_Vector
(New_Item : Element_Type; (New_Item : Element_Type;
Length : Count_Type) return Vector Length : Count_Type) return Vector
is is
Index : Int'Base;
Last : Index_Type;
Elements : Elements_Access;
begin begin
if Length = 0 then if Length = 0 then
return Empty_Vector; return Empty_Vector;
end if; end if;
declare -- We create a vector object with a capacity that matches the specified
First : constant Int := Int (Index_Type'First); -- Length, but we do not allow the vector capacity (the length of the
Last_As_Int : constant Int'Base := First + Int (Length) - 1; -- internal array) to exceed the number of values in Index_Type'Range
Last : Index_Type; -- (otherwise, there would be no way to refer to those components via an
Elements : Elements_Access; -- index). We must therefore check whether the specified Length would
-- create a Last index value greater than Index_Type'Last. This
-- calculation requires care, because overflow can occur when
-- Index_Type'First is near the end of the range of Int.
begin if Index_Type'First <= 0 then
if Last_As_Int > Index_Type'Pos (Index_Type'Last) then -- Compute the potential Last index value in the normal way, using
-- Int as the type in which to perform intermediate calculations. Int
-- is a 64-bit type, and Count_Type is a 32-bit type, so no overflow
-- can occur.
Index := Int (Index_Type'First - 1) + Int (Length);
if Index > Int (Index_Type'Last) then
raise Constraint_Error with "Length is out of range";
end if;
else
-- If Index_Type'First is within Length of Int'Last, then overflow
-- would occur if we simply computed Last directly. So instead of
-- computing Last, and then determining whether its value is greater
-- than Index_Type'Last, we work backwards by computing the potential
-- First index value, and then checking whether that value is less
-- than Index_Type'First.
Index := Int (Index_Type'Last) - Int (Length) + 1;
if Index < Int (Index_Type'First) then
raise Constraint_Error with "Length is out of range"; raise Constraint_Error with "Length is out of range";
end if; end if;
Last := Index_Type (Last_As_Int); -- We have determined that Length would not create a Last index value
-- outside of the range of Index_Type, so we can now safely compute
-- its value.
Index := Int (Index_Type'First - 1) + Int (Length);
end if;
Last := Index_Type (Index);
Elements := new Elements_Type'(Last, EA => (others => New_Item)); Elements := new Elements_Type'(Last, EA => (others => New_Item));
return Vector'(Controlled with Elements, Last, 0, 0); return Vector'(Controlled with Elements, Last, 0, 0);
end;
end To_Vector; end To_Vector;
-------------------- --------------------
......
gcc/ada/sem_prag.adb
...@@ -1154,14 +1154,6 @@ package body Sem_Prag is ...@@ -1154,14 +1154,6 @@ package body Sem_Prag is
String_Val : constant String_Id := Strval (Nam); String_Val : constant String_Id := Strval (Nam);
begin begin
-- We allow duplicated export names in CIL, as they are always
-- enclosed in a namespace that differentiates them, and overloaded
-- entities are supported by the VM.
if VM_Target = CLI_Target then
return;
end if;
-- We are only interested in the export case, and in the case of -- We are only interested in the export case, and in the case of
-- generics, it is the instance, not the template, that is the -- generics, it is the instance, not the template, that is the
-- problem (the template will generate a warning in any case). -- problem (the template will generate a warning in any case).
...@@ -4140,7 +4132,14 @@ package body Sem_Prag is ...@@ -4140,7 +4132,14 @@ package body Sem_Prag is
Set_Encoded_Interface_Name Set_Encoded_Interface_Name
(Get_Base_Subprogram (Subprogram_Def), Link_Nam); (Get_Base_Subprogram (Subprogram_Def), Link_Nam);
-- We allow duplicated export names in CIL, as they are always
-- enclosed in a namespace that differentiates them, and overloaded
-- entities are supported by the VM.
if Convention (Subprogram_Def) /= Convention_CIL then
Check_Duplicated_Export_Name (Link_Nam); Check_Duplicated_Export_Name (Link_Nam);
end if;
end Process_Interface_Name; end Process_Interface_Name;
----------------------------------------- -----------------------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment