diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 15 | ||||
| -rw-r--r-- | gcc/ada/a-coinve.adb | 357 | ||||
| -rw-r--r-- | gcc/ada/a-convec.adb | 258 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 17 |
4 files changed, 427 insertions, 220 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b7660b50808..a0b0f07824b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +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 diff --git a/gcc/ada/a-coinve.adb b/gcc/ada/a-coinve.adb index 84ad22ec1f9..fb4038db259 100644 --- a/gcc/ada/a-coinve.adb +++ b/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; -------------------- diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb index 64b1b07d927..73151bc9870 100644 --- a/gcc/ada/a-convec.adb +++ b/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; -------------------- diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 29b4cdf7db6..54823e2b63c 100644 --- a/gcc/ada/sem_prag.adb +++ b/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; ----------------------------------------- |