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 427 additions and 220 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>
* sem_ch4.adb (Complete_Object_Operation): After analyzing the
......
gcc/ada/a-coinve.adb
......@@ -117,22 +117,63 @@ package body Ada.Containers.Indefinite_Vectors is
end if;
declare
N : constant Int'Base := Int (LN) + Int (RN);
Last_As_Int : Int'Base;
N : constant Int'Base := Int (LN) + Int (RN);
J : Int'Base;
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";
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 Last_As_Int > Int (Index_Type'Last) then
raise Constraint_Error with "new length is out of range";
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;
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
Last : constant Index_Type := Index_Type (Last_As_Int);
Last : constant Index_Type := Index_Type (J);
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
......@@ -189,10 +230,8 @@ package body Ada.Containers.Indefinite_Vectors is
end "&";
function "&" (Left : Vector; Right : Element_Type) return Vector is
LN : constant Count_Type := Length (Left);
begin
if LN = 0 then
if Left.Is_Empty then
declare
Elements : Elements_Access := new Elements_Type (Index_Type'First);
......@@ -209,70 +248,65 @@ package body Ada.Containers.Indefinite_Vectors is
end;
end if;
declare
Last_As_Int : Int'Base;
begin
if Int (Index_Type'First) > Int'Last - Int (LN) then
raise Constraint_Error with "new length is out of range";
end if;
Last_As_Int := Int (Index_Type'First) + Int (LN);
if Last_As_Int > Int (Index_Type'Last) then
raise Constraint_Error with "new length is out of range";
end if;
-- We must satisfy two constraints: the new length cannot exceed
-- Count_Type'Last, and the new Last index cannot exceed
-- Index_Type'Last.
declare
Last : constant Index_Type := Index_Type (Last_As_Int);
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
if Left.Length = Count_Type'Last then
raise Constraint_Error with "new length is out of range";
end if;
Elements : Elements_Access :=
new Elements_Type (Last);
if Left.Last >= Index_Type'Last then
raise Constraint_Error with "new length is out of range";
end if;
begin
for I in LE'Range loop
begin
if LE (I) /= null then
Elements.EA (I) := new Element_Type'(LE (I).all);
end if;
declare
Last : constant Index_Type := Left.Last + 1;
exception
when others =>
for J in Index_Type'First .. I - 1 loop
Free (Elements.EA (J));
end loop;
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
Free (Elements);
raise;
end;
end loop;
Elements : Elements_Access :=
new Elements_Type (Last);
begin
for I in LE'Range loop
begin
Elements.EA (Last) := new Element_Type'(Right);
if LE (I) /= null then
Elements.EA (I) := new Element_Type'(LE (I).all);
end if;
exception
when others =>
for J in Index_Type'First .. Last - 1 loop
for J in Index_Type'First .. I - 1 loop
Free (Elements.EA (J));
end loop;
Free (Elements);
raise;
end;
end loop;
return (Controlled with Elements, Last, 0, 0);
begin
Elements.EA (Last) := new Element_Type'(Right);
exception
when others =>
for J in Index_Type'First .. Last - 1 loop
Free (Elements.EA (J));
end loop;
Free (Elements);
raise;
end;
return (Controlled with Elements, Last, 0, 0);
end;
end "&";
function "&" (Left : Element_Type; Right : Vector) return Vector is
RN : constant Count_Type := Length (Right);
begin
if RN = 0 then
if Right.Is_Empty then
declare
Elements : Elements_Access := new Elements_Type (Index_Type'First);
......@@ -289,61 +323,58 @@ package body Ada.Containers.Indefinite_Vectors is
end;
end if;
declare
Last_As_Int : Int'Base;
-- We must satisfy two constraints: the new length cannot exceed
-- Count_Type'Last, and the new Last index cannot exceed
-- Index_Type'Last.
begin
if Int (Index_Type'First) > Int'Last - Int (RN) then
raise Constraint_Error with "new length is out of range";
end if;
Last_As_Int := Int (Index_Type'First) + Int (RN);
if Right.Length = Count_Type'Last then
raise Constraint_Error with "new length is out of range";
end if;
if Last_As_Int > Int (Index_Type'Last) then
raise Constraint_Error with "new length is out of range";
end if;
if Right.Last >= Index_Type'Last then
raise Constraint_Error with "new length is out of range";
end if;
declare
Last : constant Index_Type := Index_Type (Last_As_Int);
declare
Last : constant Index_Type := Right.Last + 1;
RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last);
RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last);
Elements : Elements_Access :=
new Elements_Type (Last);
Elements : Elements_Access :=
new Elements_Type (Last);
I : Index_Type'Base := Index_Type'First;
I : Index_Type'Base := Index_Type'First;
begin
begin
Elements.EA (I) := new Element_Type'(Left);
exception
when others =>
Free (Elements);
raise;
end;
for RI in RE'Range loop
I := I + 1;
begin
Elements.EA (I) := new Element_Type'(Left);
if RE (RI) /= null then
Elements.EA (I) := new Element_Type'(RE (RI).all);
end if;
exception
when others =>
for J in Index_Type'First .. I - 1 loop
Free (Elements.EA (J));
end loop;
Free (Elements);
raise;
end;
end loop;
for RI in RE'Range loop
I := I + 1;
begin
if RE (RI) /= null then
Elements.EA (I) := new Element_Type'(RE (RI).all);
end if;
exception
when others =>
for J in Index_Type'First .. I - 1 loop
Free (Elements.EA (J));
end loop;
Free (Elements);
raise;
end;
end loop;
return (Controlled with Elements, Last, 0, 0);
end;
return (Controlled with Elements, Last, 0, 0);
end;
end "&";
......@@ -2498,73 +2529,145 @@ package body Ada.Containers.Indefinite_Vectors is
---------------
function To_Vector (Length : Count_Type) return Vector is
Index : Int'Base;
Last : Index_Type;
Elements : Elements_Access;
begin
if Length = 0 then
return Empty_Vector;
end if;
declare
First : constant Int := Int (Index_Type'First);
Last_As_Int : constant Int'Base := First + Int (Length) - 1;
Last : Index_Type;
Elements : Elements_Access;
-- We create a vector object with a capacity that matches the specified
-- Length. We do not allow the vector capacity (the length of the
-- internal array) to exceed the number of values in Index_Type'Range
-- (otherwise, there would be no way to refer to those components via an
-- 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 Last_As_Int > Index_Type'Pos (Index_Type'Last) then
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.
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;
Last := Index_Type (Last_As_Int);
Elements := new Elements_Type (Last);
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";
end if;
return (Controlled with Elements, Last, 0, 0);
end;
-- 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);
return Vector'(Controlled with Elements, Last, 0, 0);
end To_Vector;
function To_Vector
(New_Item : Element_Type;
Length : Count_Type) return Vector
is
Index : Int'Base;
Last : Index_Type;
Elements : Elements_Access;
begin
if Length = 0 then
return Empty_Vector;
end if;
declare
First : constant Int := Int (Index_Type'First);
Last_As_Int : constant Int'Base := First + Int (Length) - 1;
Last : Index_Type'Base;
Elements : Elements_Access;
-- We create a vector object with a capacity that matches the specified
-- Length. We do not allow the vector capacity (the length of the
-- internal array) to exceed the number of values in Index_Type'Range
-- (otherwise, there would be no way to refer to those components via an
-- 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 Last_As_Int > Index_Type'Pos (Index_Type'Last) then
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.
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;
Last := Index_Type (Last_As_Int);
Elements := new Elements_Type (Last);
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";
end if;
Last := Index_Type'First;
-- 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;
begin
loop
Elements.EA (Last) := new Element_Type'(New_Item);
exit when Last = Elements.Last;
Last := Last + 1;
end loop;
Last := Index_Type (Index);
Elements := new Elements_Type (Last);
exception
when others =>
for J in Index_Type'First .. Last - 1 loop
Free (Elements.EA (J));
end loop;
-- 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;
Free (Elements);
raise;
end;
begin
loop
Elements.EA (Last) := new Element_Type'(New_Item);
exit when Last = Elements.Last;
Last := Last + 1;
end loop;
return (Controlled with Elements, Last, 0, 0);
exception
when others =>
for J in Index_Type'First .. Last - 1 loop
Free (Elements.EA (J));
end loop;
Free (Elements);
raise;
end;
return (Controlled with Elements, Last, 0, 0);
end To_Vector;
--------------------
......
gcc/ada/a-convec.adb
......@@ -81,22 +81,59 @@ package body Ada.Containers.Vectors is
end if;
declare
N : constant Int'Base := Int (LN) + Int (RN);
Last_As_Int : Int'Base;
N : constant Int'Base := Int (LN) + Int (RN);
J : Int'Base;
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";
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 Last_As_Int > Int (Index_Type'Last) then
raise Constraint_Error with "new length is out of range";
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;
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
Last : constant Index_Type := Index_Type (Last_As_Int);
Last : constant Index_Type := Index_Type (J);
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
......@@ -114,10 +151,8 @@ package body Ada.Containers.Vectors is
end "&";
function "&" (Left : Vector; Right : Element_Type) return Vector is
LN : constant Count_Type := Length (Left);
begin
if LN = 0 then
if Left.Is_Empty then
declare
Elements : constant Elements_Access :=
new Elements_Type'
......@@ -129,42 +164,37 @@ package body Ada.Containers.Vectors is
end;
end if;
declare
Last_As_Int : Int'Base;
begin
if Int (Index_Type'First) > Int'Last - Int (LN) then
raise Constraint_Error with "new length is out of range";
end if;
-- We must satisfy two constraints: the new length cannot exceed
-- Count_Type'Last, and the new Last index cannot exceed
-- Index_Type'Last.
Last_As_Int := Int (Index_Type'First) + Int (LN);
if Left.Length = Count_Type'Last then
raise Constraint_Error with "new length is out of range";
end if;
if Last_As_Int > Int (Index_Type'Last) then
raise Constraint_Error with "new length is out of range";
end if;
if Left.Last >= Index_Type'Last then
raise Constraint_Error with "new length is out of range";
end if;
declare
Last : constant Index_Type := Index_Type (Last_As_Int);
declare
Last : constant Index_Type := Left.Last + 1;
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
Elements : constant Elements_Access :=
new Elements_Type'
(Last => Last,
EA => LE & Right);
Elements : constant Elements_Access :=
new Elements_Type'
(Last => Last,
EA => LE & Right);
begin
return (Controlled with Elements, Last, 0, 0);
end;
begin
return (Controlled with Elements, Last, 0, 0);
end;
end "&";
function "&" (Left : Element_Type; Right : Vector) return Vector is
RN : constant Count_Type := Length (Right);
begin
if RN = 0 then
if Right.Is_Empty then
declare
Elements : constant Elements_Access :=
new Elements_Type'
......@@ -176,34 +206,31 @@ package body Ada.Containers.Vectors is
end;
end if;
declare
Last_As_Int : Int'Base;
-- We must satisfy two constraints: the new length cannot exceed
-- Count_Type'Last, and the new Last index cannot exceed
-- Index_Type'Last.
begin
if Int (Index_Type'First) > Int'Last - Int (RN) then
raise Constraint_Error with "new length is out of range";
end if;
Last_As_Int := Int (Index_Type'First) + Int (RN);
if Right.Length = Count_Type'Last then
raise Constraint_Error with "new length is out of range";
end if;
if Last_As_Int > Int (Index_Type'Last) then
raise Constraint_Error with "new length is out of range";
end if;
if Right.Last >= Index_Type'Last then
raise Constraint_Error with "new length is out of range";
end if;
declare
Last : constant Index_Type := Index_Type (Last_As_Int);
declare
Last : constant Index_Type := Right.Last + 1;
RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last);
RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last);
Elements : constant Elements_Access :=
new Elements_Type'
(Last => Last,
EA => Left & RE);
Elements : constant Elements_Access :=
new Elements_Type'
(Last => Last,
EA => Left & RE);
begin
return (Controlled with Elements, Last, 0, 0);
end;
begin
return (Controlled with Elements, Last, 0, 0);
end;
end "&";
......@@ -488,12 +515,13 @@ package body Ada.Containers.Vectors is
"attempt to tamper with elements (vector is busy)";
end if;
Index := Int'Base (Container.Last) - Int'Base (Count);
if Count >= Container.Length then
Container.Last := No_Index;
Container.Last :=
(if Index < Index_Type'Pos (Index_Type'First)
then No_Index
else Index_Type (Index));
else
Index := Int (Container.Last) - Int (Count);
Container.Last := Index_Type (Index);
end if;
end Delete_Last;
-------------
......@@ -2135,54 +2163,116 @@ package body Ada.Containers.Vectors is
---------------
function To_Vector (Length : Count_Type) return Vector is
Index : Int'Base;
Last : Index_Type;
Elements : Elements_Access;
begin
if Length = 0 then
return Empty_Vector;
end if;
declare
First : constant Int := Int (Index_Type'First);
Last_As_Int : constant Int'Base := First + Int (Length) - 1;
Last : Index_Type;
Elements : Elements_Access;
-- We create a vector object with a capacity that matches the specified
-- Length, but we do not allow the vector capacity (the length of the
-- internal array) to exceed the number of values in Index_Type'Range
-- (otherwise, there would be no way to refer to those components via an
-- 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 Last_As_Int > Index_Type'Pos (Index_Type'Last) then
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.
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";
end if;
Last := Index_Type (Last_As_Int);
Elements := new Elements_Type (Last);
-- 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);
return Vector'(Controlled with Elements, Last, 0, 0);
end;
return Vector'(Controlled with Elements, Last, 0, 0);
end To_Vector;
function To_Vector
(New_Item : Element_Type;
Length : Count_Type) return Vector
is
Index : Int'Base;
Last : Index_Type;
Elements : Elements_Access;
begin
if Length = 0 then
return Empty_Vector;
end if;
declare
First : constant Int := Int (Index_Type'First);
Last_As_Int : constant Int'Base := First + Int (Length) - 1;
Last : Index_Type;
Elements : Elements_Access;
-- We create a vector object with a capacity that matches the specified
-- Length, but we do not allow the vector capacity (the length of the
-- internal array) to exceed the number of values in Index_Type'Range
-- (otherwise, there would be no way to refer to those components via an
-- 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 Last_As_Int > Index_Type'Pos (Index_Type'Last) then
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.
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;
Last := Index_Type (Last_As_Int);
Elements := new Elements_Type'(Last, EA => (others => New_Item));
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";
end if;
return Vector'(Controlled with Elements, Last, 0, 0);
end;
-- 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));
return Vector'(Controlled with Elements, Last, 0, 0);
end To_Vector;
--------------------
......
gcc/ada/sem_prag.adb
......@@ -1154,14 +1154,6 @@ package body Sem_Prag is
String_Val : constant String_Id := Strval (Nam);
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
-- generics, it is the instance, not the template, that is the
-- problem (the template will generate a warning in any case).
......@@ -4140,7 +4132,14 @@ package body Sem_Prag is
Set_Encoded_Interface_Name
(Get_Base_Subprogram (Subprogram_Def), Link_Nam);
Check_Duplicated_Export_Name (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);
end if;
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