diff options
| author | Ian Lance Taylor <iant@golang.org> | 2021-10-07 15:28:36 -0700 |
|---|---|---|
| committer | Ian Lance Taylor <iant@golang.org> | 2021-10-07 15:28:36 -0700 |
| commit | 0b6b70a0733672600644c8df96942cda5bf86d3d (patch) | |
| tree | 9a1fbd7f782c54df55ab225ed1be057e3f3b0b8a /gcc/ada/libgnat | |
| parent | a5b5cabc91c38710adbe5c8a2b53882abe994441 (diff) | |
| parent | fba228e259dd5112851527f2dbb62c5601100985 (diff) | |
| download | gcc-0b6b70a0733672600644c8df96942cda5bf86d3d.zip gcc-0b6b70a0733672600644c8df96942cda5bf86d3d.tar.gz gcc-0b6b70a0733672600644c8df96942cda5bf86d3d.tar.bz2 | |
Merge from trunk revision fba228e259dd5112851527f2dbb62c5601100985.
Diffstat (limited to 'gcc/ada/libgnat')
49 files changed, 6254 insertions, 1302 deletions
diff --git a/gcc/ada/libgnat/a-cbdlli.ads b/gcc/ada/libgnat/a-cbdlli.ads index ab55086..f4086ea 100644 --- a/gcc/ada/libgnat/a-cbdlli.ads +++ b/gcc/ada/libgnat/a-cbdlli.ads @@ -57,11 +57,11 @@ is Default_Iterator => Iterate, Iterator_Element => Element_Type, Aggregate => (Empty => Empty, - Add_Unnamed => Append); - pragma Preelaborable_Initialization (List); + Add_Unnamed => Append), + Preelaborable_Initialization + => Element_Type'Preelaborable_Initialization; - type Cursor is private; - pragma Preelaborable_Initialization (Cursor); + type Cursor is private with Preelaborable_Initialization; Empty_List : constant List; diff --git a/gcc/ada/libgnat/a-cbhama.ads b/gcc/ada/libgnat/a-cbhama.ads index 8be64c8..cdd4135 100644 --- a/gcc/ada/libgnat/a-cbhama.ads +++ b/gcc/ada/libgnat/a-cbhama.ads @@ -59,12 +59,13 @@ is Default_Iterator => Iterate, Iterator_Element => Element_Type, Aggregate => (Empty => Empty, - Add_Named => Insert); + Add_Named => Insert), + Preelaborable_Initialization + => Element_Type'Preelaborable_Initialization + and + Key_Type'Preelaborable_Initialization; - pragma Preelaborable_Initialization (Map); - - type Cursor is private; - pragma Preelaborable_Initialization (Cursor); + type Cursor is private with Preelaborable_Initialization; Empty_Map : constant Map; -- Map objects declared without an initialization expression are diff --git a/gcc/ada/libgnat/a-cbhase.ads b/gcc/ada/libgnat/a-cbhase.ads index 92926c1..78b31cf 100644 --- a/gcc/ada/libgnat/a-cbhase.ads +++ b/gcc/ada/libgnat/a-cbhase.ads @@ -61,12 +61,11 @@ is Default_Iterator => Iterate, Iterator_Element => Element_Type, Aggregate => (Empty => Empty, - Add_Unnamed => Include); + Add_Unnamed => Include), + Preelaborable_Initialization + => Element_Type'Preelaborable_Initialization; - pragma Preelaborable_Initialization (Set); - - type Cursor is private; - pragma Preelaborable_Initialization (Cursor); + type Cursor is private with Preelaborable_Initialization; Empty_Set : constant Set; -- Set objects declared without an initialization expression are diff --git a/gcc/ada/libgnat/a-cbmutr.ads b/gcc/ada/libgnat/a-cbmutr.ads index c7e221a..3712039 100644 --- a/gcc/ada/libgnat/a-cbmutr.ads +++ b/gcc/ada/libgnat/a-cbmutr.ads @@ -53,11 +53,11 @@ is with Constant_Indexing => Constant_Reference, Variable_Indexing => Reference, Default_Iterator => Iterate, - Iterator_Element => Element_Type; - pragma Preelaborable_Initialization (Tree); + Iterator_Element => Element_Type, + Preelaborable_Initialization + => Element_Type'Preelaborable_Initialization; - type Cursor is private; - pragma Preelaborable_Initialization (Cursor); + type Cursor is private with Preelaborable_Initialization; Empty_Tree : constant Tree; diff --git a/gcc/ada/libgnat/a-cborma.ads b/gcc/ada/libgnat/a-cborma.ads index f87522a..9d40a51 100644 --- a/gcc/ada/libgnat/a-cborma.ads +++ b/gcc/ada/libgnat/a-cborma.ads @@ -60,12 +60,13 @@ is Default_Iterator => Iterate, Iterator_Element => Element_Type, Aggregate => (Empty => Empty, - Add_Named => Insert); + Add_Named => Insert), + Preelaborable_Initialization + => Element_Type'Preelaborable_Initialization + and + Key_Type'Preelaborable_Initialization; - pragma Preelaborable_Initialization (Map); - - type Cursor is private; - pragma Preelaborable_Initialization (Cursor); + type Cursor is private with Preelaborable_Initialization; Empty_Map : constant Map; diff --git a/gcc/ada/libgnat/a-cborse.ads b/gcc/ada/libgnat/a-cborse.ads index 06bd20f..31b8b91 100644 --- a/gcc/ada/libgnat/a-cborse.ads +++ b/gcc/ada/libgnat/a-cborse.ads @@ -59,12 +59,11 @@ is Default_Iterator => Iterate, Iterator_Element => Element_Type, Aggregate => (Empty => Empty, - Add_Unnamed => Include); + Add_Unnamed => Include), + Preelaborable_Initialization + => Element_Type'Preelaborable_Initialization; - pragma Preelaborable_Initialization (Set); - - type Cursor is private; - pragma Preelaborable_Initialization (Cursor); + type Cursor is private with Preelaborable_Initialization; Empty_Set : constant Set; diff --git a/gcc/ada/libgnat/a-cfdlli.ads b/gcc/ada/libgnat/a-cfdlli.ads index 590643e..ded496b 100644 --- a/gcc/ada/libgnat/a-cfdlli.ads +++ b/gcc/ada/libgnat/a-cfdlli.ads @@ -44,6 +44,7 @@ is pragma Assertion_Policy (Pre => Ignore); pragma Assertion_Policy (Post => Ignore); + pragma Assertion_Policy (Contract_Cases => Ignore); pragma Annotate (CodePeer, Skip_Analysis); type List (Capacity : Count_Type) is private with diff --git a/gcc/ada/libgnat/a-cfhama.ads b/gcc/ada/libgnat/a-cfhama.ads index 2b49c13..59e295d 100644 --- a/gcc/ada/libgnat/a-cfhama.ads +++ b/gcc/ada/libgnat/a-cfhama.ads @@ -69,6 +69,7 @@ is pragma Assertion_Policy (Pre => Ignore); pragma Assertion_Policy (Post => Ignore); + pragma Assertion_Policy (Contract_Cases => Ignore); pragma Annotate (CodePeer, Skip_Analysis); type Map (Capacity : Count_Type; Modulus : Hash_Type) is private with diff --git a/gcc/ada/libgnat/a-cfhase.ads b/gcc/ada/libgnat/a-cfhase.ads index 9bcd8ce..23b3b6d 100644 --- a/gcc/ada/libgnat/a-cfhase.ads +++ b/gcc/ada/libgnat/a-cfhase.ads @@ -67,6 +67,7 @@ is pragma Assertion_Policy (Pre => Ignore); pragma Assertion_Policy (Post => Ignore); + pragma Assertion_Policy (Contract_Cases => Ignore); pragma Annotate (CodePeer, Skip_Analysis); type Set (Capacity : Count_Type; Modulus : Hash_Type) is private with diff --git a/gcc/ada/libgnat/a-cfinve.ads b/gcc/ada/libgnat/a-cfinve.ads index 9b95437..bd0c334 100644 --- a/gcc/ada/libgnat/a-cfinve.ads +++ b/gcc/ada/libgnat/a-cfinve.ads @@ -60,6 +60,7 @@ is pragma Assertion_Policy (Pre => Ignore); pragma Assertion_Policy (Post => Ignore); + pragma Assertion_Policy (Contract_Cases => Ignore); pragma Annotate (CodePeer, Skip_Analysis); subtype Extended_Index is Index_Type'Base diff --git a/gcc/ada/libgnat/a-cforma.ads b/gcc/ada/libgnat/a-cforma.ads index a1cad03..048e7cb 100644 --- a/gcc/ada/libgnat/a-cforma.ads +++ b/gcc/ada/libgnat/a-cforma.ads @@ -68,6 +68,7 @@ is pragma Assertion_Policy (Pre => Ignore); pragma Assertion_Policy (Post => Ignore); + pragma Assertion_Policy (Contract_Cases => Ignore); pragma Annotate (CodePeer, Skip_Analysis); function Equivalent_Keys (Left, Right : Key_Type) return Boolean with diff --git a/gcc/ada/libgnat/a-cforse.ads b/gcc/ada/libgnat/a-cforse.ads index e1d7c91..db7c586 100644 --- a/gcc/ada/libgnat/a-cforse.ads +++ b/gcc/ada/libgnat/a-cforse.ads @@ -64,6 +64,7 @@ is pragma Assertion_Policy (Pre => Ignore); pragma Assertion_Policy (Post => Ignore); + pragma Assertion_Policy (Contract_Cases => Ignore); pragma Annotate (CodePeer, Skip_Analysis); function Equivalent_Elements (Left, Right : Element_Type) return Boolean diff --git a/gcc/ada/libgnat/a-chahan.adb b/gcc/ada/libgnat/a-chahan.adb index 827794c..411d485 100644 --- a/gcc/ada/libgnat/a-chahan.adb +++ b/gcc/ada/libgnat/a-chahan.adb @@ -29,11 +29,19 @@ -- -- ------------------------------------------------------------------------------ +-- Loop invariants in this unit are meant for analysis only, not for run-time +-- checking, as it would be too costly otherwise. This is enforced by setting +-- the assertion policy to Ignore. + +pragma Assertion_Policy (Loop_Invariant => Ignore); + with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; with Ada.Strings.Maps; use Ada.Strings.Maps; with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; -package body Ada.Characters.Handling is +package body Ada.Characters.Handling + with SPARK_Mode +is ------------------------------------ -- Character Classification Table -- @@ -299,9 +307,7 @@ package body Ada.Characters.Handling is ------------------ function Is_Character (Item : Wide_Character) return Boolean is - begin - return Wide_Character'Pos (Item) < 256; - end Is_Character; + (Wide_Character'Pos (Item) < 256); ---------------- -- Is_Control -- @@ -344,9 +350,7 @@ package body Ada.Characters.Handling is ---------------- function Is_ISO_646 (Item : Character) return Boolean is - begin - return Item in ISO_646; - end Is_ISO_646; + (Item in ISO_646); -- Note: much more efficient coding of the following function is possible -- by testing several 16#80# bits in a complete word in a single operation @@ -357,6 +361,8 @@ package body Ada.Characters.Handling is if Item (J) not in ISO_646 then return False; end if; + pragma Loop_Invariant + (for all K in Item'First .. J => Is_ISO_646 (Item (K))); end loop; return True; @@ -456,6 +462,8 @@ package body Ada.Characters.Handling is if Wide_Character'Pos (Item (J)) >= 256 then return False; end if; + pragma Loop_Invariant + (for all K in Item'First .. J => Is_Character (Item (K))); end loop; return True; @@ -475,15 +483,18 @@ package body Ada.Characters.Handling is -------------- function To_Basic (Item : Character) return Character is - begin - return Value (Basic_Map, Item); - end To_Basic; + (Value (Basic_Map, Item)); function To_Basic (Item : String) return String is begin - return Result : String (1 .. Item'Length) do + return Result : String (1 .. Item'Length) with Relaxed_Initialization do for J in Item'Range loop Result (J - (Item'First - 1)) := Value (Basic_Map, Item (J)); + pragma Loop_Invariant + (Result (1 .. J - Item'First + 1)'Initialized); + pragma Loop_Invariant + (for all K in Item'First .. J => + Result (K - (Item'First - 1)) = To_Basic (Item (K))); end loop; end return; end To_Basic; @@ -511,24 +522,25 @@ package body Ada.Characters.Handling is function To_ISO_646 (Item : Character; Substitute : ISO_646 := ' ') return ISO_646 - is - begin - return (if Item in ISO_646 then Item else Substitute); - end To_ISO_646; + is (if Item in ISO_646 then Item else Substitute); function To_ISO_646 (Item : String; Substitute : ISO_646 := ' ') return String is - Result : String (1 .. Item'Length); - begin - for J in Item'Range loop - Result (J - (Item'First - 1)) := - (if Item (J) in ISO_646 then Item (J) else Substitute); - end loop; - - return Result; + return Result : String (1 .. Item'Length) with Relaxed_Initialization do + for J in Item'Range loop + Result (J - (Item'First - 1)) := + (if Item (J) in ISO_646 then Item (J) else Substitute); + pragma Loop_Invariant + (Result (1 .. J - Item'First + 1)'Initialized); + pragma Loop_Invariant + (for all K in Item'First .. J => + Result (K - (Item'First - 1)) = + To_ISO_646 (Item (K), Substitute)); + end loop; + end return; end To_ISO_646; -------------- @@ -536,15 +548,18 @@ package body Ada.Characters.Handling is -------------- function To_Lower (Item : Character) return Character is - begin - return Value (Lower_Case_Map, Item); - end To_Lower; + (Value (Lower_Case_Map, Item)); function To_Lower (Item : String) return String is begin - return Result : String (1 .. Item'Length) do + return Result : String (1 .. Item'Length) with Relaxed_Initialization do for J in Item'Range loop Result (J - (Item'First - 1)) := Value (Lower_Case_Map, Item (J)); + pragma Loop_Invariant + (Result (1 .. J - Item'First + 1)'Initialized); + pragma Loop_Invariant + (for all K in Item'First .. J => + Result (K - (Item'First - 1)) = To_Lower (Item (K))); end loop; end return; end To_Lower; @@ -557,34 +572,40 @@ package body Ada.Characters.Handling is (Item : Wide_String; Substitute : Character := ' ') return String is - Result : String (1 .. Item'Length); - begin - for J in Item'Range loop - Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute); - end loop; - - return Result; + return Result : String (1 .. Item'Length) with Relaxed_Initialization do + for J in Item'Range loop + Result (J - (Item'First - 1)) := + To_Character (Item (J), Substitute); + pragma Loop_Invariant + (Result (1 .. J - (Item'First - 1))'Initialized); + pragma Loop_Invariant + (for all K in Item'First .. J => + Result (K - (Item'First - 1)) = + To_Character (Item (K), Substitute)); + end loop; + end return; end To_String; -------------- -- To_Upper -- -------------- - function To_Upper - (Item : Character) return Character - is - begin - return Value (Upper_Case_Map, Item); - end To_Upper; + function To_Upper (Item : Character) return Character is + (Value (Upper_Case_Map, Item)); function To_Upper (Item : String) return String is begin - return Result : String (1 .. Item'Length) do + return Result : String (1 .. Item'Length) with Relaxed_Initialization do for J in Item'Range loop Result (J - (Item'First - 1)) := Value (Upper_Case_Map, Item (J)); + pragma Loop_Invariant + (Result (1 .. J - Item'First + 1)'Initialized); + pragma Loop_Invariant + (for all K in Item'First .. J => + Result (K - (Item'First - 1)) = To_Upper (Item (K))); end loop; end return; end To_Upper; @@ -607,14 +628,19 @@ package body Ada.Characters.Handling is function To_Wide_String (Item : String) return Wide_String is - Result : Wide_String (1 .. Item'Length); - begin - for J in Item'Range loop - Result (J - (Item'First - 1)) := To_Wide_Character (Item (J)); - end loop; - - return Result; + return Result : Wide_String (1 .. Item'Length) + with Relaxed_Initialization + do + for J in Item'Range loop + Result (J - (Item'First - 1)) := To_Wide_Character (Item (J)); + pragma Loop_Invariant + (Result (1 .. J - (Item'First - 1))'Initialized); + pragma Loop_Invariant + (for all K in Item'First .. J => + Result (K - (Item'First - 1)) = To_Wide_Character (Item (K))); + end loop; + end return; end To_Wide_String; end Ada.Characters.Handling; diff --git a/gcc/ada/libgnat/a-chahan.ads b/gcc/ada/libgnat/a-chahan.ads index 2f93e7c..093237d 100644 --- a/gcc/ada/libgnat/a-chahan.ads +++ b/gcc/ada/libgnat/a-chahan.ads @@ -33,7 +33,16 @@ -- -- ------------------------------------------------------------------------------ -package Ada.Characters.Handling is +-- Postconditions in this unit are meant for analysis only, not for run-time +-- checking, in order not to slow down the execution of these functions. + +pragma Assertion_Policy (Post => Ignore); + +with Ada.Characters.Latin_1; + +package Ada.Characters.Handling + with SPARK_Mode +is pragma Pure; -- In accordance with Ada 2005 AI-362 @@ -41,54 +50,296 @@ package Ada.Characters.Handling is -- Character Classification Functions -- ---------------------------------------- - function Is_Control (Item : Character) return Boolean; - function Is_Graphic (Item : Character) return Boolean; - function Is_Letter (Item : Character) return Boolean; - function Is_Lower (Item : Character) return Boolean; - function Is_Upper (Item : Character) return Boolean; - function Is_Basic (Item : Character) return Boolean; - function Is_Digit (Item : Character) return Boolean; + -- In the description below for each function that returns a Boolean + -- result, the effect is described in terms of the conditions under which + -- the value True is returned. If these conditions are not met, then the + -- function returns False. + -- + -- Each of the following classification functions has a formal Character + -- parameter, Item, and returns a Boolean result. + + function Is_Control (Item : Character) return Boolean + with + Post => Is_Control'Result = + (Character'Pos (Item) in 0 .. 31 | 127 .. 159); + -- True if Item is a control character. A control character is a character + -- whose position is in one of the ranges 0..31 or 127..159. + + function Is_Graphic (Item : Character) return Boolean + with + Post => Is_Graphic'Result = + (Character'Pos (Item) in 32 .. 126 | 160 .. 255); + -- True if Item is a graphic character. A graphic character is a character + -- whose position is in one of the ranges 32..126 or 160..255. + + function Is_Letter (Item : Character) return Boolean + with + Post => Is_Letter'Result = + (Item in 'A' .. 'Z' | 'a' .. 'z' + or else Character'Pos (Item) in 192 .. 214 | 216 .. 246 | 248 .. 255); + -- True if Item is a letter. A letter is a character that is in one of the + -- ranges 'A'..'Z' or 'a'..'z', or whose position is in one of the ranges + -- 192..214, 216..246, or 248..255. + + function Is_Lower (Item : Character) return Boolean + with + Post => Is_Lower'Result = + (Item in 'a' .. 'z' + or else Character'Pos (Item) in 223 .. 246 | 248 .. 255); + -- True if Item is a lower-case letter. A lower-case letter is a character + -- that is in the range 'a'..'z', or whose position is in one of the ranges + -- 223..246 or 248..255. + + function Is_Upper (Item : Character) return Boolean + with + Post => Is_Upper'Result = + (Item in 'A' .. 'Z' + or else Character'Pos (Item) in 192 .. 214 | 216 .. 222); + -- True if Item is an upper-case letter. An upper-case letter is a + -- character that is in the range 'A'..'Z' or whose position is in one + -- of the ranges 192..214 or 216..222. + + function Is_Basic (Item : Character) return Boolean + with + Post => Is_Basic'Result = + (Item in 'A' .. 'Z' + | 'a' .. 'z' + | Latin_1.UC_AE_Diphthong + | Latin_1.LC_AE_Diphthong + | Latin_1.UC_Icelandic_Eth + | Latin_1.LC_Icelandic_Eth + | Latin_1.UC_Icelandic_Thorn + | Latin_1.LC_Icelandic_Thorn + | Latin_1.LC_German_Sharp_S); + -- True if Item is a basic letter. A basic letter is a character that + -- is in one of the ranges 'A'..'Z' and 'a'..'z', or that is one of + -- the following: UC_AE_Diphthong, LC_AE_Diphthong, UC_Icelandic_Eth, + -- LC_Icelandic_Eth, UC_Icelandic_Thorn, LC_Icelandic_Thorn, or + -- LC_German_Sharp_S. + + function Is_Digit (Item : Character) return Boolean + with + Post => Is_Digit'Result = (Item in '0' .. '9'); + -- True if Item is a decimal digit. A decimal digit is a character in the + -- range '0'..'9'. + function Is_Decimal_Digit (Item : Character) return Boolean renames Is_Digit; - function Is_Hexadecimal_Digit (Item : Character) return Boolean; - function Is_Alphanumeric (Item : Character) return Boolean; - function Is_Special (Item : Character) return Boolean; - function Is_Line_Terminator (Item : Character) return Boolean; - function Is_Mark (Item : Character) return Boolean; - function Is_Other_Format (Item : Character) return Boolean; - function Is_Punctuation_Connector (Item : Character) return Boolean; - function Is_Space (Item : Character) return Boolean; - function Is_NFKC (Item : Character) return Boolean; + + function Is_Hexadecimal_Digit (Item : Character) return Boolean + with + Post => Is_Hexadecimal_Digit'Result = + (Is_Decimal_Digit (Item) or Item in 'A' .. 'F' | 'a' .. 'f'); + -- True if Item is a hexadecimal digit. A hexadecimal digit is a character + -- that is either a decimal digit or that is in one of the ranges 'A'..'F' + -- or 'a'..'f'. + + function Is_Alphanumeric (Item : Character) return Boolean + with + Post => Is_Alphanumeric'Result = + (Is_Letter (Item) or Is_Decimal_Digit (Item)); + -- True if Item is an alphanumeric character. An alphanumeric character is + -- a character that is either a letter or a decimal digit. + + function Is_Special (Item : Character) return Boolean + with + Post => Is_Special'Result = + (Is_Graphic (Item) and not Is_Alphanumeric (Item)); + -- True if Item is a special graphic character. A special graphic character + -- is a graphic character that is not alphanumeric. + + function Is_Line_Terminator (Item : Character) return Boolean + with + Post => Is_Line_Terminator'Result = + (Character'Pos (Item) in 10 .. 13 | 133); + -- True if Item is a character with position 10..13 (Line_Feed, + -- Line_Tabulation, Form_Feed, Carriage_Return) or 133 (Next_Line). + + function Is_Mark (Item : Character) return Boolean + with + Post => Is_Mark'Result = False; + -- Never True (no value of type Character has categories Mark, Non-Spacing + -- or Mark, Spacing Combining). + + function Is_Other_Format (Item : Character) return Boolean + with + Post => Is_Other_Format'Result = (Character'Pos (Item) = 173); + -- True if Item is a character with position 173 (Soft_Hyphen). + + function Is_Punctuation_Connector (Item : Character) return Boolean + with + Post => Is_Punctuation_Connector'Result = + (Character'Pos (Item) = 95); + -- True if Item is a character with position 95 ('_', known as Low_Line or + -- Underscore). + + function Is_Space (Item : Character) return Boolean + with + Post => Is_Space'Result = (Character'Pos (Item) in 32 | 160); + -- True if Item is a character with position 32 (' ') or 160 + -- (No_Break_Space). + + function Is_NFKC (Item : Character) return Boolean + with + Post => Is_NFKC'Result = + (Character'Pos (Item) not in + 160 | 168 | 170 | 175 | 178 | 179 | 180 + | 181 | 184 | 185 | 186 | 188 | 189 | 190); + -- True if Item could be present in a string normalized to Normalization + -- Form KC (as defined by Clause 21 of ISO/IEC 10646:2017); this includes + -- all characters except those with positions 160, 168, 170, 175, 178, 179, + -- 180, 181, 184, 185, 186, 188, 189, and 190. --------------------------------------------------- -- Conversion Functions for Character and String -- --------------------------------------------------- - function To_Lower (Item : Character) return Character; - function To_Upper (Item : Character) return Character; - function To_Basic (Item : Character) return Character; + -- Each of the names To_Lower, To_Upper, and To_Basic refers to two + -- functions: one that converts from Character to Character, and + -- the other that converts from String to String. The result of each + -- Character-to-Character function is described below, in terms of + -- the conversion applied to Item, its formal Character parameter. The + -- result of each String-to-String conversion is obtained by applying + -- to each element of the function's String parameter the corresponding + -- Character-to-Character conversion; the result is the null String if the + -- value of the formal parameter is the null String. The lower bound of the + -- result String is 1. + + function To_Lower (Item : Character) return Character + with + Post => To_Lower'Result = + (if Is_Upper (Item) then + Character'Val (Character'Pos (Item) + + (if Item in 'A' .. 'Z' then + Character'Pos ('a') - Character'Pos ('A') + else + Character'Pos (Latin_1.LC_A_Grave) + - Character'Pos (Latin_1.UC_A_Grave))) + else + Item); + -- Returns the corresponding lower-case value for Item if Is_Upper(Item), + -- and returns Item otherwise. - function To_Lower (Item : String) return String; - function To_Upper (Item : String) return String; - function To_Basic (Item : String) return String; + function To_Upper (Item : Character) return Character + with + Post => To_Upper'Result = + (if Is_Lower (Item) + and then Item not in Latin_1.LC_German_Sharp_S + | Latin_1.LC_Y_Diaeresis + then + Character'Val (Character'Pos (Item) + + (if Item in 'A' .. 'Z' then + Character'Pos ('A') - Character'Pos ('a') + else + Character'Pos (Latin_1.UC_A_Grave) + - Character'Pos (Latin_1.LC_A_Grave))) + else + Item); + -- Returns the corresponding upper-case value for Item if Is_Lower(Item) + -- and Item has an upper-case form, and returns Item otherwise. The lower + -- case letters LC_German_Sharp_S and LC_Y_Diaeresis do not have upper case + -- forms. + + function To_Basic (Item : Character) return Character + with + Post => To_Basic'Result = + (if not Is_Letter (Item) or else Is_Basic (Item) then + Item + else + (case Item is + when Latin_1.UC_A_Grave .. Latin_1.UC_A_Ring => 'A', + when Latin_1.UC_C_Cedilla => 'C', + when Latin_1.UC_E_Grave .. Latin_1.UC_E_Diaeresis => 'E', + when Latin_1.UC_I_Grave .. Latin_1.UC_I_Diaeresis => 'I', + when Latin_1.UC_N_Tilde => 'N', + when Latin_1.UC_O_Grave .. Latin_1.UC_O_Diaeresis => 'O', + when Latin_1.UC_O_Oblique_Stroke => 'O', + when Latin_1.UC_U_Grave .. Latin_1.UC_U_Diaeresis => 'U', + when Latin_1.UC_Y_Acute => 'Y', + when Latin_1.LC_A_Grave .. Latin_1.LC_A_Ring => 'a', + when Latin_1.LC_C_Cedilla => 'c', + when Latin_1.LC_E_Grave .. Latin_1.LC_E_Diaeresis => 'e', + when Latin_1.LC_I_Grave .. Latin_1.LC_I_Diaeresis => 'i', + when Latin_1.LC_N_Tilde => 'n', + when Latin_1.LC_O_Grave .. Latin_1.LC_O_Diaeresis => 'o', + when Latin_1.LC_O_Oblique_Stroke => 'o', + when Latin_1.LC_U_Grave .. Latin_1.LC_U_Diaeresis => 'u', + when Latin_1.LC_Y_Acute => 'y', + when Latin_1.LC_Y_Diaeresis => 'y', + when others => raise Program_Error)); + -- Returns the letter corresponding to Item but with no diacritical mark, + -- if Item is a letter but not a basic letter; returns Item otherwise. + + function To_Lower (Item : String) return String + with + Post => To_Lower'Result'First = 1 + and then To_Lower'Result'Length = Item'Length + and then + (for all J in To_Lower'Result'Range => + To_Lower'Result (J) = To_Lower (Item (Item'First + (J - 1)))); + + function To_Upper (Item : String) return String + with + Post => To_Upper'Result'First = 1 + and then To_Upper'Result'Length = Item'Length + and then + (for all J in To_Upper'Result'Range => + To_Upper'Result (J) = To_Upper (Item (Item'First + (J - 1)))); + + function To_Basic (Item : String) return String + with + Post => To_Basic'Result'First = 1 + and then To_Basic'Result'Length = Item'Length + and then + (for all J in To_Basic'Result'Range => + To_Basic'Result (J) = To_Basic (Item (Item'First + (J - 1)))); ---------------------------------------------------------------------- -- Classifications of and Conversions Between Character and ISO 646 -- ---------------------------------------------------------------------- + -- The following set of functions test for membership in the ISO 646 + -- character range, or convert between ISO 646 and Character. + subtype ISO_646 is Character range Character'Val (0) .. Character'Val (127); - function Is_ISO_646 (Item : Character) return Boolean; - function Is_ISO_646 (Item : String) return Boolean; + function Is_ISO_646 (Item : Character) return Boolean + with + Post => Is_ISO_646'Result = (Item in ISO_646); + -- The function whose formal parameter, Item, is of type Character returns + -- True if Item is in the subtype ISO_646. + + function Is_ISO_646 (Item : String) return Boolean + with + Post => Is_ISO_646'Result = + (for all J in Item'Range => Is_ISO_646 (Item (J))); + -- The function whose formal parameter, Item, is of type String returns + -- True if Is_ISO_646(Item(I)) is True for each I in Item'Range. function To_ISO_646 (Item : Character; - Substitute : ISO_646 := ' ') return ISO_646; + Substitute : ISO_646 := ' ') return ISO_646 + with + Post => To_ISO_646'Result = + (if Is_ISO_646 (Item) then Item else Substitute); + -- The function whose first formal parameter, Item, is of type Character + -- returns Item if Is_ISO_646(Item), and returns the Substitute ISO_646 + -- character otherwise. function To_ISO_646 (Item : String; - Substitute : ISO_646 := ' ') return String; + Substitute : ISO_646 := ' ') return String + with + Post => To_ISO_646'Result'First = 1 + and then To_ISO_646'Result'Length = Item'Length + and then + (for all J in To_ISO_646'Result'Range => + To_ISO_646'Result (J) = + To_ISO_646 (Item (Item'First + (J - 1)), Substitute)); + -- The function whose first formal parameter, Item, is of type String + -- returns the String whose Range is 1..Item'Length and each of whose + -- elements is given by To_ISO_646 of the corresponding element in Item. ------------------------------------------------------ -- Classifications of Wide_Character and Characters -- @@ -103,8 +354,18 @@ package Ada.Characters.Handling is -- We do however have to flag these if the pragma No_Obsolescent_Features -- restriction is active (see Restrict.Check_Obsolescent_2005_Entity). - function Is_Character (Item : Wide_Character) return Boolean; - function Is_String (Item : Wide_String) return Boolean; + function Is_Character (Item : Wide_Character) return Boolean + with + Post => Is_Character'Result = + (Wide_Character'Pos (Item) <= Character'Pos (Character'Last)); + -- Returns True if Wide_Character'Pos(Item) <= + -- Character'Pos(Character'Last). + + function Is_String (Item : Wide_String) return Boolean + with + Post => Is_String'Result = + (for all I in Item'Range => Is_Character (Item (I))); + -- Returns True if Is_Character(Item(I)) is True for each I in Item'Range. ------------------------------------------------------ -- Conversions between Wide_Character and Character -- @@ -121,17 +382,49 @@ package Ada.Characters.Handling is function To_Character (Item : Wide_Character; - Substitute : Character := ' ') return Character; + Substitute : Character := ' ') return Character + with + Post => To_Character'Result = + (if Is_Character (Item) then + Character'Val (Wide_Character'Pos (Item)) + else + Substitute); + -- Returns the Character corresponding to Item if Is_Character(Item), and + -- returns the Substitute Character otherwise. function To_String (Item : Wide_String; - Substitute : Character := ' ') return String; + Substitute : Character := ' ') return String + with + Post => To_String'Result'First = 1 + and then To_String'Result'Length = Item'Length + and then + (for all J in To_String'Result'Range => + To_String'Result (J) = + To_Character (Item (Item'First + (J - 1)), Substitute)); + -- Returns the String whose range is 1..Item'Length and each of whose + -- elements is given by To_Character of the corresponding element in Item. function To_Wide_Character - (Item : Character) return Wide_Character; + (Item : Character) return Wide_Character + with + Post => To_Wide_Character'Result = + Wide_Character'Val (Character'Pos (Item)); + -- Returns the Wide_Character X such that Character'Pos(Item) = + -- Wide_Character'Pos (X). function To_Wide_String - (Item : String) return Wide_String; + (Item : String) return Wide_String + with + Post => To_Wide_String'Result'First = 1 + and then To_Wide_String'Result'Length = Item'Length + and then + (for all J in To_Wide_String'Result'Range => + To_Wide_String'Result (J) = + To_Wide_Character (Item (Item'First + (J - 1)))); + -- Returns the Wide_String whose range is 1..Item'Length and each of whose + -- elements is given by To_Wide_Character of the corresponding element in + -- Item. private pragma Inline (Is_Alphanumeric); diff --git a/gcc/ada/libgnat/a-coboho.ads b/gcc/ada/libgnat/a-coboho.ads index 086f194..44269f0 100644 --- a/gcc/ada/libgnat/a-coboho.ads +++ b/gcc/ada/libgnat/a-coboho.ads @@ -70,7 +70,9 @@ package Ada.Containers.Bounded_Holders is -- System.Storage_Unit; e.g. creating Holders from 5-bit objects won't -- work. - type Holder is private; + type Holder is private + with Preelaborable_Initialization + => Element_Type'Preelaborable_Initialization; function "=" (Left, Right : Holder) return Boolean; diff --git a/gcc/ada/libgnat/a-cobove.ads b/gcc/ada/libgnat/a-cobove.ads index 67c4419..5f3e1a7 100644 --- a/gcc/ada/libgnat/a-cobove.ads +++ b/gcc/ada/libgnat/a-cobove.ads @@ -63,12 +63,11 @@ package Ada.Containers.Bounded_Vectors is Aggregate => (Empty => Empty, Add_Unnamed => Append, New_Indexed => New_Vector, - Assign_Indexed => Replace_Element); + Assign_Indexed => Replace_Element), + Preelaborable_Initialization + => Element_Type'Preelaborable_Initialization; - pragma Preelaborable_Initialization (Vector); - - type Cursor is private; - pragma Preelaborable_Initialization (Cursor); + type Cursor is private with Preelaborable_Initialization; Empty_Vector : constant Vector; diff --git a/gcc/ada/libgnat/a-cofove.ads b/gcc/ada/libgnat/a-cofove.ads index a4ed7e5..6d3f486 100644 --- a/gcc/ada/libgnat/a-cofove.ads +++ b/gcc/ada/libgnat/a-cofove.ads @@ -50,6 +50,7 @@ is pragma Assertion_Policy (Pre => Ignore); pragma Assertion_Policy (Post => Ignore); + pragma Assertion_Policy (Contract_Cases => Ignore); pragma Annotate (CodePeer, Skip_Analysis); subtype Extended_Index is Index_Type'Base diff --git a/gcc/ada/libgnat/a-except.adb b/gcc/ada/libgnat/a-except.adb index c332afa..5933928 100644 --- a/gcc/ada/libgnat/a-except.adb +++ b/gcc/ada/libgnat/a-except.adb @@ -629,6 +629,96 @@ package body Ada.Exceptions is pragma No_Return (Rcheck_CE_Invalid_Data_Ext); pragma No_Return (Rcheck_CE_Range_Check_Ext); + -- Make all of these procedures callable from strub contexts. + -- These attributes are not visible to callers; they are made + -- visible in trans.c:build_raise_check. + + pragma Machine_Attribute (Rcheck_CE_Access_Check, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_CE_Null_Access_Parameter, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_CE_Discriminant_Check, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_CE_Divide_By_Zero, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_CE_Explicit_Raise, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_CE_Index_Check, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_CE_Invalid_Data, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_CE_Length_Check, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_CE_Null_Exception_Id, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_CE_Null_Not_Allowed, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_CE_Overflow_Check, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_CE_Partition_Check, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_CE_Range_Check, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_CE_Tag_Check, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Access_Before_Elaboration, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Accessibility_Check, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Address_Of_Intrinsic, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Aliased_Parameters, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_All_Guards_Closed, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Bad_Predicated_Generic_Type, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Build_In_Place_Mismatch, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Current_Task_In_Entry_Body, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Duplicated_Entry_Address, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Explicit_Raise, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Implicit_Return, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Misaligned_Address_Value, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Missing_Return, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Non_Transportable_Actual, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Overlaid_Controlled_Object, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Potentially_Blocking_Operation, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Stream_Operation_Not_Allowed, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Stubbed_Subprogram_Called, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Unchecked_Union_Restriction, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_PE_Finalize_Raised_Exception, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_SE_Empty_Storage_Pool, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_SE_Explicit_Raise, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_SE_Infinite_Recursion, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_SE_Object_Too_Large, + "strub", "callable"); + + pragma Machine_Attribute (Rcheck_CE_Access_Check_Ext, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_CE_Index_Check_Ext, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_CE_Invalid_Data_Ext, + "strub", "callable"); + pragma Machine_Attribute (Rcheck_CE_Range_Check_Ext, + "strub", "callable"); + --------------------------------------------- -- Reason Strings for Run-Time Check Calls -- --------------------------------------------- diff --git a/gcc/ada/libgnat/a-except.ads b/gcc/ada/libgnat/a-except.ads index 2b27adb..1608e79 100644 --- a/gcc/ada/libgnat/a-except.ads +++ b/gcc/ada/libgnat/a-except.ads @@ -184,6 +184,15 @@ private -- Raise_Exception_Always if it can determine this is the case. The Export -- allows this routine to be accessed from Pure units. + -- Make these callable from strub contexts. + pragma Machine_Attribute (Raise_Exception_Always, + "strub", "callable"); + pragma Machine_Attribute (Raise_Exception, + "strub", "callable"); + -- This property should arguably be visible to callers, but let's + -- keep it private for now. In practice, it doesn't matter, since + -- it's only checked in the back end. + procedure Raise_From_Controlled_Operation (X : Exception_Occurrence); pragma No_Return (Raise_From_Controlled_Operation); pragma Export diff --git a/gcc/ada/libgnat/a-strbou.adb b/gcc/ada/libgnat/a-strbou.adb index 61b3d73..01a2002 100644 --- a/gcc/ada/libgnat/a-strbou.adb +++ b/gcc/ada/libgnat/a-strbou.adb @@ -29,7 +29,7 @@ -- -- ------------------------------------------------------------------------------ -package body Ada.Strings.Bounded is +package body Ada.Strings.Bounded with SPARK_Mode is package body Generic_Bounded_Length is diff --git a/gcc/ada/libgnat/a-strbou.ads b/gcc/ada/libgnat/a-strbou.ads index f0cf7b2..e820184 100644 --- a/gcc/ada/libgnat/a-strbou.ads +++ b/gcc/ada/libgnat/a-strbou.ads @@ -33,25 +33,41 @@ -- -- ------------------------------------------------------------------------------ --- Preconditions in this unit are meant for analysis only, not for run-time --- checking, so that the expected exceptions are raised. This is enforced by --- setting the corresponding assertion policy to Ignore. - -pragma Assertion_Policy (Pre => Ignore); - -with Ada.Strings.Maps; +-- The language-defined package Strings.Bounded provides a generic package +-- each of whose instances yields a private type Bounded_String and a set +-- of operations. An object of a particular Bounded_String type represents +-- a String whose low bound is 1 and whose length can vary conceptually +-- between 0 and a maximum size established at the generic instantiation. The +-- subprograms for fixed-length string handling are either overloaded directly +-- for Bounded_String, or are modified as needed to reflect the variability in +-- length. Additionally, since the Bounded_String type is private, appropriate +-- constructor and selector operations are provided. + +with Ada.Strings.Maps; use type Ada.Strings.Maps.Character_Mapping_Function; with Ada.Strings.Superbounded; +with Ada.Strings.Search; -package Ada.Strings.Bounded is +package Ada.Strings.Bounded with SPARK_Mode is pragma Preelaborate; generic Max : Positive; -- Maximum length of a Bounded_String - package Generic_Bounded_Length with - Initial_Condition => Length (Null_Bounded_String) = 0 + package Generic_Bounded_Length with SPARK_Mode, + Initial_Condition => Length (Null_Bounded_String) = 0, + Abstract_State => null is + -- Preconditions in this unit are meant for analysis only, not for + -- run-time checking, so that the expected exceptions are raised. This + -- is enforced by setting the corresponding assertion policy to Ignore. + -- Postconditions and contract cases should not be executed at runtime + -- as well, in order not to slow down the execution of these functions. + + pragma Assertion_Policy (Pre => Ignore, + Post => Ignore, + Contract_Cases => Ignore, + Ghost => Ignore); Max_Length : constant Positive := Max; @@ -59,11 +75,16 @@ package Ada.Strings.Bounded is pragma Preelaborable_Initialization (Bounded_String); Null_Bounded_String : constant Bounded_String; + -- Null_Bounded_String represents the null string. If an object of type + -- Bounded_String is not otherwise initialized, it will be initialized + -- to the same value as Null_Bounded_String. subtype Length_Range is Natural range 0 .. Max_Length; function Length (Source : Bounded_String) return Length_Range with Global => null; + -- The Length function returns the length of the string represented by + -- Source. -------------------------------------------------------- -- Conversion, Concatenation, and Selection Functions -- @@ -73,163 +94,466 @@ package Ada.Strings.Bounded is (Source : String; Drop : Truncation := Error) return Bounded_String with - Pre => (if Source'Length > Max_Length then Drop /= Error), - Post => - Length (To_Bounded_String'Result) - = Natural'Min (Max_Length, Source'Length), - Global => null; + Pre => (if Source'Length > Max_Length then Drop /= Error), + Contract_Cases => + (Source'Length <= Max_Length + => + To_String (To_Bounded_String'Result) = Source, + + Source'Length > Max_Length and then Drop = Left + => + To_String (To_Bounded_String'Result) = + Source (Source'Last - Max_Length + 1 .. Source'Last), + + others -- Drop = Right + => + To_String (To_Bounded_String'Result) = + Source (Source'First .. Source'First - 1 + Max_Length)); + -- If Source'Length <= Max_Length, then this function returns a + -- Bounded_String that represents Source. Otherwise, the effect + -- depends on the value of Drop: + -- + -- * If Drop=Left, then the result is a Bounded_String that represents + -- the string comprising the rightmost Max_Length characters of + -- Source. + -- + -- * If Drop=Right, then the result is a Bounded_String that represents + -- the string comprising the leftmost Max_Length characters of Source. + -- + -- * If Drop=Error, then Strings.Length_Error is propagated. function To_String (Source : Bounded_String) return String with - Post => To_String'Result'Length = Length (Source), Global => null; + -- To_String returns the String value with lower bound 1 + -- represented by Source. If B is a Bounded_String, then + -- B = To_Bounded_String(To_String(B)). procedure Set_Bounded_String (Target : out Bounded_String; Source : String; Drop : Truncation := Error) with - Pre => (if Source'Length > Max_Length then Drop /= Error), - Post => Length (Target) = Natural'Min (Max_Length, Source'Length), - Global => null; + Pre => (if Source'Length > Max_Length then Drop /= Error), + Contract_Cases => + (Source'Length <= Max_Length + => + To_String (Target) = Source, + + Source'Length > Max_Length and then Drop = Left + => + To_String (Target) = + Source (Source'Last - Max_Length + 1 .. Source'Last), + + others -- Drop = Right + => + To_String (Target) = + Source (Source'First .. Source'First - 1 + Max_Length)); pragma Ada_05 (Set_Bounded_String); + -- Equivalent to Target := To_Bounded_String (Source, Drop); + + -- Each of the Append functions returns a Bounded_String obtained by + -- concatenating the string or character given or represented by one + -- of the parameters, with the string or character given or represented + -- by the other parameter, and applying To_Bounded_String to the + -- concatenation result string, with Drop as provided to the Append + -- function. function Append (Left : Bounded_String; Right : Bounded_String; Drop : Truncation := Error) return Bounded_String with - Pre => + Pre => (if Length (Left) > Max_Length - Length (Right) then Drop /= Error), - Post => - Length (Append'Result) - = Natural'Min (Max_Length, Length (Left) + Length (Right)), - Global => null; + Contract_Cases => + (Length (Left) <= Max_Length - Length (Right) + => + Length (Append'Result) = Length (Left) + Length (Right) + and then + Slice (Append'Result, 1, Length (Left)) = To_String (Left) + and then + (if Length (Right) > 0 then + Slice (Append'Result, + Length (Left) + 1, Length (Append'Result)) = + To_String (Right)), + + Length (Left) > Max_Length - Length (Right) + and then Drop = Strings.Left + => + Length (Append'Result) = Max_Length + and then + (if Length (Right) < Max_Length then + Slice (Append'Result, 1, Max_Length - Length (Right)) = + Slice (Left, + Length (Left) - Max_Length + Length (Right) + 1, + Length (Left))) + and then + Slice (Append'Result, + Max_Length - Length (Right) + 1, Max_Length) = + To_String (Right), + + others -- Drop = Right + => + Length (Append'Result) = Max_Length + and then + Slice (Append'Result, 1, Length (Left)) = To_String (Left) + and then + (if Length (Left) < Max_Length then + Slice (Append'Result, Length (Left) + 1, Max_Length) = + Slice (Right, 1, Max_Length - Length (Left)))); function Append (Left : Bounded_String; Right : String; Drop : Truncation := Error) return Bounded_String with - Pre => + Pre => (if Right'Length > Max_Length - Length (Left) then Drop /= Error), - Post => - Length (Append'Result) - = Natural'Min (Max_Length, Length (Left) + Right'Length), - Global => null; - + Contract_Cases => + (Length (Left) <= Max_Length - Right'Length + => + Length (Append'Result) = Length (Left) + Right'Length + and then + Slice (Append'Result, 1, Length (Left)) = To_String (Left) + and then + (if Right'Length > 0 then + Slice (Append'Result, + Length (Left) + 1, Length (Append'Result)) = + Right), + + Length (Left) > Max_Length - Right'Length + and then Drop = Strings.Left + => + Length (Append'Result) = Max_Length + and then + (if Right'Length < Max_Length then + + -- The result is the end of Left followed by Right + + Slice (Append'Result, 1, Max_Length - Right'Length) = + Slice (Left, + Length (Left) - Max_Length + Right'Length + 1, + Length (Left)) + and then + Slice (Append'Result, + Max_Length - Right'Length + 1, Max_Length) = + Right + else + -- The result is the last Max_Length characters of Right + + To_String (Append'Result) = + Right (Right'Last - Max_Length + 1 .. Right'Last)), + + others -- Drop = Right + => + Length (Append'Result) = Max_Length + and then + Slice (Append'Result, 1, Length (Left)) = To_String (Left) + and then + (if Length (Left) < Max_Length then + Slice (Append'Result, Length (Left) + 1, Max_Length) = + Right (Right'First + .. Max_Length - Length (Left) - 1 + Right'First))); function Append (Left : String; Right : Bounded_String; Drop : Truncation := Error) return Bounded_String with - Pre => + Pre => (if Left'Length > Max_Length - Length (Right) then Drop /= Error), - Post => - Length (Append'Result) - = Natural'Min (Max_Length, Left'Length + Length (Right)), - Global => null; + Contract_Cases => + (Left'Length <= Max_Length - Length (Right) + => + Length (Append'Result) = Left'Length + Length (Right) + and then Slice (Append'Result, 1, Left'Length) = Left + and then + (if Length (Right) > 0 then + Slice (Append'Result, + Left'Length + 1, Length (Append'Result)) = + To_String (Right)), + + Left'Length > Max_Length - Length (Right) + and then Drop = Strings.Left + => + Length (Append'Result) = Max_Length + and then + (if Length (Right) < Max_Length then + Slice (Append'Result, 1, Max_Length - Length (Right)) = + Left (Left'Last - Max_Length + Length (Right) + 1 + .. Left'Last)) + and then + Slice (Append'Result, + Max_Length - Length (Right) + 1, Max_Length) = + To_String (Right), + + others -- Drop = Right + => + Length (Append'Result) = Max_Length + and then + (if Left'Length < Max_Length then + + -- The result is Left followed by the beginning of Right + + Slice (Append'Result, 1, Left'Length) = Left + and then + Slice (Append'Result, Left'Length + 1, Max_Length) = + Slice (Right, 1, Max_Length - Left'Length) + else + -- The result is the first Max_Length characters of Left + + To_String (Append'Result) = + Left (Left'First .. Max_Length - 1 + Left'First))); function Append (Left : Bounded_String; Right : Character; Drop : Truncation := Error) return Bounded_String with - Pre => (if Length (Left) = Max_Length then Drop /= Error), - Post => - Length (Append'Result) - = Natural'Min (Max_Length, Length (Left) + 1), - Global => null; + Pre => (if Length (Left) = Max_Length then Drop /= Error), + Contract_Cases => + (Length (Left) < Max_Length + => + Length (Append'Result) = Length (Left) + 1 + and then + Slice (Append'Result, 1, Length (Left)) = To_String (Left) + and then Element (Append'Result, Length (Left) + 1) = Right, + + Length (Left) = Max_Length and then Drop = Strings.Right + => + Length (Append'Result) = Max_Length + and then To_String (Append'Result) = To_String (Left), + + others -- Drop = Left + => + Length (Append'Result) = Max_Length + and then + Slice (Append'Result, 1, Max_Length - 1) = + Slice (Left, 2, Max_Length) + and then Element (Append'Result, Max_Length) = Right); function Append (Left : Character; Right : Bounded_String; Drop : Truncation := Error) return Bounded_String with - Pre => (if Length (Right) = Max_Length then Drop /= Error), - Post => - Length (Append'Result) - = Natural'Min (Max_Length, 1 + Length (Right)), - Global => null; + Pre => (if Length (Right) = Max_Length then Drop /= Error), + Contract_Cases => + (Length (Right) < Max_Length + => + Length (Append'Result) = Length (Right) + 1 + and then + Slice (Append'Result, 2, Length (Right) + 1) = + To_String (Right) + and then Element (Append'Result, 1) = Left, + + Length (Right) = Max_Length and then Drop = Strings.Left + => + Length (Append'Result) = Max_Length + and then To_String (Append'Result) = To_String (Right), + + others -- Drop = Right + => + Length (Append'Result) = Max_Length + and then + Slice (Append'Result, 2, Max_Length) = + Slice (Right, 1, Max_Length - 1) + and then Element (Append'Result, 1) = Left); + + -- Each of the procedures Append(Source, New_Item, Drop) has the same + -- effect as the corresponding assignment + -- Source := Append(Source, New_Item, Drop). procedure Append (Source : in out Bounded_String; New_Item : Bounded_String; Drop : Truncation := Error) with - Pre => + Pre => (if Length (Source) > Max_Length - Length (New_Item) then Drop /= Error), - Post => - Length (Source) - = Natural'Min (Max_Length, Length (Source)'Old + Length (New_Item)), - Global => null; + Contract_Cases => + (Length (Source) <= Max_Length - Length (New_Item) + => + Length (Source) = Length (Source'Old) + Length (New_Item) + and then + Slice (Source, 1, Length (Source'Old)) = + To_String (Source'Old) + and then + (if Length (New_Item) > 0 then + Slice (Source, Length (Source'Old) + 1, Length (Source)) = + To_String (New_Item)), + + Length (Source) > Max_Length - Length (New_Item) + and then Drop = Left + => + Length (Source) = Max_Length + and then + (if Length (New_Item) < Max_Length then + Slice (Source, 1, Max_Length - Length (New_Item)) = + Slice (Source'Old, + Length (Source'Old) - Max_Length + Length (New_Item) + + 1, + Length (Source'Old))) + and then + Slice (Source, Max_Length - Length (New_Item) + 1, Max_Length) + = To_String (New_Item), + + others -- Drop = Right + => + Length (Source) = Max_Length + and then + Slice (Source, 1, Length (Source'Old)) = + To_String (Source'Old) + and then + (if Length (Source'Old) < Max_Length then + Slice (Source, Length (Source'Old) + 1, Max_Length) = + Slice (New_Item, 1, Max_Length - Length (Source'Old)))); procedure Append (Source : in out Bounded_String; New_Item : String; Drop : Truncation := Error) with - Pre => + Pre => (if New_Item'Length > Max_Length - Length (Source) then Drop /= Error), - Post => - Length (Source) - = Natural'Min (Max_Length, Length (Source)'Old + New_Item'Length), - Global => null; + Contract_Cases => + (Length (Source) <= Max_Length - New_Item'Length + => + Length (Source) = Length (Source'Old) + New_Item'Length + and then + Slice (Source, 1, Length (Source'Old)) = + To_String (Source'Old) + and then + (if New_Item'Length > 0 then + Slice (Source, Length (Source'Old) + 1, Length (Source)) = + New_Item), + + Length (Source) > Max_Length - New_Item'Length + and then Drop = Left + => + Length (Source) = Max_Length + and then + (if New_Item'Length < Max_Length then + + -- The result is the end of Source followed by New_Item + + Slice (Source, 1, Max_Length - New_Item'Length) = + Slice (Source'Old, + Length (Source'Old) - Max_Length + New_Item'Length + 1, + Length (Source'Old)) + and then + Slice (Source, + Max_Length - New_Item'Length + 1, Max_Length) = + New_Item + else + -- The result is the last Max_Length characters of + -- New_Item. + + To_String (Source) = New_Item + (New_Item'Last - Max_Length + 1 .. New_Item'Last)), + + others -- Drop = Right + => + Length (Source) = Max_Length + and then + Slice (Source, 1, Length (Source'Old)) = + To_String (Source'Old) + and then + (if Length (Source'Old) < Max_Length then + Slice (Source, Length (Source'Old) + 1, Max_Length) = + New_Item (New_Item'First + .. Max_Length - Length (Source'Old) - 1 + + New_Item'First))); procedure Append (Source : in out Bounded_String; New_Item : Character; Drop : Truncation := Error) with - Pre => (if Length (Source) = Max_Length then Drop /= Error), - Post => - Length (Source) - = Natural'Min (Max_Length, Length (Source)'Old + 1), - Global => null; + Pre => (if Length (Source) = Max_Length then Drop /= Error), + Contract_Cases => + (Length (Source) < Max_Length + => + Length (Source) = Length (Source'Old) + 1 + and then + Slice (Source, 1, Length (Source'Old)) = + To_String (Source'Old) + and then Element (Source, Length (Source'Old) + 1) = New_Item, + + Length (Source) = Max_Length and then Drop = Right + => + Length (Source) = Max_Length + and then To_String (Source) = To_String (Source'Old), + + others -- Drop = Left + => + Length (Source) = Max_Length + and then + Slice (Source, 1, Max_Length - 1) = + Slice (Source'Old, 2, Max_Length) + and then Element (Source, Max_Length) = New_Item); + + -- Each of the "&" functions has the same effect as the corresponding + -- Append function, with Error as the Drop parameter. function "&" (Left : Bounded_String; Right : Bounded_String) return Bounded_String with - Pre => Length (Left) <= Max_Length - Length (Right), - Post => Length ("&"'Result) = Length (Left) + Length (Right), - Global => null; + Pre => Length (Left) <= Max_Length - Length (Right), + Post => Length ("&"'Result) = Length (Left) + Length (Right) + and then Slice ("&"'Result, 1, Length (Left)) = To_String (Left) + and then + (if Length (Right) > 0 then + Slice ("&"'Result, Length (Left) + 1, Length ("&"'Result)) = + To_String (Right)); function "&" (Left : Bounded_String; Right : String) return Bounded_String with - Pre => Right'Length <= Max_Length - Length (Left), - Post => Length ("&"'Result) = Length (Left) + Right'Length, - Global => null; + Pre => Right'Length <= Max_Length - Length (Left), + Post => Length ("&"'Result) = Length (Left) + Right'Length + and then Slice ("&"'Result, 1, Length (Left)) = To_String (Left) + and then + (if Right'Length > 0 then + Slice ("&"'Result, Length (Left) + 1, Length ("&"'Result)) = + Right); function "&" (Left : String; Right : Bounded_String) return Bounded_String with - Pre => Left'Length <= Max_Length - Length (Right), - Post => Length ("&"'Result) = Left'Length + Length (Right), - Global => null; + Pre => Left'Length <= Max_Length - Length (Right), + Post => Length ("&"'Result) = Left'Length + Length (Right) + and then Slice ("&"'Result, 1, Left'Length) = Left + and then + (if Length (Right) > 0 then + Slice ("&"'Result, Left'Length + 1, Length ("&"'Result)) = + To_String (Right)); function "&" (Left : Bounded_String; Right : Character) return Bounded_String with - Pre => Length (Left) < Max_Length, - Post => Length ("&"'Result) = Length (Left) + 1, - Global => null; + Pre => Length (Left) < Max_Length, + Post => Length ("&"'Result) = Length (Left) + 1 + and then Slice ("&"'Result, 1, Length (Left)) = To_String (Left) + and then Element ("&"'Result, Length (Left) + 1) = Right; function "&" (Left : Character; Right : Bounded_String) return Bounded_String with - Pre => Length (Right) < Max_Length, - Post => Length ("&"'Result) = 1 + Length (Right), - Global => null; + Pre => Length (Right) < Max_Length, + Post => Length ("&"'Result) = 1 + Length (Right) + and then Element ("&"'Result, 1) = Left + and then + Slice ("&"'Result, 2, Length ("&"'Result)) = To_String (Right); function Element (Source : Bounded_String; @@ -237,6 +561,8 @@ package Ada.Strings.Bounded is with Pre => Index <= Length (Source), Global => null; + -- Returns the character at position Index in the string represented by + -- Source; propagates Index_Error if Index > Length(Source). procedure Replace_Element (Source : in out Bounded_String; @@ -244,8 +570,14 @@ package Ada.Strings.Bounded is By : Character) with Pre => Index <= Length (Source), - Post => Length (Source) = Length (Source)'Old, + Post => Length (Source) = Length (Source'Old) + and then (for all K in 1 .. Length (Source) => + Element (Source, K) = + (if K = Index then By else Element (Source'Old, K))), Global => null; + -- Updates Source such that the character at position Index in the + -- string represented by Source is By; propagates Index_Error if + -- Index > Length(Source). function Slice (Source : Bounded_String; @@ -253,8 +585,11 @@ package Ada.Strings.Bounded is High : Natural) return String with Pre => Low - 1 <= Length (Source) and then High <= Length (Source), - Post => Slice'Result'Length = Natural'Max (0, High - Low + 1), Global => null; + -- Returns the slice at positions Low through High in the + -- string represented by Source; propagates Index_Error if + -- Low > Length(Source)+1 or High > Length(Source). + -- The bounds of the returned string are Low and High. function Bounded_Slice (Source : Bounded_String; @@ -262,10 +597,12 @@ package Ada.Strings.Bounded is High : Natural) return Bounded_String with Pre => Low - 1 <= Length (Source) and then High <= Length (Source), - Post => - Length (Bounded_Slice'Result) = Natural'Max (0, High - Low + 1), + Post => To_String (Bounded_Slice'Result) = Slice (Source, Low, High), Global => null; pragma Ada_05 (Bounded_Slice); + -- Returns the slice at positions Low through High in the string + -- represented by Source as a bounded string; propagates Index_Error + -- if Low > Length(Source)+1 or High > Length(Source). procedure Bounded_Slice (Source : Bounded_String; @@ -274,112 +611,181 @@ package Ada.Strings.Bounded is High : Natural) with Pre => Low - 1 <= Length (Source) and then High <= Length (Source), - Post => Length (Target) = Natural'Max (0, High - Low + 1), + Post => To_String (Target) = Slice (Source, Low, High), Global => null; pragma Ada_05 (Bounded_Slice); + -- Equivalent to Target := Bounded_Slice (Source, Low, High); + + -- Each of the functions "=", "<", ">", "<=", and ">=" returns the same + -- result as the corresponding String operation applied to the String + -- values given or represented by the two parameters. function "=" (Left : Bounded_String; Right : Bounded_String) return Boolean with + Post => "="'Result = (To_String (Left) = To_String (Right)), Global => null; function "=" (Left : Bounded_String; Right : String) return Boolean with + Post => "="'Result = (To_String (Left) = Right), Global => null; function "=" (Left : String; Right : Bounded_String) return Boolean with + Post => "="'Result = (Left = To_String (Right)), Global => null; function "<" (Left : Bounded_String; Right : Bounded_String) return Boolean with + Post => "<"'Result = (To_String (Left) < To_String (Right)), Global => null; function "<" (Left : Bounded_String; Right : String) return Boolean with + Post => "<"'Result = (To_String (Left) < Right), Global => null; function "<" (Left : String; Right : Bounded_String) return Boolean with + Post => "<"'Result = (Left < To_String (Right)), Global => null; function "<=" (Left : Bounded_String; Right : Bounded_String) return Boolean with + Post => "<="'Result = (To_String (Left) <= To_String (Right)), Global => null; function "<=" (Left : Bounded_String; Right : String) return Boolean with + Post => "<="'Result = (To_String (Left) <= Right), Global => null; function "<=" (Left : String; Right : Bounded_String) return Boolean with + Post => "<="'Result = (Left <= To_String (Right)), Global => null; function ">" (Left : Bounded_String; Right : Bounded_String) return Boolean with + Post => ">"'Result = (To_String (Left) > To_String (Right)), Global => null; function ">" (Left : Bounded_String; Right : String) return Boolean with + Post => ">"'Result = (To_String (Left) > Right), Global => null; function ">" (Left : String; Right : Bounded_String) return Boolean with + Post => ">"'Result = (Left > To_String (Right)), Global => null; function ">=" (Left : Bounded_String; Right : Bounded_String) return Boolean with + Post => ">="'Result = (To_String (Left) >= To_String (Right)), Global => null; function ">=" (Left : Bounded_String; Right : String) return Boolean with + Post => ">="'Result = (To_String (Left) >= Right), Global => null; function ">=" (Left : String; Right : Bounded_String) return Boolean with + Post => ">="'Result = (Left >= To_String (Right)), Global => null; ---------------------- -- Search Functions -- ---------------------- + -- Each of the search subprograms (Index, Index_Non_Blank, Count, + -- Find_Token) has the same effect as the corresponding subprogram in + -- Strings.Fixed applied to the string represented by the Bounded_String + -- parameter. + function Index (Source : Bounded_String; Pattern : String; Going : Direction := Forward; Mapping : Maps.Character_Mapping := Maps.Identity) return Natural with - Pre => Pattern'Length /= 0, - Global => null; + Pre => Pattern'Length > 0, + Post => Index'Result <= Length (Source), + Contract_Cases => + + -- If Source is the empty string, then 0 is returned + + (Length (Source) = 0 + => + Index'Result = 0, + + -- If some slice of Source matches Pattern, then a valid index is + -- returned. + + Length (Source) > 0 + and then + (for some J in 1 .. Length (Source) - (Pattern'Length - 1) => + Search.Match (To_String (Source), Pattern, Mapping, J)) + => + -- The result is in the considered range of Source + + Index'Result in 1 .. Length (Source) - (Pattern'Length - 1) + + -- The slice beginning at the returned index matches Pattern + + and then Search.Match + (To_String (Source), Pattern, Mapping, Index'Result) + + -- The result is the smallest or largest index which satisfies + -- the matching, respectively when Going = Forward and Going = + -- Backward. + + and then + (for all J in 1 .. Length (Source) => + (if (if Going = Forward + then J <= Index'Result - 1 + else J - 1 in Index'Result + .. Length (Source) - Pattern'Length) + then not (Search.Match + (To_String (Source), Pattern, Mapping, J)))), + + -- Otherwise, 0 is returned + + others + => + Index'Result = 0), + Global => null; function Index (Source : Bounded_String; @@ -387,8 +793,52 @@ package Ada.Strings.Bounded is Going : Direction := Forward; Mapping : Maps.Character_Mapping_Function) return Natural with - Pre => Pattern'Length /= 0, - Global => null; + Pre => Pattern'Length /= 0 and then Mapping /= null, + Post => Index'Result <= Length (Source), + Contract_Cases => + + -- If Source is the empty string, then 0 is returned + + (Length (Source) = 0 + => + Index'Result = 0, + + -- If some slice of Source matches Pattern, then a valid index is + -- returned. + + Length (Source) > 0 + and then + (for some J in 1 .. Length (Source) - (Pattern'Length - 1) => + Search.Match (To_String (Source), Pattern, Mapping, J)) + => + -- The result is in the considered range of Source + + Index'Result in 1 .. Length (Source) - (Pattern'Length - 1) + + -- The slice beginning at the returned index matches Pattern + + and then Search.Match + (To_String (Source), Pattern, Mapping, Index'Result) + + -- The result is the smallest or largest index which satisfies + -- the matching, respectively when Going = Forward and Going = + -- Backward. + + and then + (for all J in 1 .. Length (Source) => + (if (if Going = Forward + then J <= Index'Result - 1 + else J - 1 in Index'Result + .. Length (Source) - Pattern'Length) + then not (Search.Match + (To_String (Source), Pattern, Mapping, J)))), + + -- Otherwise, 0 is returned + + others + => + Index'Result = 0), + Global => null; function Index (Source : Bounded_String; @@ -396,7 +846,43 @@ package Ada.Strings.Bounded is Test : Membership := Inside; Going : Direction := Forward) return Natural with - Global => null; + Post => Index'Result <= Length (Source), + Contract_Cases => + + -- If no character of Source satisfies the property Test on Set, + -- then 0 is returned. + + ((for all C of To_String (Source) => + (Test = Inside) /= Maps.Is_In (C, Set)) + => + Index'Result = 0, + + -- Otherwise, an index in the range of Source is returned + + others + => + -- The result is in the range of Source + + Index'Result in 1 .. Length (Source) + + -- The character at the returned index satisfies the property + -- Test on Set. + + and then + (Test = Inside) = + Maps.Is_In (Element (Source, Index'Result), Set) + + -- The result is the smallest or largest index which satisfies + -- the property, respectively when Going = Forward and Going = + -- Backward. + + and then + (for all J in 1 .. Length (Source) => + (if J /= Index'Result + and then (J < Index'Result) = (Going = Forward) + then (Test = Inside) + /= Maps.Is_In (Element (Source, J), Set)))), + Global => null; function Index (Source : Bounded_String; @@ -405,11 +891,60 @@ package Ada.Strings.Bounded is Going : Direction := Forward; Mapping : Maps.Character_Mapping := Maps.Identity) return Natural with - Pre => - (if Length (Source) /= 0 - then From <= Length (Source)) - and then Pattern'Length /= 0, - Global => null; + Pre => + (if Length (Source) /= 0 then From <= Length (Source)) + and then Pattern'Length /= 0, + Post => Index'Result <= Length (Source), + Contract_Cases => + + -- If Source is the empty string, then 0 is returned + + (Length (Source) = 0 + => + Index'Result = 0, + + -- If some slice of Source matches Pattern, then a valid index is + -- returned. + + Length (Source) > 0 + and then + (for some J in + (if Going = Forward then From else 1) + .. (if Going = Forward then Length (Source) else From) + - (Pattern'Length - 1) => + Search.Match (To_String (Source), Pattern, Mapping, J)) + => + -- The result is in the considered range of Source + + Index'Result in + (if Going = Forward then From else 1) + .. (if Going = Forward then Length (Source) else From) + - (Pattern'Length - 1) + + -- The slice beginning at the returned index matches Pattern + + and then Search.Match + (To_String (Source), Pattern, Mapping, Index'Result) + + -- The result is the smallest or largest index which satisfies + -- the matching, respectively when Going = Forward and Going = + -- Backward. + + and then + (for all J in 1 .. Length (Source) => + (if (if Going = Forward + then J in From .. Index'Result - 1 + else J - 1 in Index'Result + .. From - Pattern'Length) + then not (Search.Match + (To_String (Source), Pattern, Mapping, J)))), + + -- Otherwise, 0 is returned + + others + => + Index'Result = 0), + Global => null; pragma Ada_05 (Index); function Index @@ -419,11 +954,61 @@ package Ada.Strings.Bounded is Going : Direction := Forward; Mapping : Maps.Character_Mapping_Function) return Natural with - Pre => - (if Length (Source) /= 0 - then From <= Length (Source)) - and then Pattern'Length /= 0, - Global => null; + Pre => + (if Length (Source) /= 0 then From <= Length (Source)) + and then Pattern'Length /= 0 + and then Mapping /= null, + Post => Index'Result <= Length (Source), + Contract_Cases => + + -- If Source is the empty string, then 0 is returned + + (Length (Source) = 0 + => + Index'Result = 0, + + -- If some slice of Source matches Pattern, then a valid index is + -- returned. + + Length (Source) > 0 + and then + (for some J in + (if Going = Forward then From else 1) + .. (if Going = Forward then Length (Source) else From) + - (Pattern'Length - 1) => + Search.Match (To_String (Source), Pattern, Mapping, J)) + => + -- The result is in the considered range of Source + + Index'Result in + (if Going = Forward then From else 1) + .. (if Going = Forward then Length (Source) else From) + - (Pattern'Length - 1) + + -- The slice beginning at the returned index matches Pattern + + and then Search.Match + (To_String (Source), Pattern, Mapping, Index'Result) + + -- The result is the smallest or largest index which satisfies + -- the matching, respectively when Going = Forward and Going = + -- Backward. + + and then + (for all J in 1 .. Length (Source) => + (if (if Going = Forward + then J in From .. Index'Result - 1 + else J - 1 in Index'Result + .. From - Pattern'Length) + then not (Search.Match + (To_String (Source), Pattern, Mapping, J)))), + + -- Otherwise, 0 is returned + + others + => + Index'Result = 0), + Global => null; pragma Ada_05 (Index); function Index @@ -433,23 +1018,147 @@ package Ada.Strings.Bounded is Test : Membership := Inside; Going : Direction := Forward) return Natural with - Pre => (if Length (Source) /= 0 then From <= Length (Source)), - Global => null; + Pre => + (if Length (Source) /= 0 then From <= Length (Source)), + Post => Index'Result <= Length (Source), + Contract_Cases => + + -- If Source is the empty string, or no character of the considered + -- slice of Source satisfies the property Test on Set, then 0 is + -- returned. + + (Length (Source) = 0 + or else + (for all J in 1 .. Length (Source) => + (if J = From or else (J > From) = (Going = Forward) then + (Test = Inside) /= Maps.Is_In (Element (Source, J), Set))) + => + Index'Result = 0, + + -- Otherwise, an index in the considered range of Source is + -- returned. + + others + => + -- The result is in the considered range of Source + + Index'Result in 1 .. Length (Source) + and then + (Index'Result = From + or else (Index'Result > From) = (Going = Forward)) + + -- The character at the returned index satisfies the property + -- Test on Set. + + and then + (Test = Inside) = + Maps.Is_In (Element (Source, Index'Result), Set) + + -- The result is the smallest or largest index which satisfies + -- the property, respectively when Going = Forward and Going = + -- Backward. + + and then + (for all J in 1 .. Length (Source) => + (if J /= Index'Result + and then (J < Index'Result) = (Going = Forward) + and then (J = From + or else (J > From) = (Going = Forward)) + then (Test = Inside) + /= Maps.Is_In (Element (Source, J), Set)))), + Global => null; pragma Ada_05 (Index); function Index_Non_Blank (Source : Bounded_String; Going : Direction := Forward) return Natural with - Global => null; + Post => Index_Non_Blank'Result <= Length (Source), + Contract_Cases => + + -- If all characters of Source are Space characters, then 0 is + -- returned. + + ((for all C of To_String (Source) => C = ' ') + => + Index_Non_Blank'Result = 0, + + -- Otherwise, an index in the range of Source is returned + + others + => + -- The result is in the range of Source + + Index_Non_Blank'Result in 1 .. Length (Source) + + -- The character at the returned index is not a Space character + + and then Element (Source, Index_Non_Blank'Result) /= ' ' + + -- The result is the smallest or largest index which is not a + -- Space character, respectively when Going = Forward and Going + -- = Backward. + + and then + (for all J in 1 .. Length (Source) => + (if J /= Index_Non_Blank'Result + and then + (J < Index_Non_Blank'Result) = (Going = Forward) + then Element (Source, J) = ' '))), + Global => null; function Index_Non_Blank (Source : Bounded_String; From : Positive; Going : Direction := Forward) return Natural with - Pre => (if Length (Source) /= 0 then From <= Length (Source)), - Global => null; + Pre => + (if Length (Source) /= 0 then From <= Length (Source)), + Post => Index_Non_Blank'Result <= Length (Source), + Contract_Cases => + + -- If Source is the empty string, or all characters of the + -- considered slice of Source are Space characters, then 0 + -- is returned. + + (Length (Source) = 0 + or else + (for all J in 1 .. Length (Source) => + (if J = From or else (J > From) = (Going = Forward) then + Element (Source, J) = ' ')) + => + Index_Non_Blank'Result = 0, + + -- Otherwise, an index in the considered range of Source is + -- returned. + + others + => + -- The result is in the considered range of Source + + Index_Non_Blank'Result in 1 .. Length (Source) + and then + (Index_Non_Blank'Result = From + or else + (Index_Non_Blank'Result > From) = (Going = Forward)) + + -- The character at the returned index is not a Space character + + and then Element (Source, Index_Non_Blank'Result) /= ' ' + + -- The result is the smallest or largest index which isn't a + -- Space character, respectively when Going = Forward and Going + -- = Backward. + + and then + (for all J in 1 .. Length (Source) => + (if J /= Index_Non_Blank'Result + and then + (J < Index_Non_Blank'Result) = (Going = Forward) + and then (J = From + or else (J > From) = (Going = Forward)) + then Element (Source, J) = ' '))), + Global => null; pragma Ada_05 (Index_Non_Blank); function Count @@ -465,7 +1174,7 @@ package Ada.Strings.Bounded is Pattern : String; Mapping : Maps.Character_Mapping_Function) return Natural with - Pre => Pattern'Length /= 0, + Pre => Pattern'Length /= 0 and then Mapping /= null, Global => null; function Count @@ -482,8 +1191,53 @@ package Ada.Strings.Bounded is First : out Positive; Last : out Natural) with - Pre => (if Length (Source) /= 0 then From <= Length (Source)), - Global => null; + Pre => + (if Length (Source) /= 0 then From <= Length (Source)), + Contract_Cases => + + -- If Source is the empty string, or if no character of the + -- considered slice of Source satisfies the property Test on + -- Set, then First is set to From and Last is set to 0. + + (Length (Source) = 0 + or else + (for all J in From .. Length (Source) => + (Test = Inside) /= Maps.Is_In (Element (Source, J), Set)) + => + First = From and then Last = 0, + + -- Otherwise, First and Last are set to valid indexes + + others + => + -- First and Last are in the considered range of Source + + First in From .. Length (Source) + and then Last in First .. Length (Source) + + -- No character between From and First satisfies the property + -- Test on Set. + + and then + (for all J in From .. First - 1 => + (Test = Inside) /= Maps.Is_In (Element (Source, J), Set)) + + -- All characters between First and Last satisfy the property + -- Test on Set. + + and then + (for all J in First .. Last => + (Test = Inside) = Maps.Is_In (Element (Source, J), Set)) + + -- If Last is not Source'Last, then the character at position + -- Last + 1 does not satify the property Test on Set. + + and then + (if Last < Length (Source) + then + (Test = Inside) + /= Maps.Is_In (Element (Source, Last + 1), Set))), + Global => null; pragma Ada_2012 (Find_Token); procedure Find_Token @@ -493,44 +1247,127 @@ package Ada.Strings.Bounded is First : out Positive; Last : out Natural) with - Global => null; + Contract_Cases => + + -- If Source is the empty string, or if no character of the + -- considered slice of Source satisfies the property Test on + -- Set, then First is set to 1 and Last is set to 0. + + (Length (Source) = 0 + or else + (for all J in 1 .. Length (Source) => + (Test = Inside) /= Maps.Is_In (Element (Source, J), Set)) + => + First = 1 and then Last = 0, + + -- Otherwise, First and Last are set to valid indexes + + others + => + -- First and Last are in the considered range of Source + + First in 1 .. Length (Source) + and then Last in First .. Length (Source) + + -- No character between 1 and First satisfies the property Test + -- on Set. + + and then + (for all J in 1 .. First - 1 => + (Test = Inside) /= Maps.Is_In (Element (Source, J), Set)) + + -- All characters between First and Last satisfy the property + -- Test on Set. + + and then + (for all J in First .. Last => + (Test = Inside) = Maps.Is_In (Element (Source, J), Set)) + + -- If Last is not Source'Last, then the character at position + -- Last + 1 does not satify the property Test on Set. + + and then + (if Last < Length (Source) + then + (Test = Inside) + /= Maps.Is_In (Element (Source, Last + 1), Set))), + Global => null; ------------------------------------ -- String Translation Subprograms -- ------------------------------------ + -- Each of the Translate subprograms, when applied to a Bounded_String, + -- has an analogous effect to the corresponding subprogram in + -- Strings.Fixed. For the Translate function, the translation is applied + -- to the string represented by the Bounded_String parameter, and the + -- result is converted (via To_Bounded_String) to a Bounded_String. For + -- the Translate procedure, the string represented by the Bounded_String + -- parameter after the translation is given by the Translate function + -- for fixed-length strings applied to the string represented by the + -- original value of the parameter. + function Translate (Source : Bounded_String; Mapping : Maps.Character_Mapping) return Bounded_String with - Post => Length (Translate'Result) = Length (Source), + Post => Length (Translate'Result) = Length (Source) + and then + (for all K in 1 .. Length (Source) => + Element (Translate'Result, K) = + Ada.Strings.Maps.Value (Mapping, Element (Source, K))), Global => null; procedure Translate (Source : in out Bounded_String; Mapping : Maps.Character_Mapping) with - Post => Length (Source) = Length (Source)'Old, + Post => Length (Source) = Length (Source'Old) + and then + (for all K in 1 .. Length (Source) => + Element (Source, K) = + Ada.Strings.Maps.Value (Mapping, Element (Source'Old, K))), Global => null; function Translate (Source : Bounded_String; Mapping : Maps.Character_Mapping_Function) return Bounded_String with - Post => Length (Translate'Result) = Length (Source), + Pre => Mapping /= null, + Post => Length (Translate'Result) = Length (Source) + and then + (for all K in 1 .. Length (Source) => + Element (Translate'Result, K) = Mapping (Element (Source, K))), Global => null; procedure Translate (Source : in out Bounded_String; Mapping : Maps.Character_Mapping_Function) with - Post => Length (Source) = Length (Source)'Old, + Pre => Mapping /= null, + Post => Length (Source) = Length (Source'Old) + and then + (for all K in 1 .. Length (Source) => + Element (Source, K) = Mapping (Element (Source'Old, K))), Global => null; --------------------------------------- -- String Transformation Subprograms -- --------------------------------------- + -- Each of the transformation subprograms (Replace_Slice, Insert, + -- Overwrite, Delete), selector subprograms (Trim, Head, Tail), and + -- constructor functions ("*") has an effect based on its corresponding + -- subprogram in Strings.Fixed, and Replicate is based on Fixed."*". + -- In the case of a function, the corresponding fixed-length string + -- subprogram is applied to the string represented by the Bounded_String + -- parameter. To_Bounded_String is applied the result string, with Drop + -- (or Error in the case of Generic_Bounded_Length."*") determining + -- the effect when the string length exceeds Max_Length. In + -- the case of a procedure, the corresponding function in + -- Strings.Bounded.Generic_Bounded_Length is applied, with the + -- result assigned into the Source parameter. + function Replace_Slice (Source : Bounded_String; Low : Positive; @@ -541,23 +1378,127 @@ package Ada.Strings.Bounded is Pre => Low - 1 <= Length (Source) and then - (if Drop = Error - then (if High >= Low - then Low - 1 - <= Max_Length - By'Length - - Natural'Max (Length (Source) - High, 0) - else Length (Source) <= Max_Length - By'Length)), + (if Drop = Error + then (if High >= Low + then Low - 1 + <= Max_Length - By'Length + - Integer'Max (Length (Source) - High, 0) + else Length (Source) <= Max_Length - By'Length)), Contract_Cases => - (High >= Low => - Length (Replace_Slice'Result) - = Natural'Min - (Max_Length, - Low - 1 + By'Length + Natural'Max (Length (Source) - High, - 0)), - others => - Length (Replace_Slice'Result) - = Natural'Min (Max_Length, Length (Source) + By'Length)), - Global => null; + (Low - 1 <= Max_Length - By'Length + - Integer'Max (Length (Source) - Integer'Max (High, Low - 1), 0) + => + -- Total length is lower than Max_Length: nothing is dropped + + -- Note that if High < Low, the insertion is done before Low, + -- so in all cases the starting position of the slice of Source + -- remaining after the replaced Slice is Integer'Max (High + 1, + -- Low). + + Length (Replace_Slice'Result) = Low - 1 + By'Length + + Integer'Max (Length (Source) - Integer'Max (High, Low - 1), 0) + and then + Slice (Replace_Slice'Result, 1, Low - 1) = + Slice (Source, 1, Low - 1) + and then + Slice (Replace_Slice'Result, Low, Low - 1 + By'Length) = By + and then + (if Integer'Max (High, Low - 1) < Length (Source) then + Slice (Replace_Slice'Result, + Low + By'Length, Length (Replace_Slice'Result)) = + Slice (Source, + Integer'Max (High + 1, Low), Length (Source))), + + Low - 1 > Max_Length - By'Length + - Integer'Max (Length (Source) - Integer'Max (High, Low - 1), 0) + and then Drop = Left + => + -- Final_Slice is the length of the slice of Source remaining + -- after the replaced part. + (declare + Final_Slice : constant Natural := + Integer'Max + (Length (Source) - Integer'Max (High, Low - 1), 0); + begin + -- The result is of maximal length and ends by the last + -- Final_Slice characters of Source. + + Length (Replace_Slice'Result) = Max_Length + and then + (if Final_Slice > 0 then + Slice (Replace_Slice'Result, + Max_Length - Final_Slice + 1, Max_Length) = + Slice (Source, + Integer'Max (High + 1, Low), Length (Source))) + + -- Depending on when we reach Max_Length, either the first + -- part of Source is fully dropped and By is partly dropped, + -- or By is fully added and the first part of Source is + -- partly dropped. + + and then + (if Max_Length - Final_Slice - By'Length <= 0 then + + -- The first (possibly zero) characters of By are + -- dropped. + + (if Final_Slice < Max_Length then + Slice (Replace_Slice'Result, + 1, Max_Length - Final_Slice) = + By (By'Last - Max_Length + Final_Slice + 1 + .. By'Last)) + + else -- By is added to the result + + Slice (Replace_Slice'Result, + Max_Length - Final_Slice - By'Length + 1, + Max_Length - Final_Slice) = + By + + -- The first characters of Source (1 .. Low - 1) are + -- dropped. + + and then Slice (Replace_Slice'Result, 1, + Max_Length - Final_Slice - By'Length) = + Slice (Source, + Low - Max_Length + Final_Slice + By'Length, + Low - 1))), + + others -- Drop = Right + => + -- The result is of maximal length and starts by the first Low - + -- 1 characters of Source. + + Length (Replace_Slice'Result) = Max_Length + and then + Slice (Replace_Slice'Result, 1, Low - 1) = + Slice (Source, 1, Low - 1) + + -- Depending on when we reach Max_Length, either the last part + -- of Source is fully dropped and By is partly dropped, or By + -- is fully added and the last part of Source is partly + -- dropped. + + and then + (if Low - 1 >= Max_Length - By'Length then + + -- The last characters of By are dropped + + Slice (Replace_Slice'Result, Low, Max_Length) = + By (By'First .. Max_Length - Low + By'First) + + else -- By is fully added + + Slice (Replace_Slice'Result, Low, Low + By'Length - 1) = By + + -- Then Source starting from Integer'Max (High + 1, Low) + -- is added but the last characters are dropped. + + and then Slice (Replace_Slice'Result, + Low + By'Length, Max_Length) = + Slice (Source, Integer'Max (High + 1, Low), + Integer'Max (High + 1, Low) + + (Max_Length - Low - By'Length)))); procedure Replace_Slice (Source : in out Bounded_String; @@ -569,23 +1510,119 @@ package Ada.Strings.Bounded is Pre => Low - 1 <= Length (Source) and then - (if Drop = Error - then (if High >= Low - then Low - 1 - <= Max_Length - By'Length - - Natural'Max (Length (Source) - High, 0) - else Length (Source) <= Max_Length - By'Length)), + (if Drop = Error + then (if High >= Low + then Low - 1 + <= Max_Length - By'Length + - Natural'Max (Length (Source) - High, 0) + else Length (Source) <= Max_Length - By'Length)), Contract_Cases => - (High >= Low => - Length (Source) - = Natural'Min - (Max_Length, - Low - 1 + By'Length + Natural'Max (Length (Source)'Old - High, - 0)), - others => - Length (Source) - = Natural'Min (Max_Length, Length (Source)'Old + By'Length)), - Global => null; + (Low - 1 <= Max_Length - By'Length + - Integer'Max (Length (Source) - Integer'Max (High, Low - 1), 0) + => + -- Total length is lower than Max_Length: nothing is dropped + + -- Note that if High < Low, the insertion is done before Low, + -- so in all cases the starting position of the slice of Source + -- remaining after the replaced Slice is Integer'Max (High + 1, + -- Low). + + Length (Source) = Low - 1 + By'Length + Integer'Max + (Length (Source'Old) - Integer'Max (High, Low - 1), 0) + and then + Slice (Source, 1, Low - 1) = Slice (Source'Old, 1, Low - 1) + and then Slice (Source, Low, Low - 1 + By'Length) = By + and then + (if Integer'Max (High, Low - 1) < Length (Source'Old) then + Slice (Source, Low + By'Length, Length (Source)) = + Slice (Source'Old, + Integer'Max (High + 1, Low), Length (Source'Old))), + + Low - 1 > Max_Length - By'Length + - Integer'Max (Length (Source) - Integer'Max (High, Low - 1), 0) + and then Drop = Left + => + -- Final_Slice is the length of the slice of Source remaining + -- after the replaced part. + (declare + Final_Slice : constant Integer := + Integer'Max (0, + Length (Source'Old) - Integer'Max (High, Low - 1)); + begin + -- The result is of maximal length and ends by the last + -- Final_Slice characters of Source. + + Length (Source) = Max_Length + and then + (if Final_Slice > 0 then + Slice (Source, + Max_Length - Final_Slice + 1, Max_Length) = + Slice (Source'Old, + Integer'Max (High + 1, Low), Length (Source'Old))) + + -- Depending on when we reach Max_Length, either the first + -- part of Source is fully dropped and By is partly dropped, + -- or By is fully added and the first part of Source is + -- partly dropped. + + and then + (if Max_Length - Final_Slice - By'Length <= 0 then + + -- The first characters of By are dropped + + (if Final_Slice < Max_Length then + Slice (Source, 1, Max_Length - Final_Slice) = + By (By'Last - Max_Length + Final_Slice + 1 + .. By'Last)) + + else -- By is added to the result + + Slice (Source, + Max_Length - Final_Slice - By'Length + 1, + Max_Length - Final_Slice) = By + + -- The first characters of Source (1 .. Low - 1) are + -- dropped. + + and then Slice (Source, 1, + Max_Length - Final_Slice - By'Length) = + Slice (Source'Old, + Low - Max_Length + Final_Slice + By'Length, + Low - 1))), + + others -- Drop = Right + => + -- The result is of maximal length and starts by the first Low - + -- 1 characters of Source. + + Length (Source) = Max_Length + and then + Slice (Source, 1, Low - 1) = Slice (Source'Old, 1, Low - 1) + + -- Depending on when we reach Max_Length, either the last part + -- of Source is fully dropped and By is partly dropped, or By + -- is fully added and the last part of Source is partly + -- dropped. + + and then + (if Low - 1 >= Max_Length - By'Length then + + -- The last characters of By are dropped + + Slice (Source, Low, Max_Length) = + By (By'First .. Max_Length - Low + By'First) + + else -- By is fully added + + Slice (Source, Low, Low + By'Length - 1) = By + + -- Then Source starting from Natural'Max (High + 1, Low) + -- is added but the last characters are dropped. + + and then Slice (Source, Low + By'Length, Max_Length) = + Slice (Source'Old, Integer'Max (High + 1, Low), + Integer'Max (High + 1, Low) + + (Max_Length - Low - By'Length)))); function Insert (Source : Bounded_String; @@ -593,14 +1630,113 @@ package Ada.Strings.Bounded is New_Item : String; Drop : Truncation := Error) return Bounded_String with - Pre => + Pre => Before - 1 <= Length (Source) and then (if New_Item'Length > Max_Length - Length (Source) then Drop /= Error), - Post => - Length (Insert'Result) - = Natural'Min (Max_Length, Length (Source) + New_Item'Length), - Global => null; + Contract_Cases => + (Length (Source) <= Max_Length - New_Item'Length + => + -- Total length is lower than Max_Length: nothing is dropped + + Length (Insert'Result) = Length (Source) + New_Item'Length + and then + Slice (Insert'Result, 1, Before - 1) = + Slice (Source, 1, Before - 1) + and then + Slice (Insert'Result, Before, Before - 1 + New_Item'Length) = + New_Item + and then + (if Before <= Length (Source) then + Slice (Insert'Result, + Before + New_Item'Length, Length (Insert'Result)) = + Slice (Source, Before, Length (Source))), + + Length (Source) > Max_Length - New_Item'Length and then Drop = Left + => + -- The result is of maximal length and ends by the last + -- characters of Source. + + Length (Insert'Result) = Max_Length + and then + (if Before <= Length (Source) then + Slice (Insert'Result, + Max_Length - Length (Source) + Before, Max_Length) = + Slice (Source, Before, Length (Source))) + + -- Depending on when we reach Max_Length, either the first part + -- of Source is fully dropped and New_Item is partly dropped, + -- or New_Item is fully added and the first part of Source is + -- partly dropped. + + and then + (if Max_Length - Length (Source) - 1 + Before + < New_Item'Length + then + -- The first characters of New_Item are dropped + + (if Length (Source) - Before + 1 < Max_Length then + Slice (Insert'Result, + 1, Max_Length - Length (Source) - 1 + Before) = + New_Item + (New_Item'Last - Max_Length + Length (Source) + - Before + 2 + .. New_Item'Last)) + + else -- New_Item is added to the result + + Slice (Insert'Result, + Max_Length - Length (Source) - New_Item'Length + Before, + Max_Length - Length (Source) - 1 + Before) = New_Item + + -- The first characters of Source (1 .. Before - 1) are + -- dropped. + + and then Slice (Insert'Result, + 1, Max_Length - Length (Source) - New_Item'Length + - 1 + Before) = + Slice (Source, + Length (Source) - Max_Length + New_Item'Length + + 1, + Before - 1)), + + others -- Drop = Right + => + -- The result is of maximal length and starts by the first + -- characters of Source. + + Length (Insert'Result) = Max_Length + and then + Slice (Insert'Result, 1, Before - 1) = + Slice (Source, 1, Before - 1) + + -- Depending on when we reach Max_Length, either the last part + -- of Source is fully dropped and New_Item is partly dropped, + -- or New_Item is fully added and the last part of Source is + -- partly dropped. + + and then + (if Before - 1 >= Max_Length - New_Item'Length then + + -- The last characters of New_Item are dropped + + Slice (Insert'Result, Before, Max_Length) = + New_Item (New_Item'First + .. Max_Length - Before + New_Item'First) + + else -- New_Item is fully added + + Slice (Insert'Result, + Before, Before + New_Item'Length - 1) = + New_Item + + -- Then Source starting from Before is added but the + -- last characters are dropped. + + and then Slice (Insert'Result, + Before + New_Item'Length, Max_Length) = + Slice (Source, + Before, Max_Length - New_Item'Length))); procedure Insert (Source : in out Bounded_String; @@ -608,14 +1744,112 @@ package Ada.Strings.Bounded is New_Item : String; Drop : Truncation := Error) with - Pre => + Pre => Before - 1 <= Length (Source) and then (if New_Item'Length > Max_Length - Length (Source) then Drop /= Error), - Post => - Length (Source) - = Natural'Min (Max_Length, Length (Source)'Old + New_Item'Length), - Global => null; + Contract_Cases => + (Length (Source) <= Max_Length - New_Item'Length + => + -- Total length is lower than Max_Length: nothing is dropped + + Length (Source) = Length (Source'Old) + New_Item'Length + and then + Slice (Source, 1, Before - 1) = + Slice (Source'Old, 1, Before - 1) + and then + Slice (Source, Before, Before - 1 + New_Item'Length) = + New_Item + and then + (if Before <= Length (Source'Old) then + Slice (Source, Before + New_Item'Length, Length (Source)) = + Slice (Source'Old, Before, Length (Source'Old))), + + Length (Source) > Max_Length - New_Item'Length and then Drop = Left + => + -- The result is of maximal length and ends by the last + -- characters of Source. + + Length (Source) = Max_Length + and then + (if Before <= Length (Source'Old) then + Slice (Source, + Max_Length - Length (Source'Old) + Before, Max_Length) = + Slice (Source'Old, Before, Length (Source'Old))) + + -- Depending on when we reach Max_Length, either the first part + -- of Source is fully dropped and New_Item is partly dropped, + -- or New_Item is fully added and the first part of Source is + -- partly dropped. + + and then + (if Max_Length - Length (Source'Old) - 1 + Before + < New_Item'Length + then + -- The first characters of New_Item are dropped + + (if Length (Source'Old) - Before + 1 < Max_Length then + Slice (Source, + 1, Max_Length - Length (Source'Old) - 1 + Before) = + New_Item + (New_Item'Last - Max_Length + Length (Source'Old) + - Before + 2 + .. New_Item'Last)) + + else -- New_Item is added to the result + + Slice (Source, + Max_Length - Length (Source'Old) - New_Item'Length + + Before, + Max_Length - Length (Source'Old) - 1 + Before) = New_Item + + -- The first characters of Source (1 .. Before - 1) are + -- dropped. + + and then Slice (Source, 1, + Max_Length - Length (Source'Old) - New_Item'Length + - 1 + Before) = + Slice (Source'Old, + Length (Source'Old) + - Max_Length + New_Item'Length + 1, + Before - 1)), + + others -- Drop = Right + => + -- The result is of maximal length and starts by the first + -- characters of Source. + + Length (Source) = Max_Length + and then + Slice (Source, 1, Before - 1) = + Slice (Source'Old, 1, Before - 1) + + -- Depending on when we reach Max_Length, either the last part + -- of Source is fully dropped and New_Item is partly dropped, + -- or New_Item is fully added and the last part of Source is + -- partly dropped. + + and then + (if Before - 1 >= Max_Length - New_Item'Length then + + -- The last characters of New_Item are dropped + + Slice (Source, Before, Max_Length) = + New_Item (New_Item'First + .. Max_Length - Before + New_Item'First) + + else -- New_Item is fully added + + Slice (Source, Before, Before + New_Item'Length - 1) = + New_Item + + -- Then Source starting from Before is added but the + -- last characters are dropped. + + and then + Slice (Source, Before + New_Item'Length, Max_Length) = + Slice (Source'Old, + Before, Max_Length - New_Item'Length))); function Overwrite (Source : Bounded_String; @@ -623,16 +1857,85 @@ package Ada.Strings.Bounded is New_Item : String; Drop : Truncation := Error) return Bounded_String with - Pre => + Pre => Position - 1 <= Length (Source) and then (if New_Item'Length > Max_Length - (Position - 1) then Drop /= Error), - Post => - Length (Overwrite'Result) - = Natural'Max - (Length (Source), - Natural'Min (Max_Length, Position - 1 + New_Item'Length)), - Global => null; + Contract_Cases => + (Position - 1 <= Max_Length - New_Item'Length + => + -- The length is unchanged, unless New_Item overwrites further + -- than the end of Source. In this contract case, we suppose + -- New_Item doesn't overwrite further than Max_Length. + + Length (Overwrite'Result) = + Integer'Max (Length (Source), Position - 1 + New_Item'Length) + and then + Slice (Overwrite'Result, 1, Position - 1) = + Slice (Source, 1, Position - 1) + and then Slice (Overwrite'Result, + Position, Position - 1 + New_Item'Length) = + New_Item + and then + (if Position - 1 + New_Item'Length < Length (Source) then + + -- There are some unchanged characters of Source remaining + -- after New_Item. + + Slice (Overwrite'Result, + Position + New_Item'Length, Length (Source)) = + Slice (Source, + Position + New_Item'Length, Length (Source))), + + Position - 1 > Max_Length - New_Item'Length and then Drop = Left + => + Length (Overwrite'Result) = Max_Length + + -- If a part of the result has to be dropped, it means New_Item + -- is overwriting further than the end of Source. Thus the + -- result is necessarily ending by New_Item. However, we don't + -- know whether New_Item covers all Max_Length characters or + -- some characters of Source are remaining at the left. + + and then + (if New_Item'Length > Max_Length then + + -- New_Item covers all Max_Length characters + + To_String (Overwrite'Result) = + New_Item + (New_Item'Last - Max_Length + 1 .. New_Item'Last) + else + -- New_Item fully appears at the end + + Slice (Overwrite'Result, + Max_Length - New_Item'Length + 1, Max_Length) = + New_Item + + -- The left of Source is cut + + and then + Slice (Overwrite'Result, + 1, Max_Length - New_Item'Length) = + Slice (Source, + Position - Max_Length + New_Item'Length, + Position - 1)), + + others -- Drop = Right + => + -- The result is of maximal length and starts by the first + -- characters of Source. + + Length (Overwrite'Result) = Max_Length + and then + Slice (Overwrite'Result, 1, Position - 1) = + Slice (Source, 1, Position - 1) + + -- Then New_Item is written until Max_Length + + and then Slice (Overwrite'Result, Position, Max_Length) = + New_Item + (New_Item'First .. Max_Length - Position + New_Item'First)); procedure Overwrite (Source : in out Bounded_String; @@ -640,16 +1943,84 @@ package Ada.Strings.Bounded is New_Item : String; Drop : Truncation := Error) with - Pre => + Pre => Position - 1 <= Length (Source) and then (if New_Item'Length > Max_Length - (Position - 1) then Drop /= Error), - Post => - Length (Source) - = Natural'Max - (Length (Source)'Old, - Natural'Min (Max_Length, Position - 1 + New_Item'Length)), - Global => null; + Contract_Cases => + (Position - 1 <= Max_Length - New_Item'Length + => + -- The length of Source is unchanged, unless New_Item overwrites + -- further than the end of Source. In this contract case, we + -- suppose New_Item doesn't overwrite further than Max_Length. + + Length (Source) = Integer'Max + (Length (Source'Old), Position - 1 + New_Item'Length) + and then + Slice (Source, 1, Position - 1) = + Slice (Source'Old, 1, Position - 1) + and then Slice (Source, + Position, Position - 1 + New_Item'Length) = + New_Item + and then + (if Position - 1 + New_Item'Length < Length (Source'Old) then + + -- There are some unchanged characters of Source remaining + -- after New_Item. + + Slice (Source, + Position + New_Item'Length, Length (Source'Old)) = + Slice (Source'Old, + Position + New_Item'Length, Length (Source'Old))), + + Position - 1 > Max_Length - New_Item'Length and then Drop = Left + => + Length (Source) = Max_Length + + -- If a part of the result has to be dropped, it means New_Item + -- is overwriting further than the end of Source. Thus the + -- result is necessarily ending by New_Item. However, we don't + -- know whether New_Item covers all Max_Length characters or + -- some characters of Source are remaining at the left. + + and then + (if New_Item'Length > Max_Length then + + -- New_Item covers all Max_Length characters + + To_String (Source) = + New_Item + (New_Item'Last - Max_Length + 1 .. New_Item'Last) + else + -- New_Item fully appears at the end + + Slice (Source, + Max_Length - New_Item'Length + 1, Max_Length) = + New_Item + + -- The left of Source is cut + + and then + Slice (Source, 1, Max_Length - New_Item'Length) = + Slice (Source'Old, + Position - Max_Length + New_Item'Length, + Position - 1)), + + others -- Drop = Right + => + -- The result is of maximal length and starts by the first + -- characters of Source. + + Length (Source) = Max_Length + and then + Slice (Source, 1, Position - 1) = + Slice (Source'Old, 1, Position - 1) + + -- New_Item is written until Max_Length + + and then Slice (Source, Position, Max_Length) = + New_Item + (New_Item'First .. Max_Length - Position + New_Item'First)); function Delete (Source : Bounded_String; @@ -657,13 +2028,20 @@ package Ada.Strings.Bounded is Through : Natural) return Bounded_String with Pre => - (if Through <= From then From - 1 <= Length (Source)), + (if Through >= From then From - 1 <= Length (Source)), Contract_Cases => (Through >= From => - Length (Delete'Result) = Length (Source) - (Through - From + 1), + Length (Delete'Result) = + From - 1 + Natural'Max (Length (Source) - Through, 0) + and then + Slice (Delete'Result, 1, From - 1) = + Slice (Source, 1, From - 1) + and then + (if Through < Length (Source) then + Slice (Delete'Result, From, Length (Delete'Result)) = + Slice (Source, Through + 1, Length (Source))), others => - Length (Delete'Result) = Length (Source)), - + Delete'Result = Source), Global => null; procedure Delete @@ -672,12 +2050,19 @@ package Ada.Strings.Bounded is Through : Natural) with Pre => - (if Through <= From then From - 1 <= Length (Source)), + (if Through >= From then From - 1 <= Length (Source)), Contract_Cases => (Through >= From => - Length (Source) = Length (Source)'Old - (Through - From + 1), + Length (Source) = + From - 1 + Natural'Max (Length (Source'Old) - Through, 0) + and then + Slice (Source, 1, From - 1) = Slice (Source'Old, 1, From - 1) + and then + (if Through < Length (Source) then + Slice (Source, From, Length (Source)) = + Slice (Source'Old, Through + 1, Length (Source'Old))), others => - Length (Source) = Length (Source)'Old), + Source = Source'Old), Global => null; --------------------------------- @@ -688,31 +2073,111 @@ package Ada.Strings.Bounded is (Source : Bounded_String; Side : Trim_End) return Bounded_String with - Post => Length (Trim'Result) <= Length (Source), - Global => null; + Contract_Cases => + -- If all characters in Source are Space, the returned string is + -- empty. + + ((for all C of To_String (Source) => C = ' ') + => + Length (Trim'Result) = 0, + + -- Otherwise, the returned string is a slice of Source + + others + => + (declare + Low : constant Positive := + (if Side = Right then 1 + else Index_Non_Blank (Source, Forward)); + High : constant Positive := + (if Side = Left then Length (Source) + else Index_Non_Blank (Source, Backward)); + begin + To_String (Trim'Result) = Slice (Source, Low, High))), + Global => null; procedure Trim (Source : in out Bounded_String; Side : Trim_End) with - Post => Length (Source) <= Length (Source)'Old, - Global => null; + Contract_Cases => + -- If all characters in Source are Space, the returned string is + -- empty. + + ((for all C of To_String (Source) => C = ' ') + => + Length (Source) = 0, + + -- Otherwise, the returned string is a slice of Source + + others + => + (declare + Low : constant Positive := + (if Side = Right then 1 + else Index_Non_Blank (Source'Old, Forward)); + High : constant Positive := + (if Side = Left then Length (Source'Old) + else Index_Non_Blank (Source'Old, Backward)); + begin + To_String (Source) = Slice (Source'Old, Low, High))), + Global => null; function Trim (Source : Bounded_String; Left : Maps.Character_Set; Right : Maps.Character_Set) return Bounded_String with - Post => Length (Trim'Result) <= Length (Source), - Global => null; + Contract_Cases => + -- If all characters in Source are contained in one of the sets Left + -- or Right, then the returned string is empty. + + ((for all C of To_String (Source) => Maps.Is_In (C, Left)) + or else + (for all C of To_String (Source) => Maps.Is_In (C, Right)) + => + Length (Trim'Result) = 0, + + -- Otherwise, the returned string is a slice of Source + + others + => + (declare + Low : constant Positive := + Index (Source, Left, Outside, Forward); + High : constant Positive := + Index (Source, Right, Outside, Backward); + begin + To_String (Trim'Result) = Slice (Source, Low, High))), + Global => null; procedure Trim (Source : in out Bounded_String; Left : Maps.Character_Set; Right : Maps.Character_Set) with - Post => Length (Source) <= Length (Source)'Old, - Global => null; + Contract_Cases => + -- If all characters in Source are contained in one of the sets Left + -- or Right, then the returned string is empty. + + ((for all C of To_String (Source) => Maps.Is_In (C, Left)) + or else + (for all C of To_String (Source) => Maps.Is_In (C, Right)) + => + Length (Source) = 0, + + -- Otherwise, the returned string is a slice of Source + + others + => + (declare + Low : constant Positive := + Index (Source'Old, Left, Outside, Forward); + High : constant Positive := + Index (Source'Old, Right, Outside, Backward); + begin + To_String (Source) = Slice (Source'Old, Low, High))), + Global => null; function Head (Source : Bounded_String; @@ -720,9 +2185,54 @@ package Ada.Strings.Bounded is Pad : Character := Space; Drop : Truncation := Error) return Bounded_String with - Pre => (if Count > Max_Length then Drop /= Error), - Post => Length (Head'Result) = Natural'Min (Max_Length, Count), - Global => null; + Pre => (if Count > Max_Length then Drop /= Error), + Contract_Cases => + (Count <= Length (Source) + => + -- Source is cut + + To_String (Head'Result) = Slice (Source, 1, Count), + + Count > Length (Source) and then Count <= Max_Length + => + -- Source is followed by Pad characters + + Length (Head'Result) = Count + and then + Slice (Head'Result, 1, Length (Source)) = To_String (Source) + and then + Slice (Head'Result, Length (Source) + 1, Count) = + (1 .. Count - Length (Source) => Pad), + + Count > Max_Length and then Drop = Right + => + -- Source is followed by Pad characters + + Length (Head'Result) = Max_Length + and then + Slice (Head'Result, 1, Length (Source)) = To_String (Source) + and then + Slice (Head'Result, Length (Source) + 1, Max_Length) = + (1 .. Max_Length - Length (Source) => Pad), + + Count - Length (Source) > Max_Length and then Drop = Left + => + -- Source is fully dropped at the left + + To_String (Head'Result) = (1 .. Max_Length => Pad), + + others + => + -- Source is partly dropped at the left + + Length (Head'Result) = Max_Length + and then + Slice (Head'Result, 1, Max_Length - Count + Length (Source)) = + Slice (Source, Count - Max_Length + 1, Length (Source)) + and then + Slice (Head'Result, + Max_Length - Count + Length (Source) + 1, Max_Length) = + (1 .. Count - Length (Source) => Pad)); procedure Head (Source : in out Bounded_String; @@ -730,9 +2240,57 @@ package Ada.Strings.Bounded is Pad : Character := Space; Drop : Truncation := Error) with - Pre => (if Count > Max_Length then Drop /= Error), - Post => Length (Source) = Natural'Min (Max_Length, Count), - Global => null; + Pre => (if Count > Max_Length then Drop /= Error), + Contract_Cases => + (Count <= Length (Source) + => + -- Source is cut + + To_String (Source) = Slice (Source'Old, 1, Count), + + Count > Length (Source) and then Count <= Max_Length + => + -- Source is followed by Pad characters + + Length (Source) = Count + and then + Slice (Source, 1, Length (Source'Old)) = + To_String (Source'Old) + and then + Slice (Source, Length (Source'Old) + 1, Count) = + (1 .. Count - Length (Source'Old) => Pad), + + Count > Max_Length and then Drop = Right + => + -- Source is followed by Pad characters + + Length (Source) = Max_Length + and then + Slice (Source, 1, Length (Source'Old)) = + To_String (Source'Old) + and then + Slice (Source, Length (Source'Old) + 1, Max_Length) = + (1 .. Max_Length - Length (Source'Old) => Pad), + + Count - Length (Source) > Max_Length and then Drop = Left + => + -- Source is fully dropped on the left + + To_String (Source) = (1 .. Max_Length => Pad), + + others + => + -- Source is partly dropped on the left + + Length (Source) = Max_Length + and then + Slice (Source, 1, Max_Length - Count + Length (Source'Old)) = + Slice (Source'Old, + Count - Max_Length + 1, Length (Source'Old)) + and then + Slice (Source, + Max_Length - Count + Length (Source'Old) + 1, Max_Length) = + (1 .. Count - Length (Source'Old) => Pad)); function Tail (Source : Bounded_String; @@ -740,9 +2298,60 @@ package Ada.Strings.Bounded is Pad : Character := Space; Drop : Truncation := Error) return Bounded_String with - Pre => (if Count > Max_Length then Drop /= Error), - Post => Length (Tail'Result) = Natural'Min (Max_Length, Count), - Global => null; + Pre => (if Count > Max_Length then Drop /= Error), + Contract_Cases => + (Count < Length (Source) + => + -- Source is cut + + (if Count > 0 then + To_String (Tail'Result) = + Slice (Source, Length (Source) - Count + 1, Length (Source)) + else Length (Tail'Result) = 0), + + Count >= Length (Source) and then Count < Max_Length + => + -- Source is preceded by Pad characters + + Length (Tail'Result) = Count + and then + Slice (Tail'Result, 1, Count - Length (Source)) = + (1 .. Count - Length (Source) => Pad) + and then + Slice (Tail'Result, Count - Length (Source) + 1, Count) = + To_String (Source), + + Count >= Max_Length and then Drop = Left + => + -- Source is preceded by Pad characters + + Length (Tail'Result) = Max_Length + and then + Slice (Tail'Result, 1, Max_Length - Length (Source)) = + (1 .. Max_Length - Length (Source) => Pad) + and then + (if Length (Source) > 0 then + Slice (Tail'Result, + Max_Length - Length (Source) + 1, Max_Length) = + To_String (Source)), + + Count - Length (Source) >= Max_Length and then Drop /= Left + => + -- Source is fully dropped on the right + + To_String (Tail'Result) = (1 .. Max_Length => Pad), + + others + => + -- Source is partly dropped on the right + + Length (Tail'Result) = Max_Length + and then + Slice (Tail'Result, 1, Count - Length (Source)) = + (1 .. Count - Length (Source) => Pad) + and then + Slice (Tail'Result, Count - Length (Source) + 1, Max_Length) = + Slice (Source, 1, Max_Length - Count + Length (Source))); procedure Tail (Source : in out Bounded_String; @@ -750,9 +2359,62 @@ package Ada.Strings.Bounded is Pad : Character := Space; Drop : Truncation := Error) with - Pre => (if Count > Max_Length then Drop /= Error), - Post => Length (Source) = Natural'Min (Max_Length, Count), - Global => null; + Pre => (if Count > Max_Length then Drop /= Error), + Contract_Cases => + (Count < Length (Source) + => + -- Source is cut + + (if Count > 0 then + To_String (Source) = + Slice (Source'Old, + Length (Source'Old) - Count + 1, Length (Source'Old)) + else Length (Source) = 0), + + Count >= Length (Source) and then Count < Max_Length + => + -- Source is preceded by Pad characters + + Length (Source) = Count + and then + Slice (Source, 1, Count - Length (Source'Old)) = + (1 .. Count - Length (Source'Old) => Pad) + and then + Slice (Source, Count - Length (Source'Old) + 1, Count) = + To_String (Source'Old), + + Count >= Max_Length and then Drop = Left + => + -- Source is preceded by Pad characters + + Length (Source) = Max_Length + and then + Slice (Source, 1, Max_Length - Length (Source'Old)) = + (1 .. Max_Length - Length (Source'Old) => Pad) + and then + (if Length (Source'Old) > 0 then + Slice (Source, + Max_Length - Length (Source'Old) + 1, Max_Length) = + To_String (Source'Old)), + + Count - Length (Source) >= Max_Length and then Drop /= Left + => + -- Source is fully dropped at the right + + To_String (Source) = (1 .. Max_Length => Pad), + + others + => + -- Source is partly dropped at the right + + Length (Source) = Max_Length + and then + Slice (Source, 1, Count - Length (Source'Old)) = + (1 .. Count - Length (Source'Old) => Pad) + and then + Slice (Source, Count - Length (Source'Old) + 1, Max_Length) = + Slice (Source'Old, + 1, Max_Length - Count + Length (Source'Old))); ------------------------------------ -- String Constructor Subprograms -- @@ -762,64 +2424,113 @@ package Ada.Strings.Bounded is (Left : Natural; Right : Character) return Bounded_String with - Pre => Left <= Max_Length, - Post => Length ("*"'Result) = Left, - Global => null; + Pre => Left <= Max_Length, + Post => To_String ("*"'Result) = (1 .. Left => Right); function "*" (Left : Natural; Right : String) return Bounded_String with - Pre => (if Left /= 0 then Right'Length <= Max_Length / Left), - Post => Length ("*"'Result) = Left * Right'Length, - Global => null; + Pre => (if Left /= 0 then Right'Length <= Max_Length / Left), + Post => + Length ("*"'Result) = Left * Right'Length + and then + (if Right'Length > 0 then + (for all K in 1 .. Left * Right'Length => + Element ("*"'Result, K) = + Right (Right'First + (K - 1) mod Right'Length))); function "*" (Left : Natural; Right : Bounded_String) return Bounded_String with - Pre => (if Left /= 0 then Length (Right) <= Max_Length / Left), - Post => Length ("*"'Result) = Left * Length (Right), - Global => null; + Pre => (if Left /= 0 then Length (Right) <= Max_Length / Left), + Post => + Length ("*"'Result) = Left * Length (Right) + and then + (if Length (Right) > 0 then + (for all K in 1 .. Left * Length (Right) => + Element ("*"'Result, K) = + Element (Right, 1 + (K - 1) mod Length (Right)))); function Replicate (Count : Natural; Item : Character; Drop : Truncation := Error) return Bounded_String with - Pre => (if Count > Max_Length then Drop /= Error), - Post => - Length (Replicate'Result) - = Natural'Min (Max_Length, Count), - Global => null; + Pre => (if Count > Max_Length then Drop /= Error), + Post => + To_String (Replicate'Result) = + (1 .. Natural'Min (Max_Length, Count) => Item); function Replicate (Count : Natural; Item : String; Drop : Truncation := Error) return Bounded_String with - Pre => - (if Item'Length /= 0 - and then Count > Max_Length / Item'Length + Pre => + (if Count /= 0 and then Item'Length > Max_Length / Count then Drop /= Error), - Post => - Length (Replicate'Result) - = Natural'Min (Max_Length, Count * Item'Length), - Global => null; + Contract_Cases => + (Count = 0 or else Item'Length <= Max_Length / Count + => + Length (Replicate'Result) = Count * Item'Length + and then + (if Item'Length > 0 then + (for all K in 1 .. Count * Item'Length => + Element (Replicate'Result, K) = + Item (Item'First + (K - 1) mod Item'Length))), + Count /= 0 + and then Item'Length > Max_Length / Count + and then Drop = Right + => + Length (Replicate'Result) = Max_Length + and then + (for all K in 1 .. Max_Length => + Element (Replicate'Result, K) = + Item (Item'First + (K - 1) mod Item'Length)), + others -- Drop = Left + => + Length (Replicate'Result) = Max_Length + and then + (for all K in 1 .. Max_Length => + Element (Replicate'Result, K) = + Item (Item'Last - (Max_Length - K) mod Item'Length))); function Replicate (Count : Natural; Item : Bounded_String; Drop : Truncation := Error) return Bounded_String with - Pre => - (if Length (Item) /= 0 - and then Count > Max_Length / Length (Item) + Pre => + (if Count /= 0 and then Length (Item) > Max_Length / Count then Drop /= Error), - Post => - Length (Replicate'Result) - = Natural'Min (Max_Length, Count * Length (Item)), - Global => null; + Contract_Cases => + ((if Count /= 0 then Length (Item) <= Max_Length / Count) + => + Length (Replicate'Result) = Count * Length (Item) + and then + (if Length (Item) > 0 then + (for all K in 1 .. Count * Length (Item) => + Element (Replicate'Result, K) = + Element (Item, 1 + (K - 1) mod Length (Item)))), + Count /= 0 + and then Length (Item) > Max_Length / Count + and then Drop = Right + => + Length (Replicate'Result) = Max_Length + and then + (for all K in 1 .. Max_Length => + Element (Replicate'Result, K) = + Element (Item, 1 + (K - 1) mod Length (Item))), + others -- Drop = Left + => + Length (Replicate'Result) = Max_Length + and then + (for all K in 1 .. Max_Length => + Element (Replicate'Result, K) = + Element (Item, + Length (Item) - (Max_Length - K) mod Length (Item)))); private -- Most of the implementation is in the separate non generic package @@ -843,7 +2554,8 @@ package Ada.Strings.Bounded is -- the generic instantiation is compatible with the Super_String -- type declared in the Superbounded package. - function From_String (Source : String) return Bounded_String; + function From_String (Source : String) return Bounded_String + with Pre => Source'Length <= Max_Length; -- Private routine used only by Stream_Convert pragma Stream_Convert (Bounded_String, From_String, To_String); diff --git a/gcc/ada/libgnat/a-strfix.adb b/gcc/ada/libgnat/a-strfix.adb index 00967c4..31dea6c 100644 --- a/gcc/ada/libgnat/a-strfix.adb +++ b/gcc/ada/libgnat/a-strfix.adb @@ -214,7 +214,8 @@ package body Ada.Strings.Fixed with SPARK_Mode is -- Lemma_Split -- ----------------- - procedure Lemma_Split (Result : String) is + procedure Lemma_Split (Result : String) + is begin for K in Ptr + 1 .. Ptr + Right'Length loop Lemma_Mod (K - 1); @@ -307,7 +308,8 @@ package body Ada.Strings.Fixed with SPARK_Mode is From : Positive; Through : Natural; Justify : Alignment := Left; - Pad : Character := Space) with SPARK_Mode => Off is + Pad : Character := Space) + is begin Move (Source => Delete (Source, From, Through), Target => Source, @@ -403,7 +405,8 @@ package body Ada.Strings.Fixed with SPARK_Mode is (Source : in out String; Before : Positive; New_Item : String; - Drop : Truncation := Error) with SPARK_Mode => Off is + Drop : Truncation := Error) + is begin Move (Source => Insert (Source, Before, New_Item), Target => Source, @@ -419,7 +422,8 @@ package body Ada.Strings.Fixed with SPARK_Mode is Target : out String; Drop : Truncation := Error; Justify : Alignment := Left; - Pad : Character := Space) with SPARK_Mode => Off + Pad : Character := Space) + with SPARK_Mode => Off is Sfirst : constant Integer := Source'First; Slast : constant Integer := Source'Last; @@ -571,7 +575,8 @@ package body Ada.Strings.Fixed with SPARK_Mode is (Source : in out String; Position : Positive; New_Item : String; - Drop : Truncation := Right) with SPARK_Mode => Off is + Drop : Truncation := Right) + is begin Move (Source => Overwrite (Source, Position, New_Item), Target => Source, @@ -648,7 +653,8 @@ package body Ada.Strings.Fixed with SPARK_Mode is By : String; Drop : Truncation := Error; Justify : Alignment := Left; - Pad : Character := Space) with SPARK_Mode => Off is + Pad : Character := Space) + is begin Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad); end Replace_Slice; @@ -865,7 +871,7 @@ package body Ada.Strings.Fixed with SPARK_Mode is High, Low : Integer; begin - Low := Index (Source, Set => Left, Test => Outside, Going => Forward); + Low := Index (Source, Set => Left, Test => Outside, Going => Forward); -- Case where source comprises only characters in Left diff --git a/gcc/ada/libgnat/a-strfix.ads b/gcc/ada/libgnat/a-strfix.ads index 1a5ee94..1d9fd1b 100644 --- a/gcc/ada/libgnat/a-strfix.ads +++ b/gcc/ada/libgnat/a-strfix.ads @@ -382,7 +382,7 @@ package Ada.Strings.Fixed with SPARK_Mode is => Index'Result = 0, - -- Otherwise, a index in the range of Source is returned + -- Otherwise, an index in the range of Source is returned others => @@ -392,7 +392,7 @@ package Ada.Strings.Fixed with SPARK_Mode is Index'Result in Source'Range -- The character at the returned index satisfies the property - -- Test on Set + -- Test on Set. and then (Test = Inside) @@ -433,7 +433,7 @@ package Ada.Strings.Fixed with SPARK_Mode is => Index'Result = 0, - -- Otherwise, a index in the considered range of Source is returned + -- Otherwise, an index in the considered range of Source is returned others => @@ -904,7 +904,15 @@ package Ada.Strings.Fixed with SPARK_Mode is Justify : Alignment := Left; Pad : Character := Space) with - Pre => Low - 1 <= Source'Last, + Pre => + Low - 1 <= Source'Last + and then High >= Source'First - 1 + and then (if High >= Low + then Natural'Max (0, Low - Source'First) + <= Natural'Last + - By'Length + - Natural'Max (Source'Last - High, 0) + else Source'Length <= Natural'Last - By'Length), -- Incomplete contract @@ -966,7 +974,9 @@ package Ada.Strings.Fixed with SPARK_Mode is New_Item : String; Drop : Truncation := Error) with - Pre => Before - 1 in Source'First - 1 .. Source'Last, + Pre => + Before - 1 in Source'First - 1 .. Source'Last + and then Source'Length <= Natural'Last - New_Item'Length, -- Incomplete contract @@ -1033,7 +1043,11 @@ package Ada.Strings.Fixed with SPARK_Mode is New_Item : String; Drop : Truncation := Right) with - Pre => Position - 1 in Source'First - 1 .. Source'Last, + Pre => + Position - 1 in Source'First - 1 .. Source'Last + and then + (if Position - Source'First >= Source'Length - New_Item'Length + then Position - Source'First <= Natural'Last - New_Item'Length), -- Incomplete contract @@ -1133,31 +1147,15 @@ package Ada.Strings.Fixed with SPARK_Mode is -- Otherwise, the returned string is a slice of Source else - (for some Low in Source'Range => - (for some High in Source'Range => - - -- Trim returns the slice of Source between Low and High - - Trim'Result = Source (Low .. High) - - -- Values of Low and High and the characters at their - -- position depend on Side. - - and then - (if Side = Left then High = Source'Last - else Source (High) /= ' ') - and then - (if Side = Right then Low = Source'First - else Source (Low) /= ' ') - - -- All characters outside range Low .. High are - -- Space characters. - - and then - (for all J in Source'Range => - (if J < Low then Source (J) = ' ') - and then - (if J > High then Source (J) = ' '))))), + (declare + Low : constant Positive := + (if Side = Right then Source'First + else Index_Non_Blank (Source, Forward)); + High : constant Positive := + (if Side = Left then Source'Last + else Index_Non_Blank (Source, Backward)); + begin + Trim'Result = Source (Low .. High))), Global => null; -- Returns the string obtained by removing from Source all leading Space -- characters (if Side = Left), all trailing Space characters (if @@ -1203,30 +1201,13 @@ package Ada.Strings.Fixed with SPARK_Mode is -- Otherwise, the returned string is a slice of Source else - (for some Low in Source'Range => - (for some High in Source'Range => - - -- Trim returns the slice of Source between Low and High - - Trim'Result = Source (Low .. High) - - -- Characters at the bounds of the returned string are - -- not contained in Left or Right. - - and then not Ada.Strings.Maps.Is_In (Source (Low), Left) - and then not Ada.Strings.Maps.Is_In (Source (High), Right) - - -- All characters before Low are contained in Left. - -- All characters after High are contained in Right. - - and then - (for all K in Source'Range => - (if K < Low - then - Ada.Strings.Maps.Is_In (Source (K), Left)) - and then - (if K > High then - Ada.Strings.Maps.Is_In (Source (K), Right)))))), + (declare + Low : constant Positive := + Index (Source, Left, Outside, Forward); + High : constant Positive := + Index (Source, Right, Outside, Backward); + begin + Trim'Result = Source (Low .. High))), Global => null; -- Returns the string obtained by removing from Source all leading -- characters in Left and all trailing characters in Right. diff --git a/gcc/ada/libgnat/a-strmap.adb b/gcc/ada/libgnat/a-strmap.adb index 8ad9f12..c87f4e5 100644 --- a/gcc/ada/libgnat/a-strmap.adb +++ b/gcc/ada/libgnat/a-strmap.adb @@ -35,7 +35,17 @@ -- is bit-by-bit or character-by-character and therefore rather slow. -- Generally for character sets we favor the full 32-byte representation. -package body Ada.Strings.Maps is +-- Assertions, ghost code and loop invariants in this unit are meant for +-- analysis only, not for run-time checking, as it would be too costly +-- otherwise. This is enforced by setting the assertion policy to Ignore. + +pragma Assertion_Policy (Assert => Ignore, + Ghost => Ignore, + Loop_Invariant => Ignore); + +package body Ada.Strings.Maps + with SPARK_Mode +is --------- -- "-" -- @@ -102,9 +112,7 @@ package body Ada.Strings.Maps is (Element : Character; Set : Character_Set) return Boolean is - begin - return Set (Element); - end Is_In; + (Set (Element)); --------------- -- Is_Subset -- @@ -122,18 +130,37 @@ package body Ada.Strings.Maps is -- To_Domain -- --------------- - function To_Domain (Map : Character_Mapping) return Character_Sequence - is - Result : String (1 .. Map'Length); + function To_Domain (Map : Character_Mapping) return Character_Sequence is + Result : String (1 .. Map'Length) with Relaxed_Initialization; J : Natural; + type Character_Index is array (Character) of Natural with Ghost; + Indexes : Character_Index := (others => 0) with Ghost; + begin J := 0; for C in Map'Range loop if Map (C) /= C then J := J + 1; Result (J) := C; + Indexes (C) := J; end if; + + pragma Loop_Invariant (if Map = Identity then J = 0); + pragma Loop_Invariant (J <= Character'Pos (C) + 1); + pragma Loop_Invariant (Result (1 .. J)'Initialized); + pragma Loop_Invariant (for all K in 1 .. J => Result (K) <= C); + pragma Loop_Invariant + (SPARK_Proof_Sorted_Character_Sequence (Result (1 .. J))); + pragma Loop_Invariant + (for all D in Map'First .. C => + (if Map (D) = D then + Indexes (D) = 0 + else + Indexes (D) in 1 .. J + and then Result (Indexes (D)) = D)); + pragma Loop_Invariant + (for all Char of Result (1 .. J) => Map (Char) /= Char); end loop; return Result (1 .. J); @@ -146,7 +173,7 @@ package body Ada.Strings.Maps is function To_Mapping (From, To : Character_Sequence) return Character_Mapping is - Result : Character_Mapping; + Result : Character_Mapping with Relaxed_Initialization; Inserted : Character_Set := Null_Set; From_Len : constant Natural := From'Length; To_Len : constant Natural := To'Length; @@ -158,6 +185,9 @@ package body Ada.Strings.Maps is for Char in Character loop Result (Char) := Char; + pragma Loop_Invariant (Result (Result'First .. Char)'Initialized); + pragma Loop_Invariant + (for all C in Result'First .. Char => Result (C) = C); end loop; for J in From'Range loop @@ -167,6 +197,23 @@ package body Ada.Strings.Maps is Result (From (J)) := To (J - From'First + To'First); Inserted (From (J)) := True; + + pragma Loop_Invariant (Result'Initialized); + pragma Loop_Invariant + (for all K in From'First .. J => + Result (From (K)) = To (K - From'First + To'First) + and then Inserted (From (K))); + pragma Loop_Invariant + (for all Char in Character => + (Inserted (Char) = + (for some K in From'First .. J => Char = From (K)))); + pragma Loop_Invariant + (for all Char in Character => + (if not Inserted (Char) then Result (Char) = Char)); + pragma Loop_Invariant + (if (for all K in From'First .. J => + From (K) = To (J - From'First + To'First)) + then Result = Identity); end loop; return Result; @@ -176,19 +223,195 @@ package body Ada.Strings.Maps is -- To_Range -- -------------- - function To_Range (Map : Character_Mapping) return Character_Sequence - is - Result : String (1 .. Map'Length); + function To_Range (Map : Character_Mapping) return Character_Sequence is + + -- Extract from the postcondition of To_Domain the essential properties + -- that define Seq as the domain of Map. + function Is_Domain + (Map : Character_Mapping; + Seq : Character_Sequence) + return Boolean + is + (Seq'First = 1 + and then + SPARK_Proof_Sorted_Character_Sequence (Seq) + and then + (for all Char in Character => + (if (for all X of Seq => X /= Char) + then Map (Char) = Char)) + and then + (for all Char of Seq => Map (Char) /= Char)) + with + Ghost; + + -- Given Map, there is a unique sequence Seq for which + -- Is_Domain(Map,Seq) holds. + procedure Lemma_Domain_Unicity + (Map : Character_Mapping; + Seq1, Seq2 : Character_Sequence) + with + Ghost, + Pre => Is_Domain (Map, Seq1) + and then Is_Domain (Map, Seq2), + Post => Seq1 = Seq2; + + -- Isolate the proof that To_Domain(Map) returns a sequence for which + -- Is_Domain holds. + procedure Lemma_Is_Domain (Map : Character_Mapping) + with + Ghost, + Post => Is_Domain (Map, To_Domain (Map)); + + -- Deduce the alternative expression of sortedness from the one in + -- SPARK_Proof_Sorted_Character_Sequence which compares consecutive + -- elements. + procedure Lemma_Is_Sorted (Seq : Character_Sequence) + with + Ghost, + Pre => SPARK_Proof_Sorted_Character_Sequence (Seq), + Post => (for all J in Seq'Range => + (for all K in Seq'Range => + (if J < K then Seq (J) < Seq (K)))); + + -------------------------- + -- Lemma_Domain_Unicity -- + -------------------------- + + procedure Lemma_Domain_Unicity + (Map : Character_Mapping; + Seq1, Seq2 : Character_Sequence) + is + J : Positive := 1; + + begin + while J <= Seq1'Last + and then J <= Seq2'Last + and then Seq1 (J) = Seq2 (J) + loop + pragma Loop_Invariant + (Seq1 (Seq1'First .. J) = Seq2 (Seq2'First .. J)); + + if J = Positive'Last then + return; + end if; + + J := J + 1; + end loop; + + Lemma_Is_Sorted (Seq1); + Lemma_Is_Sorted (Seq2); + + if J <= Seq1'Last + and then J <= Seq2'Last + then + if Seq1 (J) < Seq2 (J) then + pragma Assert (for all X of Seq2 => X /= Seq1 (J)); + pragma Assert (Map (Seq1 (J)) = Seq1 (J)); + pragma Assert (False); + else + pragma Assert (for all X of Seq1 => X /= Seq2 (J)); + pragma Assert (Map (Seq2 (J)) = Seq2 (J)); + pragma Assert (False); + end if; + + elsif J <= Seq1'Last then + pragma Assert (for all X of Seq2 => X /= Seq1 (J)); + pragma Assert (Map (Seq1 (J)) = Seq1 (J)); + pragma Assert (False); + + elsif J <= Seq2'Last then + pragma Assert (for all X of Seq1 => X /= Seq2 (J)); + pragma Assert (Map (Seq2 (J)) = Seq2 (J)); + pragma Assert (False); + end if; + end Lemma_Domain_Unicity; + + --------------------- + -- Lemma_Is_Domain -- + --------------------- + + procedure Lemma_Is_Domain (Map : Character_Mapping) is + Ignore : constant Character_Sequence := To_Domain (Map); + begin + null; + end Lemma_Is_Domain; + + --------------------- + -- Lemma_Is_Sorted -- + --------------------- + + procedure Lemma_Is_Sorted (Seq : Character_Sequence) is + begin + for A in Seq'Range loop + exit when A = Positive'Last; + + for B in A + 1 .. Seq'Last loop + pragma Loop_Invariant + (for all K in A + 1 .. B => Seq (A) < Seq (K)); + end loop; + + pragma Loop_Invariant + (for all J in Seq'First .. A => + (for all K in Seq'Range => + (if J < K then Seq (J) < Seq (K)))); + end loop; + end Lemma_Is_Sorted; + + -- Local variables + + Result : String (1 .. Map'Length) with Relaxed_Initialization; J : Natural; + + -- Repeat the computation from To_Domain in ghost code, in order to + -- prove the relationship between Result and To_Domain(Map). + + Domain : String (1 .. Map'Length) with Ghost, Relaxed_Initialization; + type Character_Index is array (Character) of Natural with Ghost; + Indexes : Character_Index := (others => 0) with Ghost; + + -- Start of processing for To_Range + begin J := 0; for C in Map'Range loop if Map (C) /= C then J := J + 1; Result (J) := Map (C); + Domain (J) := C; + Indexes (C) := J; end if; + + -- Repeat the loop invariants from To_Domain regarding Domain and + -- Indexes. Add similar loop invariants for Result and Indexes. + + pragma Loop_Invariant (J <= Character'Pos (C) + 1); + pragma Loop_Invariant (Result (1 .. J)'Initialized); + pragma Loop_Invariant (Domain (1 .. J)'Initialized); + pragma Loop_Invariant (for all K in 1 .. J => Domain (K) <= C); + pragma Loop_Invariant + (SPARK_Proof_Sorted_Character_Sequence (Domain (1 .. J))); + pragma Loop_Invariant + (for all D in Map'First .. C => + (if Map (D) = D then + Indexes (D) = 0 + else + Indexes (D) in 1 .. J + and then Domain (Indexes (D)) = D + and then Result (Indexes (D)) = Map (D))); + pragma Loop_Invariant + (for all Char of Domain (1 .. J) => Map (Char) /= Char); + pragma Loop_Invariant + (for all K in 1 .. J => Result (K) = Map (Domain (K))); end loop; + -- Show the equality of Domain and To_Domain(Map) + + Lemma_Is_Domain (Map); + Lemma_Domain_Unicity (Map, Domain (1 .. J), To_Domain (Map)); + pragma Assert + (for all K in 1 .. J => Domain (K) = To_Domain (Map) (K)); + pragma Assert (To_Domain (Map)'Length = J); + return Result (1 .. J); end To_Range; @@ -197,18 +420,26 @@ package body Ada.Strings.Maps is --------------- function To_Ranges (Set : Character_Set) return Character_Ranges is - Max_Ranges : Character_Ranges (1 .. Set'Length / 2 + 1); + Max_Ranges : Character_Ranges (1 .. Set'Length / 2 + 1) + with Relaxed_Initialization; Range_Num : Natural; C : Character; + C_Iter : Character with Ghost; begin C := Character'First; Range_Num := 0; loop + C_Iter := C; + -- Skip gap between subsets while not Set (C) loop + pragma Loop_Invariant + (Character'Pos (C) >= Character'Pos (C'Loop_Entry)); + pragma Loop_Invariant + (for all Char in C'Loop_Entry .. C => not Set (Char)); exit when C = Character'Last; C := Character'Succ (C); end loop; @@ -221,16 +452,45 @@ package body Ada.Strings.Maps is -- Span a subset loop + pragma Loop_Invariant + (Character'Pos (C) >= Character'Pos (C'Loop_Entry)); + pragma Loop_Invariant + (for all Char in C'Loop_Entry .. C => + (if Char /= C then Set (Char))); exit when not Set (C) or else C = Character'Last; C := Character'Succ (C); end loop; if Set (C) then - Max_Ranges (Range_Num). High := C; + Max_Ranges (Range_Num).High := C; exit; else - Max_Ranges (Range_Num). High := Character'Pred (C); + Max_Ranges (Range_Num).High := Character'Pred (C); end if; + + pragma Assert + (for all Char in C_Iter .. C => + (Set (Char) = + (Char in Max_Ranges (Range_Num).Low .. + Max_Ranges (Range_Num).High))); + pragma Assert + (for all Char in Character'First .. C_Iter => + (if Char /= C_Iter then + (Set (Char) = + (for some Span of Max_Ranges (1 .. Range_Num - 1) => + Char in Span.Low .. Span.High)))); + + pragma Loop_Invariant (2 * Range_Num <= Character'Pos (C) + 1); + pragma Loop_Invariant (Max_Ranges (1 .. Range_Num)'Initialized); + pragma Loop_Invariant (not Set (C)); + pragma Loop_Invariant + (for all Char in Character'First .. C => + (Set (Char) = + (for some Span of Max_Ranges (1 .. Range_Num) => + Char in Span.Low .. Span.High))); + pragma Loop_Invariant + (for all Span of Max_Ranges (1 .. Range_Num) => + (for all Char in Span.Low .. Span.High => Set (Char))); end loop; return Max_Ranges (1 .. Range_Num); @@ -241,7 +501,8 @@ package body Ada.Strings.Maps is ----------------- function To_Sequence (Set : Character_Set) return Character_Sequence is - Result : String (1 .. Character'Pos (Character'Last) + 1); + Result : String (1 .. Character'Pos (Character'Last) + 1) + with Relaxed_Initialization; Count : Natural := 0; begin for Char in Set'Range loop @@ -249,6 +510,17 @@ package body Ada.Strings.Maps is Count := Count + 1; Result (Count) := Char; end if; + + pragma Loop_Invariant (Count <= Character'Pos (Char) + 1); + pragma Loop_Invariant (Result (1 .. Count)'Initialized); + pragma Loop_Invariant (for all K in 1 .. Count => Result (K) <= Char); + pragma Loop_Invariant + (SPARK_Proof_Sorted_Character_Sequence (Result (1 .. Count))); + pragma Loop_Invariant + (for all C in Set'First .. Char => + (Set (C) = (for some X of Result (1 .. Count) => C = X))); + pragma Loop_Invariant + (for all Char of Result (1 .. Count) => Is_In (Char, Set)); end loop; return Result (1 .. Count); @@ -259,30 +531,37 @@ package body Ada.Strings.Maps is ------------ function To_Set (Ranges : Character_Ranges) return Character_Set is - Result : Character_Set; + Result : Character_Set := Null_Set; begin - for C in Result'Range loop - Result (C) := False; - end loop; - for R in Ranges'Range loop for C in Ranges (R).Low .. Ranges (R).High loop Result (C) := True; + pragma Loop_Invariant + (for all Char in Character => + Result (Char) = + ((for some Prev in Ranges'First .. R - 1 => + Char in Ranges (Prev).Low .. Ranges (Prev).High) + or else (Char in Ranges (R).Low .. C))); end loop; + + pragma Loop_Invariant + (for all Char in Character => + Result (Char) = + (for some Prev in Ranges'First .. R => + Char in Ranges (Prev).Low .. Ranges (Prev).High)); end loop; return Result; end To_Set; function To_Set (Span : Character_Range) return Character_Set is - Result : Character_Set; + Result : Character_Set := Null_Set; begin - for C in Result'Range loop - Result (C) := False; - end loop; - for C in Span.Low .. Span.High loop Result (C) := True; + pragma Loop_Invariant + (for all Char in Character => + Result (Char) = (Char in Span.Low .. C)); end loop; return Result; @@ -293,6 +572,10 @@ package body Ada.Strings.Maps is begin for J in Sequence'Range loop Result (Sequence (J)) := True; + pragma Loop_Invariant + (for all Char in Character => + Result (Char) = + (for some K in Sequence'First .. J => Char = Sequence (K))); end loop; return Result; @@ -313,8 +596,6 @@ package body Ada.Strings.Maps is (Map : Character_Mapping; Element : Character) return Character is - begin - return Map (Element); - end Value; + (Map (Element)); end Ada.Strings.Maps; diff --git a/gcc/ada/libgnat/a-strmap.ads b/gcc/ada/libgnat/a-strmap.ads index c35c392..1a15d5d 100644 --- a/gcc/ada/libgnat/a-strmap.ads +++ b/gcc/ada/libgnat/a-strmap.ads @@ -33,15 +33,24 @@ -- -- ------------------------------------------------------------------------------ +-- The package Strings.Maps defines the types, operations, and other entities +-- needed for character sets and character-to-character mappings. + -- Preconditions in this unit are meant for analysis only, not for run-time -- checking, so that the expected exceptions are raised. This is enforced by --- setting the corresponding assertion policy to Ignore. +-- setting the corresponding assertion policy to Ignore. Postconditions and +-- ghost code should not be executed at runtime as well, in order not to slow +-- down the execution of these functions. -pragma Assertion_Policy (Pre => Ignore); +pragma Assertion_Policy (Pre => Ignore, + Post => Ignore, + Ghost => Ignore); with Ada.Characters.Latin_1; -package Ada.Strings.Maps is +package Ada.Strings.Maps + with SPARK_Mode +is pragma Pure; -- In accordance with Ada 2005 AI-362 @@ -51,9 +60,10 @@ package Ada.Strings.Maps is type Character_Set is private; pragma Preelaborable_Initialization (Character_Set); - -- Representation for a set of character values: + -- An object of type Character_Set represents a set of characters. Null_Set : constant Character_Set; + -- Null_Set represents the set containing no characters. --------------------------- -- Constructors for Sets -- @@ -63,9 +73,12 @@ package Ada.Strings.Maps is Low : Character; High : Character; end record; - -- Represents Character range Low .. High + -- An object Obj of type Character_Range represents the set of characters + -- in the range Obj.Low .. Obj.High. type Character_Ranges is array (Positive range <>) of Character_Range; + -- An object Obj of type Character_Ranges represents the union of the sets + -- corresponding to Obj(I) for I in Obj'Range. function To_Set (Ranges : Character_Ranges) return Character_Set with Post => @@ -78,6 +91,8 @@ package Ada.Strings.Maps is (for all Span of Ranges => (for all Char in Span.Low .. Span.High => Is_In (Char, To_Set'Result))); + -- If Ranges'Length=0 then Null_Set is returned; otherwise, the returned + -- value represents the set corresponding to Ranges. function To_Set (Span : Character_Range) return Character_Set with Post => @@ -87,6 +102,7 @@ package Ada.Strings.Maps is (if Is_In (Char, To_Set'Result) then Char in Span.Low .. Span.High)) and then (for all Char in Span.Low .. Span.High => Is_In (Char, To_Set'Result)); + -- The returned value represents the set containing each character in Span. function To_Ranges (Set : Character_Set) return Character_Ranges with Post => @@ -100,6 +116,12 @@ package Ada.Strings.Maps is and then (for all Span of To_Ranges'Result => (for all Char in Span.Low .. Span.High => Is_In (Char, Set))); + -- If Set = Null_Set, then an empty Character_Ranges array is returned; + -- otherwise, the shortest array of contiguous ranges of Character values + -- in Set, in increasing order of Low, is returned. + -- + -- The postcondition above does not express that the result is the shortest + -- array and that it is sorted. ---------------------------------- -- Operations on Character Sets -- @@ -111,6 +133,13 @@ package Ada.Strings.Maps is = (for all Char in Character => (Is_In (Char, Left) = Is_In (Char, Right))); + -- The function "=" returns True if Left and Right represent identical + -- sets, and False otherwise. + + -- Each of the logical operators "not", "and", "or", and "xor" returns a + -- Character_Set value that represents the set obtained by applying the + -- corresponding operation to the set(s) represented by the parameter(s) + -- of the operator. function "not" (Right : Character_Set) return Character_Set with Post => @@ -146,10 +175,12 @@ package Ada.Strings.Maps is (Is_In (Char, "-"'Result) = (Is_In (Char, Left) and not Is_In (Char, Right)))); + -- "-"(Left, Right) is equivalent to "and"(Left, "not"(Right)). function Is_In (Element : Character; Set : Character_Set) return Boolean; + -- Is_In returns True if Element is in Set, and False otherwise. function Is_Subset (Elements : Character_Set; @@ -160,6 +191,8 @@ package Ada.Strings.Maps is = (for all Char in Character => (if Is_In (Char, Elements) then Is_In (Char, Set))); + -- Is_Subset returns True if Elements is a subset of Set, and False + -- otherwise. function "<=" (Left : Character_Set; @@ -167,7 +200,23 @@ package Ada.Strings.Maps is renames Is_Subset; subtype Character_Sequence is String; - -- Alternative representation for a set of character values + -- The Character_Sequence subtype is used to portray a set of character + -- values and also to identify the domain and range of a character mapping. + + function SPARK_Proof_Sorted_Character_Sequence + (Seq : Character_Sequence) return Boolean + is + (for all J in Seq'Range => + (if J /= Seq'Last then Seq (J) < Seq (J + 1))) + with + Ghost; + -- Check whether the Character_Sequence is sorted in stricly increasing + -- order, as expected from the result of To_Sequence and To_Domain. + + -- Sequence portrays the set of character values that it explicitly + -- contains (ignoring duplicates). Singleton portrays the set comprising a + -- single Character. Each of the To_Set functions returns a Character_Set + -- value that represents the set portrayed by Sequence or Singleton. function To_Set (Sequence : Character_Sequence) return Character_Set with Post => @@ -197,10 +246,10 @@ package Ada.Strings.Maps is and then (for all Char of To_Sequence'Result => Is_In (Char, Set)) and then - (for all J in To_Sequence'Result'Range => - (for all K in To_Sequence'Result'Range => - (if J /= K - then To_Sequence'Result (J) /= To_Sequence'Result (K)))); + SPARK_Proof_Sorted_Character_Sequence (To_Sequence'Result); + -- The function To_Sequence returns a Character_Sequence value containing + -- each of the characters in the set represented by Set, in ascending order + -- with no duplicates. ------------------------------------ -- Character Mapping Declarations -- @@ -208,13 +257,39 @@ package Ada.Strings.Maps is type Character_Mapping is private; pragma Preelaborable_Initialization (Character_Mapping); - -- Representation for a character to character mapping: + -- An object of type Character_Mapping represents a Character-to-Character + -- mapping. + + type SPARK_Proof_Character_Mapping_Model is + array (Character) of Character + with Ghost; + -- Publicly visible model of a Character_Mapping + + function SPARK_Proof_Model + (Map : Character_Mapping) + return SPARK_Proof_Character_Mapping_Model + with Ghost; + -- Creation of a publicly visible model of a Character_Mapping function Value (Map : Character_Mapping; - Element : Character) return Character; + Element : Character) return Character + with + Post => Value'Result = SPARK_Proof_Model (Map) (Element); + -- The function Value returns the Character value to which Element maps + -- with respect to the mapping represented by Map. + + -- A character C matches a pattern character P with respect to a given + -- Character_Mapping value Map if Value(Map, C) = P. A string S matches + -- a pattern string P with respect to a given Character_Mapping if + -- their lengths are the same and if each character in S matches its + -- corresponding character in the pattern string P. + + -- String handling subprograms that deal with character mappings have + -- parameters whose type is Character_Mapping. Identity : constant Character_Mapping; + -- Identity maps each Character to itself. ---------------------------- -- Operations on Mappings -- @@ -240,6 +315,10 @@ package Ada.Strings.Maps is and then (if (for all X of From => Char /= X) then Value (To_Mapping'Result, Char) = Char))); + -- To_Mapping produces a Character_Mapping such that each element of From + -- maps to the corresponding element of To, and each other character maps + -- to itself. If From'Length /= To'Length, or if some character is repeated + -- in From, then Translation_Error is propagated. function To_Domain (Map : Character_Mapping) return Character_Sequence with @@ -248,24 +327,40 @@ package Ada.Strings.Maps is and then To_Domain'Result'First = 1 and then + SPARK_Proof_Sorted_Character_Sequence (To_Domain'Result) + and then (for all Char in Character => (if (for all X of To_Domain'Result => X /= Char) then Value (Map, Char) = Char)) and then (for all Char of To_Domain'Result => Value (Map, Char) /= Char); + -- To_Domain returns the shortest Character_Sequence value D such that each + -- character not in D maps to itself, and such that the characters in D are + -- in ascending order. The lower bound of D is 1. function To_Range (Map : Character_Mapping) return Character_Sequence with Post => To_Range'Result'First = 1 and then - To_Range'Result'Last = To_Domain (Map)'Last + To_Range'Result'Length = To_Domain (Map)'Length and then (for all J in To_Range'Result'Range => To_Range'Result (J) = Value (Map, To_Domain (Map) (J))); + -- To_Range returns the Character_Sequence value R, such that if D = + -- To_Domain(Map), then R has the same bounds as D, and D(I) maps to + -- R(I) for each I in D'Range. + -- + -- A direct encoding of the Ada RM would be the postcondition + -- To_Range'Result'Last = To_Domain (Map)'Last + -- which is not provable unless the postcondition of To_Domain is also + -- strengthened to state the value of the high bound for an empty result. type Character_Mapping_Function is access function (From : Character) return Character; + -- An object F of type Character_Mapping_Function maps a Character value C + -- to the Character value F.all(C), which is said to match C with respect + -- to mapping function F. private pragma Inline (Is_In); @@ -285,6 +380,12 @@ private type Character_Mapping is array (Character) of Character; + function SPARK_Proof_Model + (Map : Character_Mapping) + return SPARK_Proof_Character_Mapping_Model + is + (SPARK_Proof_Character_Mapping_Model (Map)); + package L renames Ada.Characters.Latin_1; Identity : constant Character_Mapping := diff --git a/gcc/ada/libgnat/a-strsea.ads b/gcc/ada/libgnat/a-strsea.ads index 4396747..f4e7d36 100644 --- a/gcc/ada/libgnat/a-strsea.ads +++ b/gcc/ada/libgnat/a-strsea.ads @@ -213,7 +213,7 @@ package Ada.Strings.Search with SPARK_Mode is => Index'Result = 0, - -- Otherwise, a index in the range of Source is returned + -- Otherwise, an index in the range of Source is returned others => @@ -222,7 +222,7 @@ package Ada.Strings.Search with SPARK_Mode is Index'Result in Source'Range -- The character at the returned index satisfies the property - -- Test on Set + -- Test on Set. and then (Test = Inside) = Ada.Strings.Maps.Is_In (Source (Index'Result), Set) @@ -377,7 +377,7 @@ package Ada.Strings.Search with SPARK_Mode is => Index'Result = 0, - -- Otherwise, a index in the considered range of Source is returned + -- Otherwise, an index in the considered range of Source is returned others => diff --git a/gcc/ada/libgnat/a-strsup.adb b/gcc/ada/libgnat/a-strsup.adb index 1e85cc2..a94d6ca 100644 --- a/gcc/ada/libgnat/a-strsup.adb +++ b/gcc/ada/libgnat/a-strsup.adb @@ -29,10 +29,17 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Strings.Maps; use Ada.Strings.Maps; -with Ada.Strings.Search; +-- Ghost code, loop invariants and assertions in this unit are meant for +-- analysis only, not for run-time checking, as it would be too costly +-- otherwise. This is enforced by setting the assertion policy to Ignore. -package body Ada.Strings.Superbounded is +pragma Assertion_Policy (Ghost => Ignore, + Loop_Invariant => Ignore, + Assert => Ignore); + +with Ada.Strings.Maps; use Ada.Strings.Maps; + +package body Ada.Strings.Superbounded with SPARK_Mode is ------------ -- Concat -- @@ -53,9 +60,13 @@ package body Ada.Strings.Superbounded is raise Ada.Strings.Length_Error; end if; - Result.Current_Length := Nlen; Result.Data (1 .. Llen) := Left.Data (1 .. Llen); - Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen); + + if Rlen > 0 then + Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen); + end if; + + Result.Current_Length := Nlen; end; end return; end Concat; @@ -74,9 +85,13 @@ package body Ada.Strings.Superbounded is raise Ada.Strings.Length_Error; end if; - Result.Current_Length := Nlen; Result.Data (1 .. Llen) := Left.Data (1 .. Llen); - Result.Data (Llen + 1 .. Nlen) := Right; + + if Right'Length > 0 then + Result.Data (Llen + 1 .. Nlen) := Super_String_Data (Right); + end if; + + Result.Current_Length := Nlen; end; end return; end Concat; @@ -97,9 +112,13 @@ package body Ada.Strings.Superbounded is raise Ada.Strings.Length_Error; end if; + Result.Data (1 .. Llen) := Super_String_Data (Left); + + if Rlen > 0 then + Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen); + end if; + Result.Current_Length := Nlen; - Result.Data (1 .. Llen) := Left; - Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen); end; end return; end Concat; @@ -117,9 +136,9 @@ package body Ada.Strings.Superbounded is raise Ada.Strings.Length_Error; end if; - Result.Current_Length := Llen + 1; Result.Data (1 .. Llen) := Left.Data (1 .. Llen); - Result.Data (Result.Current_Length) := Right; + Result.Data (Llen + 1) := Right; + Result.Current_Length := Llen + 1; end; end return; end Concat; @@ -137,10 +156,9 @@ package body Ada.Strings.Superbounded is raise Ada.Strings.Length_Error; end if; - Result.Current_Length := Rlen + 1; Result.Data (1) := Left; - Result.Data (2 .. Result.Current_Length) := - Right.Data (1 .. Rlen); + Result.Data (2 .. Rlen + 1) := Right.Data (1 .. Rlen); + Result.Current_Length := Rlen + 1; end; end return; end Concat; @@ -154,9 +172,7 @@ package body Ada.Strings.Superbounded is Right : Super_String) return Boolean is begin - return Left.Current_Length = Right.Current_Length - and then Left.Data (1 .. Left.Current_Length) = - Right.Data (1 .. Right.Current_Length); + return Super_To_String (Left) = Super_To_String (Right); end "="; function Equal @@ -164,8 +180,7 @@ package body Ada.Strings.Superbounded is Right : String) return Boolean is begin - return Left.Current_Length = Right'Length - and then Left.Data (1 .. Left.Current_Length) = Right; + return Super_To_String (Left) = Right; end Equal; function Equal @@ -173,8 +188,7 @@ package body Ada.Strings.Superbounded is Right : Super_String) return Boolean is begin - return Left'Length = Right.Current_Length - and then Left = Right.Data (1 .. Right.Current_Length); + return Left = Super_To_String (Right); end Equal; ------------- @@ -186,8 +200,7 @@ package body Ada.Strings.Superbounded is Right : Super_String) return Boolean is begin - return Left.Data (1 .. Left.Current_Length) > - Right.Data (1 .. Right.Current_Length); + return Super_To_String (Left) > Super_To_String (Right); end Greater; function Greater @@ -195,7 +208,7 @@ package body Ada.Strings.Superbounded is Right : String) return Boolean is begin - return Left.Data (1 .. Left.Current_Length) > Right; + return Super_To_String (Left) > Right; end Greater; function Greater @@ -203,7 +216,7 @@ package body Ada.Strings.Superbounded is Right : Super_String) return Boolean is begin - return Left > Right.Data (1 .. Right.Current_Length); + return Left > Super_To_String (Right); end Greater; ---------------------- @@ -215,8 +228,7 @@ package body Ada.Strings.Superbounded is Right : Super_String) return Boolean is begin - return Left.Data (1 .. Left.Current_Length) >= - Right.Data (1 .. Right.Current_Length); + return Super_To_String (Left) >= Super_To_String (Right); end Greater_Or_Equal; function Greater_Or_Equal @@ -224,7 +236,7 @@ package body Ada.Strings.Superbounded is Right : String) return Boolean is begin - return Left.Data (1 .. Left.Current_Length) >= Right; + return Super_To_String (Left) >= Right; end Greater_Or_Equal; function Greater_Or_Equal @@ -232,7 +244,7 @@ package body Ada.Strings.Superbounded is Right : Super_String) return Boolean is begin - return Left >= Right.Data (1 .. Right.Current_Length); + return Left >= Super_To_String (Right); end Greater_Or_Equal; ---------- @@ -244,8 +256,7 @@ package body Ada.Strings.Superbounded is Right : Super_String) return Boolean is begin - return Left.Data (1 .. Left.Current_Length) < - Right.Data (1 .. Right.Current_Length); + return Super_To_String (Left) < Super_To_String (Right); end Less; function Less @@ -253,7 +264,7 @@ package body Ada.Strings.Superbounded is Right : String) return Boolean is begin - return Left.Data (1 .. Left.Current_Length) < Right; + return Super_To_String (Left) < Right; end Less; function Less @@ -261,7 +272,7 @@ package body Ada.Strings.Superbounded is Right : Super_String) return Boolean is begin - return Left < Right.Data (1 .. Right.Current_Length); + return Left < Super_To_String (Right); end Less; ------------------- @@ -273,8 +284,7 @@ package body Ada.Strings.Superbounded is Right : Super_String) return Boolean is begin - return Left.Data (1 .. Left.Current_Length) <= - Right.Data (1 .. Right.Current_Length); + return Super_To_String (Left) <= Super_To_String (Right); end Less_Or_Equal; function Less_Or_Equal @@ -282,7 +292,7 @@ package body Ada.Strings.Superbounded is Right : String) return Boolean is begin - return Left.Data (1 .. Left.Current_Length) <= Right; + return Super_To_String (Left) <= Right; end Less_Or_Equal; function Less_Or_Equal @@ -290,7 +300,7 @@ package body Ada.Strings.Superbounded is Right : Super_String) return Boolean is begin - return Left <= Right.Data (1 .. Right.Current_Length); + return Left <= Super_To_String (Right); end Less_Or_Equal; ---------------------- @@ -307,20 +317,20 @@ package body Ada.Strings.Superbounded is begin if Slen <= Max_Length then + Target.Data (1 .. Slen) := Super_String_Data (Source); Target.Current_Length := Slen; - Target.Data (1 .. Slen) := Source; else case Drop is when Strings.Right => + Target.Data (1 .. Max_Length) := Super_String_Data + (Source (Source'First .. Source'First - 1 + Max_Length)); Target.Current_Length := Max_Length; - Target.Data (1 .. Max_Length) := - Source (Source'First .. Source'First - 1 + Max_Length); when Strings.Left => + Target.Data (1 .. Max_Length) := Super_String_Data + (Source (Source'Last - (Max_Length - 1) .. Source'Last)); Target.Current_Length := Max_Length; - Target.Data (1 .. Max_Length) := - Source (Source'Last - (Max_Length - 1) .. Source'Last); when Strings.Error => raise Ada.Strings.Length_Error; @@ -343,17 +353,18 @@ package body Ada.Strings.Superbounded is Result : Super_String (Max_Length); Llen : constant Natural := Left.Current_Length; Rlen : constant Natural := Right.Current_Length; - Nlen : constant Natural := Llen + Rlen; begin - if Nlen <= Max_Length then - Result.Current_Length := Nlen; + if Llen <= Max_Length - Rlen then Result.Data (1 .. Llen) := Left.Data (1 .. Llen); - Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen); - else - Result.Current_Length := Max_Length; + if Rlen > 0 then + Result.Data (Llen + 1 .. Llen + Rlen) := Right.Data (1 .. Rlen); + end if; + + Result.Current_Length := Llen + Rlen; + else case Drop is when Strings.Right => if Llen >= Max_Length then -- only case is Llen = Max_Length @@ -379,6 +390,8 @@ package body Ada.Strings.Superbounded is when Strings.Error => raise Ada.Strings.Length_Error; end case; + + Result.Current_Length := Max_Length; end if; return Result; @@ -392,16 +405,15 @@ package body Ada.Strings.Superbounded is Max_Length : constant Positive := Source.Max_Length; Llen : constant Natural := Source.Current_Length; Rlen : constant Natural := New_Item.Current_Length; - Nlen : constant Natural := Llen + Rlen; begin - if Nlen <= Max_Length then - Source.Current_Length := Nlen; - Source.Data (Llen + 1 .. Nlen) := New_Item.Data (1 .. Rlen); + if Llen <= Max_Length - Rlen then + if Rlen > 0 then + Source.Data (Llen + 1 .. Llen + Rlen) := New_Item.Data (1 .. Rlen); + Source.Current_Length := Llen + Rlen; + end if; else - Source.Current_Length := Max_Length; - case Drop is when Strings.Right => if Llen < Max_Length then @@ -423,6 +435,8 @@ package body Ada.Strings.Superbounded is when Strings.Error => raise Ada.Strings.Length_Error; end case; + + Source.Current_Length := Max_Length; end if; end Super_Append; @@ -438,17 +452,18 @@ package body Ada.Strings.Superbounded is Result : Super_String (Max_Length); Llen : constant Natural := Left.Current_Length; Rlen : constant Natural := Right'Length; - Nlen : constant Natural := Llen + Rlen; begin - if Nlen <= Max_Length then - Result.Current_Length := Nlen; + if Llen <= Max_Length - Rlen then Result.Data (1 .. Llen) := Left.Data (1 .. Llen); - Result.Data (Llen + 1 .. Nlen) := Right; - else - Result.Current_Length := Max_Length; + if Rlen > 0 then + Result.Data (Llen + 1 .. Llen + Rlen) := Super_String_Data (Right); + end if; + + Result.Current_Length := Llen + Rlen; + else case Drop is when Strings.Right => if Llen >= Max_Length then -- only case is Llen = Max_Length @@ -456,27 +471,29 @@ package body Ada.Strings.Superbounded is else Result.Data (1 .. Llen) := Left.Data (1 .. Llen); - Result.Data (Llen + 1 .. Max_Length) := - Right (Right'First .. Right'First - 1 + - Max_Length - Llen); + Result.Data (Llen + 1 .. Max_Length) := Super_String_Data + (Right + (Right'First .. Right'First - 1 - Llen + Max_Length)); end if; when Strings.Left => if Rlen >= Max_Length then - Result.Data (1 .. Max_Length) := - Right (Right'Last - (Max_Length - 1) .. Right'Last); + Result.Data (1 .. Max_Length) := Super_String_Data + (Right (Right'Last - (Max_Length - 1) .. Right'Last)); else Result.Data (1 .. Max_Length - Rlen) := Left.Data (Llen - (Max_Length - Rlen - 1) .. Llen); Result.Data (Max_Length - Rlen + 1 .. Max_Length) := - Right; + Super_String_Data (Right); end if; when Strings.Error => raise Ada.Strings.Length_Error; end case; + + Result.Current_Length := Max_Length; end if; return Result; @@ -490,40 +507,42 @@ package body Ada.Strings.Superbounded is Max_Length : constant Positive := Source.Max_Length; Llen : constant Natural := Source.Current_Length; Rlen : constant Natural := New_Item'Length; - Nlen : constant Natural := Llen + Rlen; begin - if Nlen <= Max_Length then - Source.Current_Length := Nlen; - Source.Data (Llen + 1 .. Nlen) := New_Item; + if Llen <= Max_Length - Rlen then + if Rlen > 0 then + Source.Data (Llen + 1 .. Llen + Rlen) := + Super_String_Data (New_Item); + Source.Current_Length := Llen + Rlen; + end if; else - Source.Current_Length := Max_Length; - case Drop is when Strings.Right => if Llen < Max_Length then - Source.Data (Llen + 1 .. Max_Length) := - New_Item (New_Item'First .. - New_Item'First - 1 + Max_Length - Llen); + Source.Data (Llen + 1 .. Max_Length) := Super_String_Data + (New_Item (New_Item'First .. + New_Item'First - 1 - Llen + Max_Length)); end if; when Strings.Left => if Rlen >= Max_Length then - Source.Data (1 .. Max_Length) := - New_Item (New_Item'Last - (Max_Length - 1) .. - New_Item'Last); + Source.Data (1 .. Max_Length) := Super_String_Data + (New_Item (New_Item'Last - (Max_Length - 1) .. + New_Item'Last)); else Source.Data (1 .. Max_Length - Rlen) := Source.Data (Llen - (Max_Length - Rlen - 1) .. Llen); Source.Data (Max_Length - Rlen + 1 .. Max_Length) := - New_Item; + Super_String_Data (New_Item); end if; when Strings.Error => raise Ada.Strings.Length_Error; end case; + + Source.Current_Length := Max_Length; end if; end Super_Append; @@ -539,25 +558,25 @@ package body Ada.Strings.Superbounded is Result : Super_String (Max_Length); Llen : constant Natural := Left'Length; Rlen : constant Natural := Right.Current_Length; - Nlen : constant Natural := Llen + Rlen; begin - if Nlen <= Max_Length then - Result.Current_Length := Nlen; - Result.Data (1 .. Llen) := Left; - Result.Data (Llen + 1 .. Llen + Rlen) := Right.Data (1 .. Rlen); + if Llen <= Max_Length - Rlen then + Result.Data (1 .. Llen) := Super_String_Data (Left); - else - Result.Current_Length := Max_Length; + if Rlen > 0 then + Result.Data (Llen + 1 .. Llen + Rlen) := Right.Data (1 .. Rlen); + end if; + Result.Current_Length := Llen + Rlen; + else case Drop is when Strings.Right => if Llen >= Max_Length then - Result.Data (1 .. Max_Length) := - Left (Left'First .. Left'First + (Max_Length - 1)); + Result.Data (1 .. Max_Length) := Super_String_Data + (Left (Left'First .. Left'First + (Max_Length - 1))); else - Result.Data (1 .. Llen) := Left; + Result.Data (1 .. Llen) := Super_String_Data (Left); Result.Data (Llen + 1 .. Max_Length) := Right.Data (1 .. Max_Length - Llen); end if; @@ -568,8 +587,8 @@ package body Ada.Strings.Superbounded is Right.Data (Rlen - (Max_Length - 1) .. Rlen); else - Result.Data (1 .. Max_Length - Rlen) := - Left (Left'Last - (Max_Length - Rlen - 1) .. Left'Last); + Result.Data (1 .. Max_Length - Rlen) := Super_String_Data + (Left (Left'Last - (Max_Length - Rlen - 1) .. Left'Last)); Result.Data (Max_Length - Rlen + 1 .. Max_Length) := Right.Data (1 .. Rlen); end if; @@ -577,6 +596,8 @@ package body Ada.Strings.Superbounded is when Strings.Error => raise Ada.Strings.Length_Error; end case; + + Result.Current_Length := Max_Length; end if; return Result; @@ -595,9 +616,9 @@ package body Ada.Strings.Superbounded is begin if Llen < Max_Length then - Result.Current_Length := Llen + 1; Result.Data (1 .. Llen) := Left.Data (1 .. Llen); Result.Data (Llen + 1) := Right; + Result.Current_Length := Llen + 1; return Result; else @@ -606,10 +627,10 @@ package body Ada.Strings.Superbounded is return Left; when Strings.Left => - Result.Current_Length := Max_Length; Result.Data (1 .. Max_Length - 1) := Left.Data (2 .. Max_Length); Result.Data (Max_Length) := Right; + Result.Current_Length := Max_Length; return Result; when Strings.Error => @@ -628,12 +649,10 @@ package body Ada.Strings.Superbounded is begin if Llen < Max_Length then - Source.Current_Length := Llen + 1; Source.Data (Llen + 1) := New_Item; + Source.Current_Length := Llen + 1; else - Source.Current_Length := Max_Length; - case Drop is when Strings.Right => null; @@ -663,18 +682,18 @@ package body Ada.Strings.Superbounded is begin if Rlen < Max_Length then - Result.Current_Length := Rlen + 1; Result.Data (1) := Left; Result.Data (2 .. Rlen + 1) := Right.Data (1 .. Rlen); + Result.Current_Length := Rlen + 1; return Result; else case Drop is when Strings.Right => - Result.Current_Length := Max_Length; Result.Data (1) := Left; Result.Data (2 .. Max_Length) := Right.Data (1 .. Max_Length - 1); + Result.Current_Length := Max_Length; return Result; when Strings.Left => @@ -696,9 +715,7 @@ package body Ada.Strings.Superbounded is Mapping : Maps.Character_Mapping := Maps.Identity) return Natural is begin - return - Search.Count - (Source.Data (1 .. Source.Current_Length), Pattern, Mapping); + return Search.Count (Super_To_String (Source), Pattern, Mapping); end Super_Count; function Super_Count @@ -707,9 +724,7 @@ package body Ada.Strings.Superbounded is Mapping : Maps.Character_Mapping_Function) return Natural is begin - return - Search.Count - (Source.Data (1 .. Source.Current_Length), Pattern, Mapping); + return Search.Count (Super_To_String (Source), Pattern, Mapping); end Super_Count; function Super_Count @@ -717,7 +732,7 @@ package body Ada.Strings.Superbounded is Set : Maps.Character_Set) return Natural is begin - return Search.Count (Source.Data (1 .. Source.Current_Length), Set); + return Search.Count (Super_To_String (Source), Set); end Super_Count; ------------------ @@ -737,19 +752,19 @@ package body Ada.Strings.Superbounded is if Num_Delete <= 0 then return Source; - elsif From > Slen + 1 then + elsif From - 1 > Slen then raise Ada.Strings.Index_Error; elsif Through >= Slen then - Result.Current_Length := From - 1; Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1); + Result.Current_Length := From - 1; return Result; else - Result.Current_Length := Slen - Num_Delete; Result.Data (1 .. From - 1) := Source.Data (1 .. From - 1); - Result.Data (From .. Result.Current_Length) := + Result.Data (From .. Slen - Num_Delete) := Source.Data (Through + 1 .. Slen); + Result.Current_Length := Slen - Num_Delete; return Result; end if; end Super_Delete; @@ -766,7 +781,7 @@ package body Ada.Strings.Superbounded is if Num_Delete <= 0 then return; - elsif From > Slen + 1 then + elsif From - 1 > Slen then raise Ada.Strings.Index_Error; elsif Through >= Slen then @@ -779,22 +794,6 @@ package body Ada.Strings.Superbounded is end if; end Super_Delete; - ------------------- - -- Super_Element -- - ------------------- - - function Super_Element - (Source : Super_String; - Index : Positive) return Character - is - begin - if Index <= Source.Current_Length then - return Source.Data (Index); - else - raise Strings.Index_Error; - end if; - end Super_Element; - ---------------------- -- Super_Find_Token -- ---------------------- @@ -809,7 +808,7 @@ package body Ada.Strings.Superbounded is is begin Search.Find_Token - (Source.Data (From .. Source.Current_Length), Set, Test, First, Last); + (Super_To_String (Source), Set, From, Test, First, Last); end Super_Find_Token; procedure Super_Find_Token @@ -820,8 +819,7 @@ package body Ada.Strings.Superbounded is Last : out Natural) is begin - Search.Find_Token - (Source.Data (1 .. Source.Current_Length), Set, Test, First, Last); + Search.Find_Token (Super_To_String (Source), Set, Test, First, Last); end Super_Find_Token; ---------------- @@ -841,21 +839,22 @@ package body Ada.Strings.Superbounded is begin if Npad <= 0 then - Result.Current_Length := Count; Result.Data (1 .. Count) := Source.Data (1 .. Count); + Result.Current_Length := Count; elsif Count <= Max_Length then - Result.Current_Length := Count; Result.Data (1 .. Slen) := Source.Data (1 .. Slen); Result.Data (Slen + 1 .. Count) := (others => Pad); + Result.Current_Length := Count; else - Result.Current_Length := Max_Length; - case Drop is when Strings.Right => Result.Data (1 .. Slen) := Source.Data (1 .. Slen); - Result.Data (Slen + 1 .. Max_Length) := (others => Pad); + + if Slen < Max_Length then + Result.Data (Slen + 1 .. Max_Length) := (others => Pad); + end if; when Strings.Left => if Npad >= Max_Length then @@ -871,6 +870,8 @@ package body Ada.Strings.Superbounded is when Strings.Error => raise Ada.Strings.Length_Error; end case; + + Result.Current_Length := Max_Length; end if; return Result; @@ -885,22 +886,22 @@ package body Ada.Strings.Superbounded is Max_Length : constant Positive := Source.Max_Length; Slen : constant Natural := Source.Current_Length; Npad : constant Integer := Count - Slen; - Temp : String (1 .. Max_Length); + Temp : Super_String_Data (1 .. Max_Length); begin if Npad <= 0 then Source.Current_Length := Count; elsif Count <= Max_Length then - Source.Current_Length := Count; Source.Data (Slen + 1 .. Count) := (others => Pad); + Source.Current_Length := Count; else - Source.Current_Length := Max_Length; - case Drop is when Strings.Right => - Source.Data (Slen + 1 .. Max_Length) := (others => Pad); + if Slen < Max_Length then + Source.Data (Slen + 1 .. Max_Length) := (others => Pad); + end if; when Strings.Left => if Npad > Max_Length then @@ -910,15 +911,15 @@ package body Ada.Strings.Superbounded is Temp := Source.Data; Source.Data (1 .. Max_Length - Npad) := Temp (Count - Max_Length + 1 .. Slen); - - for J in Max_Length - Npad + 1 .. Max_Length loop - Source.Data (J) := Pad; - end loop; + Source.Data (Max_Length - Npad + 1 .. Max_Length) := + (others => Pad); end if; when Strings.Error => raise Ada.Strings.Length_Error; end case; + + Source.Current_Length := Max_Length; end if; end Super_Head; @@ -933,8 +934,7 @@ package body Ada.Strings.Superbounded is Mapping : Maps.Character_Mapping := Maps.Identity) return Natural is begin - return Search.Index - (Source.Data (1 .. Source.Current_Length), Pattern, Going, Mapping); + return Search.Index (Super_To_String (Source), Pattern, Going, Mapping); end Super_Index; function Super_Index @@ -944,8 +944,7 @@ package body Ada.Strings.Superbounded is Mapping : Maps.Character_Mapping_Function) return Natural is begin - return Search.Index - (Source.Data (1 .. Source.Current_Length), Pattern, Going, Mapping); + return Search.Index (Super_To_String (Source), Pattern, Going, Mapping); end Super_Index; function Super_Index @@ -955,8 +954,7 @@ package body Ada.Strings.Superbounded is Going : Strings.Direction := Strings.Forward) return Natural is begin - return Search.Index - (Source.Data (1 .. Source.Current_Length), Set, Test, Going); + return Search.Index (Super_To_String (Source), Set, Test, Going); end Super_Index; function Super_Index @@ -968,8 +966,7 @@ package body Ada.Strings.Superbounded is is begin return Search.Index - (Source.Data (1 .. Source.Current_Length), - Pattern, From, Going, Mapping); + (Super_To_String (Source), Pattern, From, Going, Mapping); end Super_Index; function Super_Index @@ -981,8 +978,7 @@ package body Ada.Strings.Superbounded is is begin return Search.Index - (Source.Data (1 .. Source.Current_Length), - Pattern, From, Going, Mapping); + (Super_To_String (Source), Pattern, From, Going, Mapping); end Super_Index; function Super_Index @@ -993,8 +989,15 @@ package body Ada.Strings.Superbounded is Going : Direction := Forward) return Natural is begin - return Search.Index - (Source.Data (1 .. Source.Current_Length), Set, From, Test, Going); + return Result : Natural do + Result := + Search.Index (Super_To_String (Source), Set, From, Test, Going); + pragma Assert + (if (for all J in 1 .. Super_Length (Source) => + (if J = From or else (J > From) = (Going = Forward) then + (Test = Inside) /= Maps.Is_In (Source.Data (J), Set))) + then Result = 0); + end return; end Super_Index; --------------------------- @@ -1006,9 +1009,7 @@ package body Ada.Strings.Superbounded is Going : Strings.Direction := Strings.Forward) return Natural is begin - return - Search.Index_Non_Blank - (Source.Data (1 .. Source.Current_Length), Going); + return Search.Index_Non_Blank (Super_To_String (Source), Going); end Super_Index_Non_Blank; function Super_Index_Non_Blank @@ -1017,9 +1018,7 @@ package body Ada.Strings.Superbounded is Going : Direction := Forward) return Natural is begin - return - Search.Index_Non_Blank - (Source.Data (1 .. Source.Current_Length), From, Going); + return Search.Index_Non_Blank (Super_To_String (Source), From, Going); end Super_Index_Non_Blank; ------------------ @@ -1031,60 +1030,71 @@ package body Ada.Strings.Superbounded is Before : Positive; New_Item : String; Drop : Strings.Truncation := Strings.Error) return Super_String + with SPARK_Mode => Off is Max_Length : constant Positive := Source.Max_Length; Result : Super_String (Max_Length); Slen : constant Natural := Source.Current_Length; Nlen : constant Natural := New_Item'Length; - Tlen : constant Natural := Slen + Nlen; Blen : constant Natural := Before - 1; Alen : constant Integer := Slen - Blen; - Droplen : constant Integer := Tlen - Max_Length; + Droplen : constant Integer := Slen - Max_Length + Nlen; - -- Tlen is the length of the total string before possible truncation. -- Blen, Alen are the lengths of the before and after pieces of the - -- source string. + -- source string. The number of dropped characters is Natural'Max (0, + -- Droplen). begin if Alen < 0 then raise Ada.Strings.Index_Error; elsif Droplen <= 0 then - Result.Current_Length := Tlen; Result.Data (1 .. Blen) := Source.Data (1 .. Blen); - Result.Data (Before .. Before + Nlen - 1) := New_Item; - Result.Data (Before + Nlen .. Tlen) := - Source.Data (Before .. Slen); + Result.Data (Before .. Before - 1 + Nlen) := + Super_String_Data (New_Item); - else - Result.Current_Length := Max_Length; + if Before <= Slen then + Result.Data (Before + Nlen .. Slen + Nlen) := + Source.Data (Before .. Slen); + end if; + Result.Current_Length := Slen + Nlen; + + else case Drop is when Strings.Right => Result.Data (1 .. Blen) := Source.Data (1 .. Blen); - if Droplen > Alen then - Result.Data (Before .. Max_Length) := - New_Item (New_Item'First - .. New_Item'First + Max_Length - Before); + if Droplen >= Alen then + Result.Data (Before .. Max_Length) := Super_String_Data + (New_Item (New_Item'First + .. New_Item'First - Before + Max_Length)); + pragma Assert + (String (Result.Data (Before .. Max_Length)) = + New_Item (New_Item'First + .. New_Item'First - Before + Max_Length)); else - Result.Data (Before .. Before + Nlen - 1) := New_Item; + Result.Data (Before .. Before - 1 + Nlen) := + Super_String_Data (New_Item); Result.Data (Before + Nlen .. Max_Length) := Source.Data (Before .. Slen - Droplen); end if; when Strings.Left => - Result.Data (Max_Length - (Alen - 1) .. Max_Length) := - Source.Data (Before .. Slen); + if Alen > 0 then + Result.Data (Max_Length - (Alen - 1) .. Max_Length) := + Source.Data (Before .. Slen); + end if; - if Droplen >= Blen then - Result.Data (1 .. Max_Length - Alen) := - New_Item (New_Item'Last - (Max_Length - Alen) + 1 - .. New_Item'Last); + if Droplen > Blen then + if Alen < Max_Length then + Result.Data (1 .. Max_Length - Alen) := Super_String_Data + (New_Item (New_Item'Last - (Max_Length - Alen) + 1 + .. New_Item'Last)); + end if; else - Result.Data - (Blen - Droplen + 1 .. Max_Length - Alen) := - New_Item; + Result.Data (Blen - Droplen + 1 .. Max_Length - Alen) := + Super_String_Data (New_Item); Result.Data (1 .. Blen - Droplen) := Source.Data (Droplen + 1 .. Blen); end if; @@ -1092,6 +1102,8 @@ package body Ada.Strings.Superbounded is when Strings.Error => raise Ada.Strings.Length_Error; end case; + + Result.Current_Length := Max_Length; end if; return Result; @@ -1111,15 +1123,6 @@ package body Ada.Strings.Superbounded is Source := Super_Insert (Source, Before, New_Item, Drop); end Super_Insert; - ------------------ - -- Super_Length -- - ------------------ - - function Super_Length (Source : Super_String) return Natural is - begin - return Source.Current_Length; - end Super_Length; - --------------------- -- Super_Overwrite -- --------------------- @@ -1132,61 +1135,61 @@ package body Ada.Strings.Superbounded is is Max_Length : constant Positive := Source.Max_Length; Result : Super_String (Max_Length); - Endpos : constant Natural := Position + New_Item'Length - 1; Slen : constant Natural := Source.Current_Length; Droplen : Natural; begin - if Position > Slen + 1 then + if Position - 1 > Slen then raise Ada.Strings.Index_Error; elsif New_Item'Length = 0 then return Source; - elsif Endpos <= Slen then - Result.Current_Length := Source.Current_Length; + elsif Position - 1 <= Slen - New_Item'Length then Result.Data (1 .. Slen) := Source.Data (1 .. Slen); - Result.Data (Position .. Endpos) := New_Item; + Result.Data (Position .. Position - 1 + New_Item'Length) := + Super_String_Data (New_Item); + Result.Current_Length := Source.Current_Length; return Result; - elsif Endpos <= Max_Length then - Result.Current_Length := Endpos; + elsif Position - 1 <= Max_Length - New_Item'Length then Result.Data (1 .. Position - 1) := Source.Data (1 .. Position - 1); - Result.Data (Position .. Endpos) := New_Item; + Result.Data (Position .. Position - 1 + New_Item'Length) := + Super_String_Data (New_Item); + Result.Current_Length := Position - 1 + New_Item'Length; return Result; else - Result.Current_Length := Max_Length; - Droplen := Endpos - Max_Length; + Droplen := Position - 1 - Max_Length + New_Item'Length; case Drop is when Strings.Right => Result.Data (1 .. Position - 1) := Source.Data (1 .. Position - 1); - Result.Data (Position .. Max_Length) := - New_Item (New_Item'First .. New_Item'Last - Droplen); - return Result; + Result.Data (Position .. Max_Length) := Super_String_Data + (New_Item (New_Item'First .. New_Item'Last - Droplen)); when Strings.Left => if New_Item'Length >= Max_Length then - Result.Data (1 .. Max_Length) := - New_Item (New_Item'Last - Max_Length + 1 .. - New_Item'Last); - return Result; + Result.Data (1 .. Max_Length) := Super_String_Data + (New_Item (New_Item'Last - Max_Length + 1 .. + New_Item'Last)); else Result.Data (1 .. Max_Length - New_Item'Length) := Source.Data (Droplen + 1 .. Position - 1); Result.Data (Max_Length - New_Item'Length + 1 .. Max_Length) := - New_Item; - return Result; + Super_String_Data (New_Item); end if; when Strings.Error => raise Ada.Strings.Length_Error; end case; + + Result.Current_Length := Max_Length; + return Result; end if; end Super_Overwrite; @@ -1195,50 +1198,52 @@ package body Ada.Strings.Superbounded is Position : Positive; New_Item : String; Drop : Strings.Truncation := Strings.Error) + with SPARK_Mode => Off is Max_Length : constant Positive := Source.Max_Length; - Endpos : constant Positive := Position + New_Item'Length - 1; Slen : constant Natural := Source.Current_Length; Droplen : Natural; begin - if Position > Slen + 1 then + if Position - 1 > Slen then raise Ada.Strings.Index_Error; - elsif Endpos <= Slen then - Source.Data (Position .. Endpos) := New_Item; + elsif Position - 1 <= Slen - New_Item'Length then + Source.Data (Position .. Position - 1 + New_Item'Length) := + Super_String_Data (New_Item); - elsif Endpos <= Max_Length then - Source.Data (Position .. Endpos) := New_Item; - Source.Current_Length := Endpos; + elsif Position - 1 <= Max_Length - New_Item'Length then + Source.Data (Position .. Position - 1 + New_Item'Length) := + Super_String_Data (New_Item); + Source.Current_Length := Position - 1 + New_Item'Length; else - Source.Current_Length := Max_Length; - Droplen := Endpos - Max_Length; + Droplen := Position - 1 - Max_Length + New_Item'Length; case Drop is when Strings.Right => - Source.Data (Position .. Max_Length) := - New_Item (New_Item'First .. New_Item'Last - Droplen); + Source.Data (Position .. Max_Length) := Super_String_Data + (New_Item (New_Item'First .. New_Item'Last - Droplen)); when Strings.Left => if New_Item'Length > Max_Length then - Source.Data (1 .. Max_Length) := - New_Item (New_Item'Last - Max_Length + 1 .. - New_Item'Last); + Source.Data (1 .. Max_Length) := Super_String_Data + (New_Item + (New_Item'Last - Max_Length + 1 .. New_Item'Last)); else Source.Data (1 .. Max_Length - New_Item'Length) := Source.Data (Droplen + 1 .. Position - 1); - Source.Data (Max_Length - New_Item'Length + 1 .. Max_Length) := - New_Item; + Super_String_Data (New_Item); end if; when Strings.Error => raise Ada.Strings.Length_Error; end case; + + Source.Current_Length := Max_Length; end if; end Super_Overwrite; @@ -1269,12 +1274,13 @@ package body Ada.Strings.Superbounded is High : Natural; By : String; Drop : Strings.Truncation := Strings.Error) return Super_String + with SPARK_Mode => Off is Max_Length : constant Positive := Source.Max_Length; Slen : constant Natural := Source.Current_Length; begin - if Low > Slen + 1 then + if Low - 1 > Slen then raise Strings.Index_Error; elsif High < Low then @@ -1282,51 +1288,58 @@ package body Ada.Strings.Superbounded is else declare - Blen : constant Natural := Natural'Max (0, Low - 1); + Blen : constant Natural := Low - 1; Alen : constant Natural := Natural'Max (0, Slen - High); - Tlen : constant Natural := Blen + By'Length + Alen; - Droplen : constant Integer := Tlen - Max_Length; + Droplen : constant Integer := Blen + Alen - Max_Length + By'Length; Result : Super_String (Max_Length); - -- Tlen is the total length of the result string before any - -- truncation. Blen and Alen are the lengths of the pieces - -- of the original string that end up in the result string - -- before and after the replaced slice. + -- Blen and Alen are the lengths of the pieces of the original + -- string that end up in the result string before and after the + -- replaced slice. The number of dropped characters is Natural'Max + -- (0, Droplen). begin if Droplen <= 0 then - Result.Current_Length := Tlen; Result.Data (1 .. Blen) := Source.Data (1 .. Blen); - Result.Data (Low .. Low + By'Length - 1) := By; - Result.Data (Low + By'Length .. Tlen) := - Source.Data (High + 1 .. Slen); + Result.Data (Low .. Blen + By'Length) := + Super_String_Data (By); - else - Result.Current_Length := Max_Length; + if Alen > 0 then + Result.Data (Low + By'Length .. Blen + By'Length + Alen) := + Source.Data (High + 1 .. Slen); + end if; + Result.Current_Length := Blen + By'Length + Alen; + + else case Drop is when Strings.Right => Result.Data (1 .. Blen) := Source.Data (1 .. Blen); - if Droplen > Alen then - Result.Data (Low .. Max_Length) := - By (By'First .. By'First + Max_Length - Low); + if Droplen >= Alen then + Result.Data (Low .. Max_Length) := Super_String_Data + (By (By'First .. By'First - Low + Max_Length)); else - Result.Data (Low .. Low + By'Length - 1) := By; + Result.Data (Low .. Low - 1 + By'Length) := + Super_String_Data (By); Result.Data (Low + By'Length .. Max_Length) := Source.Data (High + 1 .. Slen - Droplen); end if; when Strings.Left => - Result.Data (Max_Length - (Alen - 1) .. Max_Length) := - Source.Data (High + 1 .. Slen); + if Alen > 0 then + Result.Data (Max_Length - (Alen - 1) .. Max_Length) := + Source.Data (High + 1 .. Slen); + end if; if Droplen >= Blen then Result.Data (1 .. Max_Length - Alen) := - By (By'Last - (Max_Length - Alen) + 1 .. By'Last); + Super_String_Data (By + (By'Last - (Max_Length - Alen) + 1 .. By'Last)); else Result.Data - (Blen - Droplen + 1 .. Max_Length - Alen) := By; + (Blen - Droplen + 1 .. Max_Length - Alen) := + Super_String_Data (By); Result.Data (1 .. Blen - Droplen) := Source.Data (Droplen + 1 .. Blen); end if; @@ -1334,6 +1347,8 @@ package body Ada.Strings.Superbounded is when Strings.Error => raise Ada.Strings.Length_Error; end case; + + Result.Current_Length := Max_Length; end if; return Result; @@ -1370,16 +1385,17 @@ package body Ada.Strings.Superbounded is begin if Count <= Max_Length then + Result.Data (1 .. Count) := (others => Item); Result.Current_Length := Count; elsif Drop = Strings.Error then raise Ada.Strings.Length_Error; else + Result.Data (1 .. Max_Length) := (others => Item); Result.Current_Length := Max_Length; end if; - Result.Data (1 .. Result.Current_Length) := (others => Item); return Result; end Super_Replicate; @@ -1389,52 +1405,203 @@ package body Ada.Strings.Superbounded is Drop : Truncation := Error; Max_Length : Positive) return Super_String is - Length : constant Integer := Count * Item'Length; Result : Super_String (Max_Length); - Indx : Positive; + Indx : Natural; + Ilen : constant Natural := Item'Length; + + -- Parts of the proof involving manipulations with the modulo operator + -- are complicated for the prover and can't be done automatically in + -- the global subprogram. That's why we isolate them in these two ghost + -- lemmas. + + procedure Lemma_Mod (K : Natural; Q : Natural) with + Ghost, + Pre => Ilen /= 0 + and then Q mod Ilen = 0 + and then K - Q in 0 .. Ilen - 1, + Post => K mod Ilen = K - Q; + -- Lemma_Mod is applied to an index considered in Lemma_Split to prove + -- that it has the right value modulo Item'Length. + + procedure Lemma_Mod_Zero (X : Natural) with + Ghost, + Pre => Ilen /= 0 + and then X mod Ilen = 0 + and then X <= Natural'Last - Ilen, + Post => (X + Ilen) mod Ilen = 0; + -- Lemma_Mod_Zero is applied to prove that the length of the range + -- of indexes considered in the loop, when dropping on the Left, is + -- a multiple of Item'Length. + + procedure Lemma_Split (Going : Direction) with + Ghost, + Pre => + Ilen /= 0 + and then Indx in 0 .. Max_Length - Ilen + and then + (if Going = Forward + then Indx mod Ilen = 0 + else (Max_Length - Indx - Ilen) mod Ilen = 0) + and then Result.Data (Indx + 1 .. Indx + Ilen)'Initialized + and then String (Result.Data (Indx + 1 .. Indx + Ilen)) = Item, + Post => + (if Going = Forward then + (for all J in Indx + 1 .. Indx + Ilen => + Result.Data (J) = Item (Item'First + (J - 1) mod Ilen)) + else + (for all J in Indx + 1 .. Indx + Ilen => + Result.Data (J) = + Item (Item'Last - (Max_Length - J) mod Ilen))); + -- Lemma_Split is used after Result.Data (Indx + 1 .. Indx + Ilen) is + -- updated to Item and concludes that the characters match for each + -- index when taken modulo Item'Length, as the considered slice starts + -- at index 1 (or ends at index Max_Length, if Going = Backward) modulo + -- Item'Length. + + --------------- + -- Lemma_Mod -- + --------------- + + procedure Lemma_Mod (K : Natural; Q : Natural) is null; + + -------------------- + -- Lemma_Mod_Zero -- + -------------------- + + procedure Lemma_Mod_Zero (X : Natural) is null; + + ----------------- + -- Lemma_Split -- + ----------------- + + procedure Lemma_Split (Going : Direction) is + begin + if Going = Forward then + for K in Indx + 1 .. Indx + Ilen loop + Lemma_Mod (K - 1, Indx); + pragma Loop_Invariant + (for all J in Indx + 1 .. K => + Result.Data (J) = Item (Item'First + (J - 1) mod Ilen)); + end loop; + else + for K in Indx + 1 .. Indx + Ilen loop + Lemma_Mod (Max_Length - K, Max_Length - Indx - Ilen); + pragma Loop_Invariant + (for all J in Indx + 1 .. K => + Result.Data (J) = + Item (Item'Last - (Max_Length - J) mod Ilen)); + end loop; + end if; + end Lemma_Split; begin - if Length <= Max_Length then - Result.Current_Length := Length; - - if Length > 0 then - Indx := 1; + if Count = 0 or else Ilen <= Max_Length / Count then + if Count * Ilen > 0 then + Indx := 0; for J in 1 .. Count loop - Result.Data (Indx .. Indx + Item'Length - 1) := Item; - Indx := Indx + Item'Length; + Result.Data (Indx + 1 .. Indx + Ilen) := + Super_String_Data (Item); + pragma Assert + (for all K in 1 .. Ilen => + Result.Data (Indx + K) = Item (Item'First - 1 + K)); + pragma Assert + (String (Result.Data (Indx + 1 .. Indx + Ilen)) = Item); + Lemma_Split (Forward); + Indx := Indx + Ilen; + pragma Loop_Invariant (Indx = J * Ilen); + pragma Loop_Invariant (Result.Data (1 .. Indx)'Initialized); + pragma Loop_Invariant + (for all K in 1 .. Indx => + Result.Data (K) = + Item (Item'First + (K - 1) mod Ilen)); end loop; end if; - else - Result.Current_Length := Max_Length; + Result.Current_Length := Count * Ilen; + else case Drop is when Strings.Right => - Indx := 1; - - while Indx + Item'Length <= Max_Length + 1 loop - Result.Data (Indx .. Indx + Item'Length - 1) := Item; - Indx := Indx + Item'Length; + Indx := 0; + + while Indx < Max_Length - Ilen loop + Result.Data (Indx + 1 .. Indx + Ilen) := + Super_String_Data (Item); + pragma Assert + (for all K in 1 .. Ilen => + Result.Data (Indx + K) = Item (Item'First - 1 + K)); + pragma Assert + (String (Result.Data (Indx + 1 .. Indx + Ilen)) = Item); + Lemma_Split (Forward); + Indx := Indx + Ilen; + pragma Loop_Invariant (Indx mod Ilen = 0); + pragma Loop_Invariant (Indx in 0 .. Max_Length - 1); + pragma Loop_Invariant (Result.Data (1 .. Indx)'Initialized); + pragma Loop_Invariant + (for all K in 1 .. Indx => + Result.Data (K) = + Item (Item'First + (K - 1) mod Ilen)); end loop; - Result.Data (Indx .. Max_Length) := - Item (Item'First .. Item'First + Max_Length - Indx); + Result.Data (Indx + 1 .. Max_Length) := Super_String_Data + (Item (Item'First .. Item'First + (Max_Length - Indx - 1))); + pragma Assert + (for all J in Indx + 1 .. Max_Length => + Result.Data (J) = Item (Item'First - 1 - Indx + J)); + + for J in Indx + 1 .. Max_Length loop + Lemma_Mod (J - 1, Indx); + pragma Loop_Invariant + (for all K in 1 .. J => + Result.Data (K) = + Item (Item'First + (K - 1) mod Ilen)); + end loop; when Strings.Left => Indx := Max_Length; - while Indx - Item'Length >= 1 loop - Result.Data (Indx - (Item'Length - 1) .. Indx) := Item; - Indx := Indx - Item'Length; + while Indx > Ilen loop + Indx := Indx - Ilen; + Result.Data (Indx + 1 .. Indx + Ilen) := + Super_String_Data (Item); + pragma Assert + (for all K in 1 .. Ilen => + Result.Data (Indx + K) = Item (Item'First - 1 + K)); + pragma Assert + (String (Result.Data (Indx + 1 .. Indx + Ilen)) = Item); + Lemma_Split (Backward); + Lemma_Mod_Zero (Max_Length - Indx - Ilen); + pragma Loop_Invariant + ((Max_Length - Indx) mod Ilen = 0); + pragma Loop_Invariant (Indx in 1 .. Max_Length); + pragma Loop_Invariant + (Result.Data (Indx + 1 .. Max_Length)'Initialized); + pragma Loop_Invariant + (for all K in Indx + 1 .. Max_Length => + Result.Data (K) = + Item (Item'Last - (Max_Length - K) mod Ilen)); end loop; Result.Data (1 .. Indx) := - Item (Item'Last - Indx + 1 .. Item'Last); + Super_String_Data (Item (Item'Last - Indx + 1 .. Item'Last)); + pragma Assert + (for all J in 1 .. Indx => + Result.Data (J) = Item (Item'Last - Indx + J)); + + for J in reverse 1 .. Indx loop + Lemma_Mod (Max_Length - J, Max_Length - Indx); + pragma Loop_Invariant + (for all K in J .. Max_Length => + Result.Data (K) = + Item (Item'Last - (Max_Length - K) mod Ilen)); + end loop; when Strings.Error => raise Ada.Strings.Length_Error; end case; + + Result.Current_Length := Max_Length; end if; return Result; @@ -1447,11 +1614,7 @@ package body Ada.Strings.Superbounded is is begin return - Super_Replicate - (Count, - Item.Data (1 .. Item.Current_Length), - Drop, - Item.Max_Length); + Super_Replicate (Count, Super_To_String (Item), Drop, Item.Max_Length); end Super_Replicate; ----------------- @@ -1461,42 +1624,20 @@ package body Ada.Strings.Superbounded is function Super_Slice (Source : Super_String; Low : Positive; - High : Natural) return String - is - begin - -- Note: test of High > Length is in accordance with AI95-00128 - - return R : String (Low .. High) do - if Low > Source.Current_Length + 1 - or else High > Source.Current_Length - then - raise Index_Error; - end if; - - -- Note: in this case, superflat bounds are not a problem, we just - -- get the null string in accordance with normal Ada slice rules. - - R := Source.Data (Low .. High); - end return; - end Super_Slice; - - function Super_Slice - (Source : Super_String; - Low : Positive; High : Natural) return Super_String is begin return Result : Super_String (Source.Max_Length) do - if Low > Source.Current_Length + 1 + if Low - 1 > Source.Current_Length or else High > Source.Current_Length then raise Index_Error; end if; - -- Note: the Max operation here deals with the superflat case - - Result.Current_Length := Integer'Max (0, High - Low + 1); - Result.Data (1 .. Result.Current_Length) := Source.Data (Low .. High); + if High >= Low then + Result.Data (1 .. High - Low + 1) := Source.Data (Low .. High); + Result.Current_Length := High - Low + 1; + end if; end return; end Super_Slice; @@ -1507,16 +1648,18 @@ package body Ada.Strings.Superbounded is High : Natural) is begin - if Low > Source.Current_Length + 1 + if Low - 1 > Source.Current_Length or else High > Source.Current_Length then raise Index_Error; end if; - -- Note: the Max operation here deals with the superflat case - - Target.Current_Length := Integer'Max (0, High - Low + 1); - Target.Data (1 .. Target.Current_Length) := Source.Data (Low .. High); + if High >= Low then + Target.Data (1 .. High - Low + 1) := Source.Data (Low .. High); + Target.Current_Length := High - Low + 1; + else + Target.Current_Length := 0; + end if; end Super_Slice; ---------------- @@ -1536,18 +1679,22 @@ package body Ada.Strings.Superbounded is begin if Npad <= 0 then - Result.Current_Length := Count; - Result.Data (1 .. Count) := - Source.Data (Slen - (Count - 1) .. Slen); + if Count > 0 then + Result.Data (1 .. Count) := + Source.Data (Slen - (Count - 1) .. Slen); + Result.Current_Length := Count; + end if; elsif Count <= Max_Length then - Result.Current_Length := Count; Result.Data (1 .. Npad) := (others => Pad); - Result.Data (Npad + 1 .. Count) := Source.Data (1 .. Slen); - else - Result.Current_Length := Max_Length; + if Slen > 0 then + Result.Data (Npad + 1 .. Count) := Source.Data (1 .. Slen); + end if; + + Result.Current_Length := Count; + else case Drop is when Strings.Right => if Npad >= Max_Length then @@ -1567,6 +1714,8 @@ package body Ada.Strings.Superbounded is when Strings.Error => raise Ada.Strings.Length_Error; end case; + + Result.Current_Length := Max_Length; end if; return Result; @@ -1582,22 +1731,27 @@ package body Ada.Strings.Superbounded is Slen : constant Natural := Source.Current_Length; Npad : constant Integer := Count - Slen; - Temp : constant String (1 .. Max_Length) := Source.Data; + Temp : constant Super_String_Data (1 .. Max_Length) := Source.Data; begin if Npad <= 0 then Source.Current_Length := Count; - Source.Data (1 .. Count) := - Temp (Slen - (Count - 1) .. Slen); + + if Count > 0 then + Source.Data (1 .. Count) := + Temp (Slen - (Count - 1) .. Slen); + end if; elsif Count <= Max_Length then - Source.Current_Length := Count; Source.Data (1 .. Npad) := (others => Pad); - Source.Data (Npad + 1 .. Count) := Temp (1 .. Slen); - else - Source.Current_Length := Max_Length; + if Slen > 0 then + Source.Data (Npad + 1 .. Count) := Temp (1 .. Slen); + end if; + Source.Current_Length := Count; + + else case Drop is when Strings.Right => if Npad >= Max_Length then @@ -1610,31 +1764,19 @@ package body Ada.Strings.Superbounded is end if; when Strings.Left => - for J in 1 .. Max_Length - Slen loop - Source.Data (J) := Pad; - end loop; - + Source.Data (1 .. Max_Length - Slen) := (others => Pad); Source.Data (Max_Length - Slen + 1 .. Max_Length) := Temp (1 .. Slen); when Strings.Error => raise Ada.Strings.Length_Error; end case; + + Source.Current_Length := Max_Length; end if; end Super_Tail; --------------------- - -- Super_To_String -- - --------------------- - - function Super_To_String (Source : Super_String) return String is - begin - return R : String (1 .. Source.Current_Length) do - R := Source.Data (1 .. Source.Current_Length); - end return; - end Super_To_String; - - --------------------- -- Super_Translate -- --------------------- @@ -1645,12 +1787,15 @@ package body Ada.Strings.Superbounded is Result : Super_String (Source.Max_Length); begin - Result.Current_Length := Source.Current_Length; - for J in 1 .. Source.Current_Length loop Result.Data (J) := Value (Mapping, Source.Data (J)); + pragma Loop_Invariant (Result.Data (1 .. J)'Initialized); + pragma Loop_Invariant + (for all K in 1 .. J => + Result.Data (K) = Value (Mapping, Source.Data (K))); end loop; + Result.Current_Length := Source.Current_Length; return Result; end Super_Translate; @@ -1661,6 +1806,9 @@ package body Ada.Strings.Superbounded is begin for J in 1 .. Source.Current_Length loop Source.Data (J) := Value (Mapping, Source.Data (J)); + pragma Loop_Invariant + (for all K in 1 .. J => + Source.Data (K) = Value (Mapping, Source'Loop_Entry.Data (K))); end loop; end Super_Translate; @@ -1671,12 +1819,15 @@ package body Ada.Strings.Superbounded is Result : Super_String (Source.Max_Length); begin - Result.Current_Length := Source.Current_Length; - for J in 1 .. Source.Current_Length loop Result.Data (J) := Mapping.all (Source.Data (J)); + pragma Loop_Invariant (Result.Data (1 .. J)'Initialized); + pragma Loop_Invariant + (for all K in 1 .. J => + Result.Data (K) = Mapping (Source.Data (K))); end loop; + Result.Current_Length := Source.Current_Length; return Result; end Super_Translate; @@ -1687,6 +1838,9 @@ package body Ada.Strings.Superbounded is begin for J in 1 .. Source.Current_Length loop Source.Data (J) := Mapping.all (Source.Data (J)); + pragma Loop_Invariant + (for all K in 1 .. J => + Source.Data (K) = Mapping (Source'Loop_Entry.Data (K))); end loop; end Super_Translate; @@ -1699,24 +1853,62 @@ package body Ada.Strings.Superbounded is Side : Trim_End) return Super_String is Result : Super_String (Source.Max_Length); - Last : Natural := Source.Current_Length; - First : Positive := 1; + Last : constant Natural := Source.Current_Length; begin - if Side = Left or else Side = Both then - while First <= Last and then Source.Data (First) = ' ' loop - First := First + 1; - end loop; - end if; + case Side is + when Strings.Left => + declare + Low : constant Natural := + Super_Index_Non_Blank (Source, Forward); + begin + -- All blanks case - if Side = Right or else Side = Both then - while Last >= First and then Source.Data (Last) = ' ' loop - Last := Last - 1; - end loop; - end if; + if Low = 0 then + return Result; + end if; + + Result.Data (1 .. Last - Low + 1) := Source.Data (Low .. Last); + Result.Current_Length := Last - Low + 1; + end; + + when Strings.Right => + declare + High : constant Natural := + Super_Index_Non_Blank (Source, Backward); + begin + -- All blanks case + + if High = 0 then + return Result; + end if; + + Result.Data (1 .. High) := Source.Data (1 .. High); + Result.Current_Length := High; + end; + + when Strings.Both => + declare + Low : constant Natural := + Super_Index_Non_Blank (Source, Forward); + begin + -- All blanks case + + if Low = 0 then + return Result; + end if; + + declare + High : constant Natural := + Super_Index_Non_Blank (Source, Backward); + begin + Result.Data (1 .. High - Low + 1) := + Source.Data (Low .. High); + Result.Current_Length := High - Low + 1; + end; + end; + end case; - Result.Current_Length := Last - First + 1; - Result.Data (1 .. Result.Current_Length) := Source.Data (First .. Last); return Result; end Super_Trim; @@ -1724,28 +1916,54 @@ package body Ada.Strings.Superbounded is (Source : in out Super_String; Side : Trim_End) is - Max_Length : constant Positive := Source.Max_Length; - Last : Natural := Source.Current_Length; - First : Positive := 1; - Temp : String (1 .. Max_Length); - + Last : constant Natural := Source.Current_Length; begin - Temp (1 .. Last) := Source.Data (1 .. Last); - - if Side = Left or else Side = Both then - while First <= Last and then Temp (First) = ' ' loop - First := First + 1; - end loop; - end if; + case Side is + when Strings.Left => + declare + Low : constant Natural := + Super_Index_Non_Blank (Source, Forward); + begin + -- All blanks case - if Side = Right or else Side = Both then - while Last >= First and then Temp (Last) = ' ' loop - Last := Last - 1; - end loop; - end if; - - Source.Current_Length := Last - First + 1; - Source.Data (1 .. Source.Current_Length) := Temp (First .. Last); + if Low = 0 then + Source.Current_Length := 0; + else + Source.Data (1 .. Last - Low + 1) := + Source.Data (Low .. Last); + Source.Current_Length := Last - Low + 1; + end if; + end; + + when Strings.Right => + declare + High : constant Natural := + Super_Index_Non_Blank (Source, Backward); + begin + Source.Current_Length := High; + end; + + when Strings.Both => + declare + Low : constant Natural := + Super_Index_Non_Blank (Source, Forward); + begin + -- All blanks case + + if Low = 0 then + Source.Current_Length := 0; + else + declare + High : constant Natural := + Super_Index_Non_Blank (Source, Backward); + begin + Source.Data (1 .. High - Low + 1) := + Source.Data (Low .. High); + Source.Current_Length := High - Low + 1; + end; + end if; + end; + end case; end Super_Trim; function Super_Trim @@ -1754,22 +1972,31 @@ package body Ada.Strings.Superbounded is Right : Maps.Character_Set) return Super_String is Result : Super_String (Source.Max_Length); + Low : Natural; + High : Natural; begin - for First in 1 .. Source.Current_Length loop - if not Is_In (Source.Data (First), Left) then - for Last in reverse First .. Source.Current_Length loop - if not Is_In (Source.Data (Last), Right) then - Result.Current_Length := Last - First + 1; - Result.Data (1 .. Result.Current_Length) := - Source.Data (First .. Last); - return Result; - end if; - end loop; - end if; - end loop; + Low := Super_Index (Source, Left, Outside, Forward); + + -- Case where source comprises only characters in Left + + if Low = 0 then + return Result; + end if; + + High := Super_Index (Source, Right, Outside, Backward); + + -- Case where source comprises only characters in Right + + if High = 0 then + return Result; + end if; + + if High >= Low then + Result.Data (1 .. High - Low + 1) := Source.Data (Low .. High); + Result.Current_Length := High - Low + 1; + end if; - Result.Current_Length := 0; return Result; end Super_Trim; @@ -1778,29 +2005,39 @@ package body Ada.Strings.Superbounded is Left : Maps.Character_Set; Right : Maps.Character_Set) is + Last : constant Natural := Source.Current_Length; + Temp : Super_String_Data (1 .. Last); + Low : Natural; + High : Natural; + begin - for First in 1 .. Source.Current_Length loop - if not Is_In (Source.Data (First), Left) then - for Last in reverse First .. Source.Current_Length loop - if not Is_In (Source.Data (Last), Right) then - if First = 1 then - Source.Current_Length := Last; - return; - else - Source.Current_Length := Last - First + 1; - Source.Data (1 .. Source.Current_Length) := - Source.Data (First .. Last); - return; - end if; - end if; - end loop; + Temp := Source.Data (1 .. Last); + Low := Super_Index (Source, Left, Outside, Forward); + + -- Case where source comprises only characters in Left + + if Low = 0 then + Source.Current_Length := 0; + + else + High := Super_Index (Source, Right, Outside, Backward); + -- Case where source comprises only characters in Right + + if High = 0 then Source.Current_Length := 0; - return; - end if; - end loop; - Source.Current_Length := 0; + elsif Low = 1 then + Source.Current_Length := High; + + elsif High < Low then + Source.Current_Length := 0; + + else + Source.Data (1 .. High - Low + 1) := Temp (Low .. High); + Source.Current_Length := High - Low + 1; + end if; + end if; end Super_Trim; ----------- @@ -1819,11 +2056,14 @@ package body Ada.Strings.Superbounded is raise Ada.Strings.Length_Error; else - Result.Current_Length := Left; - for J in 1 .. Left loop Result.Data (J) := Right; + pragma Loop_Invariant (Result.Data (1 .. J)'Initialized); + pragma Loop_Invariant + (for all K in 1 .. J => Result.Data (K) = Right); end loop; + + Result.Current_Length := Left; end if; return Result; @@ -1835,23 +2075,88 @@ package body Ada.Strings.Superbounded is Max_Length : Positive) return Super_String is Result : Super_String (Max_Length); - Pos : Positive := 1; + Pos : Natural := 0; Rlen : constant Natural := Right'Length; Nlen : constant Natural := Left * Rlen; + -- Parts of the proof involving manipulations with the modulo operator + -- are complicated for the prover and can't be done automatically in + -- the global subprogram. That's why we isolate them in these two ghost + -- lemmas. + + procedure Lemma_Mod (K : Integer) with + Ghost, + Pre => + Rlen /= 0 + and then Pos mod Rlen = 0 + and then Pos in 0 .. Max_Length - Rlen + and then K in Pos .. Pos + Rlen - 1, + Post => K mod Rlen = K - Pos; + -- Lemma_Mod is applied to an index considered in Lemma_Split to prove + -- that it has the right value modulo Right'Length. + + procedure Lemma_Split with + Ghost, + Pre => + Rlen /= 0 + and then Pos mod Rlen = 0 + and then Pos in 0 .. Max_Length - Rlen + and then Result.Data (1 .. Pos + Rlen)'Initialized + and then String (Result.Data (Pos + 1 .. Pos + Rlen)) = Right, + Post => + (for all K in Pos + 1 .. Pos + Rlen => + Result.Data (K) = Right (Right'First + (K - 1) mod Rlen)); + -- Lemma_Split is used after Result.Data (Pos + 1 .. Pos + Rlen) is + -- updated to Right and concludes that the characters match for each + -- index when taken modulo Right'Length, as the considered slice starts + -- at index 1 modulo Right'Length. + + --------------- + -- Lemma_Mod -- + --------------- + + procedure Lemma_Mod (K : Integer) is null; + + ----------------- + -- Lemma_Split -- + ----------------- + + procedure Lemma_Split is + begin + for K in Pos + 1 .. Pos + Rlen loop + Lemma_Mod (K - 1); + pragma Loop_Invariant + (for all J in Pos + 1 .. K => + Result.Data (J) = Right (Right'First + (J - 1) mod Rlen)); + end loop; + end Lemma_Split; + begin if Nlen > Max_Length then raise Ada.Strings.Length_Error; else - Result.Current_Length := Nlen; - if Nlen > 0 then for J in 1 .. Left loop - Result.Data (Pos .. Pos + Rlen - 1) := Right; + Result.Data (Pos + 1 .. Pos + Rlen) := + Super_String_Data (Right); + pragma Assert + (for all K in 1 .. Rlen => Result.Data (Pos + K) = + Right (Right'First - 1 + K)); + pragma Assert + (String (Result.Data (Pos + 1 .. Pos + Rlen)) = Right); + Lemma_Split; Pos := Pos + Rlen; + pragma Loop_Invariant (Pos = J * Rlen); + pragma Loop_Invariant (Result.Data (1 .. Pos)'Initialized); + pragma Loop_Invariant + (for all K in 1 .. Pos => + Result.Data (K) = + Right (Right'First + (K - 1) mod Rlen)); end loop; end if; + + Result.Current_Length := Nlen; end if; return Result; @@ -1862,7 +2167,7 @@ package body Ada.Strings.Superbounded is Right : Super_String) return Super_String is Result : Super_String (Right.Max_Length); - Pos : Positive := 1; + Pos : Natural := 0; Rlen : constant Natural := Right.Current_Length; Nlen : constant Natural := Left * Rlen; @@ -1871,15 +2176,21 @@ package body Ada.Strings.Superbounded is raise Ada.Strings.Length_Error; else - Result.Current_Length := Nlen; - if Nlen > 0 then for J in 1 .. Left loop - Result.Data (Pos .. Pos + Rlen - 1) := + Result.Data (Pos + 1 .. Pos + Rlen) := Right.Data (1 .. Rlen); Pos := Pos + Rlen; + pragma Loop_Invariant (Pos = J * Rlen); + pragma Loop_Invariant (Result.Data (1 .. Pos)'Initialized); + pragma Loop_Invariant + (for all K in 1 .. Pos => + Result.Data (K) = + Right.Data (1 + (K - 1) mod Rlen)); end loop; end if; + + Result.Current_Length := Nlen; end if; return Result; @@ -1891,7 +2202,7 @@ package body Ada.Strings.Superbounded is function To_Super_String (Source : String; - Max_Length : Natural; + Max_Length : Positive; Drop : Truncation := Error) return Super_String is Result : Super_String (Max_Length); @@ -1899,20 +2210,20 @@ package body Ada.Strings.Superbounded is begin if Slen <= Max_Length then + Result.Data (1 .. Slen) := Super_String_Data (Source); Result.Current_Length := Slen; - Result.Data (1 .. Slen) := Source; else case Drop is when Strings.Right => + Result.Data (1 .. Max_Length) := Super_String_Data + (Source (Source'First .. Source'First - 1 + Max_Length)); Result.Current_Length := Max_Length; - Result.Data (1 .. Max_Length) := - Source (Source'First .. Source'First - 1 + Max_Length); when Strings.Left => + Result.Data (1 .. Max_Length) := Super_String_Data + (Source (Source'Last - (Max_Length - 1) .. Source'Last)); Result.Current_Length := Max_Length; - Result.Data (1 .. Max_Length) := - Source (Source'Last - (Max_Length - 1) .. Source'Last); when Strings.Error => raise Ada.Strings.Length_Error; diff --git a/gcc/ada/libgnat/a-strsup.ads b/gcc/ada/libgnat/a-strsup.ads index 9e568a8..7428e9c 100644 --- a/gcc/ada/libgnat/a-strsup.ads +++ b/gcc/ada/libgnat/a-strsup.ads @@ -36,28 +36,47 @@ -- length as the discriminant. Individual instantiations of Strings.Bounded -- use this type with an appropriate discriminant value set. -with Ada.Strings.Maps; +-- Preconditions in this unit are meant for analysis only, not for run-time +-- checking, so that the expected exceptions are raised. This is enforced by +-- setting the corresponding assertion policy to Ignore. Postconditions and +-- contract cases should not be executed at runtime as well, in order not to +-- slow down the execution of these functions. -package Ada.Strings.Superbounded is +pragma Assertion_Policy (Pre => Ignore, + Post => Ignore, + Contract_Cases => Ignore, + Ghost => Ignore); + +with Ada.Strings.Maps; use type Ada.Strings.Maps.Character_Mapping_Function; +with Ada.Strings.Search; + +package Ada.Strings.Superbounded with SPARK_Mode is pragma Preelaborate; -- Type Bounded_String in Ada.Strings.Bounded.Generic_Bounded_Length is -- derived from Super_String, with the constraint of the maximum length. + type Super_String_Data is new String with Relaxed_Initialization; + type Super_String (Max_Length : Positive) is record Current_Length : Natural := 0; - Data : String (1 .. Max_Length); + Data : Super_String_Data (1 .. Max_Length); -- A previous version had a default initial value for Data, which is -- no longer necessary, because we now special-case this type in the -- compiler, so "=" composes properly for descendants of this type. -- Leaving it out is more efficient. - end record; + end record + with + Predicate => + Current_Length <= Max_Length + and then Data (1 .. Current_Length)'Initialized; -- The subprograms defined for Super_String are similar to those -- defined for Bounded_String, except that they have different names, so -- that they can be renamed in Ada.Strings.Bounded.Generic_Bounded_Length. - function Super_Length (Source : Super_String) return Natural; + function Super_Length (Source : Super_String) return Natural + is (Source.Current_Length); -------------------------------------------------------- -- Conversion, Concatenation, and Selection Functions -- @@ -65,109 +84,606 @@ package Ada.Strings.Superbounded is function To_Super_String (Source : String; - Max_Length : Natural; - Drop : Truncation := Error) return Super_String; + Max_Length : Positive; + Drop : Truncation := Error) return Super_String + with + Pre => (if Source'Length > Max_Length then Drop /= Error), + Post => To_Super_String'Result.Max_Length = Max_Length, + Contract_Cases => + (Source'Length <= Max_Length + => + Super_To_String (To_Super_String'Result) = Source, + + Source'Length > Max_Length and then Drop = Left + => + Super_To_String (To_Super_String'Result) = + Source (Source'Last - Max_Length + 1 .. Source'Last), + + others -- Drop = Right + => + Super_To_String (To_Super_String'Result) = + Source (Source'First .. Source'First - 1 + Max_Length)), + Global => null; -- Note the additional parameter Max_Length, which specifies the maximum -- length setting of the resulting Super_String value. -- The following procedures have declarations (and semantics) that are -- exactly analogous to those declared in Ada.Strings.Bounded. - function Super_To_String (Source : Super_String) return String; + function Super_To_String (Source : Super_String) return String + is (String (Source.Data (1 .. Source.Current_Length))); procedure Set_Super_String (Target : out Super_String; Source : String; - Drop : Truncation := Error); + Drop : Truncation := Error) + with + Pre => + (if Source'Length > Target.Max_Length then Drop /= Error), + Contract_Cases => + (Source'Length <= Target.Max_Length + => + Super_To_String (Target) = Source, + + Source'Length > Target.Max_Length and then Drop = Left + => + Super_To_String (Target) = + Source (Source'Last - Target.Max_Length + 1 .. Source'Last), + + others -- Drop = Right + => + Super_To_String (Target) = + Source (Source'First .. Source'First - 1 + Target.Max_Length)), + Global => null; function Super_Append (Left : Super_String; Right : Super_String; - Drop : Truncation := Error) return Super_String; + Drop : Truncation := Error) return Super_String + with + Pre => + Left.Max_Length = Right.Max_Length + and then + (if Super_Length (Left) > Left.Max_Length - Super_Length (Right) + then Drop /= Error), + Post => Super_Append'Result.Max_Length = Left.Max_Length, + Contract_Cases => + (Super_Length (Left) <= Left.Max_Length - Super_Length (Right) + => + Super_Length (Super_Append'Result) = + Super_Length (Left) + Super_Length (Right) + and then + Super_Slice (Super_Append'Result, 1, Super_Length (Left)) = + Super_To_String (Left) + and then + (if Super_Length (Right) > 0 then + Super_Slice (Super_Append'Result, + Super_Length (Left) + 1, + Super_Length (Super_Append'Result)) = + Super_To_String (Right)), + + Super_Length (Left) > Left.Max_Length - Super_Length (Right) + and then Drop = Strings.Left + => + Super_Length (Super_Append'Result) = Left.Max_Length + and then + (if Super_Length (Right) < Left.Max_Length then + String'(Super_Slice (Super_Append'Result, + 1, Left.Max_Length - Super_Length (Right))) = + Super_Slice (Left, + Super_Length (Left) - Left.Max_Length + + Super_Length (Right) + 1, + Super_Length (Left))) + and then + Super_Slice (Super_Append'Result, + Left.Max_Length - Super_Length (Right) + 1, Left.Max_Length) = + Super_To_String (Right), + + others -- Drop = Right + => + Super_Length (Super_Append'Result) = Left.Max_Length + and then + Super_Slice (Super_Append'Result, 1, Super_Length (Left)) = + Super_To_String (Left) + and then + (if Super_Length (Left) < Left.Max_Length then + String'(Super_Slice (Super_Append'Result, + Super_Length (Left) + 1, Left.Max_Length)) = + Super_Slice (Right, + 1, Left.Max_Length - Super_Length (Left)))), + Global => null; function Super_Append (Left : Super_String; Right : String; - Drop : Truncation := Error) return Super_String; + Drop : Truncation := Error) return Super_String + with + Pre => + (if Right'Length > Left.Max_Length - Super_Length (Left) + then Drop /= Error), + Post => Super_Append'Result.Max_Length = Left.Max_Length, + Contract_Cases => + (Super_Length (Left) <= Left.Max_Length - Right'Length + => + Super_Length (Super_Append'Result) = + Super_Length (Left) + Right'Length + and then + Super_Slice (Super_Append'Result, 1, Super_Length (Left)) = + Super_To_String (Left) + and then + (if Right'Length > 0 then + Super_Slice (Super_Append'Result, + Super_Length (Left) + 1, + Super_Length (Super_Append'Result)) = + Right), + + Super_Length (Left) > Left.Max_Length - Right'Length + and then Drop = Strings.Left + => + Super_Length (Super_Append'Result) = Left.Max_Length + and then + (if Right'Length < Left.Max_Length then + + -- The result is the end of Left followed by Right + + String'(Super_Slice (Super_Append'Result, + 1, Left.Max_Length - Right'Length)) = + Super_Slice (Left, + Super_Length (Left) - Left.Max_Length + Right'Length + + 1, + Super_Length (Left)) + and then + Super_Slice (Super_Append'Result, + Left.Max_Length - Right'Length + 1, Left.Max_Length) = + Right + else + -- The result is the last Max_Length characters of Right + + Super_To_String (Super_Append'Result) = + Right (Right'Last - Left.Max_Length + 1 .. Right'Last)), + + others -- Drop = Right + => + Super_Length (Super_Append'Result) = Left.Max_Length + and then + Super_Slice (Super_Append'Result, 1, Super_Length (Left)) = + Super_To_String (Left) + and then + (if Super_Length (Left) < Left.Max_Length then + Super_Slice (Super_Append'Result, + Super_Length (Left) + 1, Left.Max_Length) = + Right (Right'First + .. Left.Max_Length - Super_Length (Left) + - 1 + Right'First))), + Global => null; function Super_Append (Left : String; Right : Super_String; - Drop : Truncation := Error) return Super_String; + Drop : Truncation := Error) return Super_String + with + Pre => + (if Left'Length > Right.Max_Length - Super_Length (Right) + then Drop /= Error), + Post => Super_Append'Result.Max_Length = Right.Max_Length, + Contract_Cases => + (Left'Length <= Right.Max_Length - Super_Length (Right) + => + Super_Length (Super_Append'Result) = + Left'Length + Super_Length (Right) + and then Super_Slice (Super_Append'Result, 1, Left'Length) = Left + and then + (if Super_Length (Right) > 0 then + Super_Slice (Super_Append'Result, + Left'Length + 1, Super_Length (Super_Append'Result)) = + Super_To_String (Right)), + + Left'Length > Right.Max_Length - Super_Length (Right) + and then Drop = Strings.Left + => + Super_Length (Super_Append'Result) = Right.Max_Length + and then + (if Super_Length (Right) < Right.Max_Length then + Super_Slice (Super_Append'Result, + 1, Right.Max_Length - Super_Length (Right)) = + Left + (Left'Last - Right.Max_Length + Super_Length (Right) + 1 + .. Left'Last)) + and then + Super_Slice (Super_Append'Result, + Right.Max_Length - Super_Length (Right) + 1, + Right.Max_Length) = + Super_To_String (Right), + + others -- Drop = Right + => + Super_Length (Super_Append'Result) = Right.Max_Length + and then + (if Left'Length < Right.Max_Length then + + -- The result is Left followed by the beginning of Right + + Super_Slice (Super_Append'Result, 1, Left'Length) = Left + and then + String'(Super_Slice (Super_Append'Result, + Left'Length + 1, Right.Max_Length)) = + Super_Slice (Right, 1, Right.Max_Length - Left'Length) + else + -- The result is the first Max_Length characters of Left + + Super_To_String (Super_Append'Result) = + Left (Left'First .. Right.Max_Length - 1 + Left'First))), + Global => null; function Super_Append (Left : Super_String; Right : Character; - Drop : Truncation := Error) return Super_String; + Drop : Truncation := Error) return Super_String + with + Pre => + (if Super_Length (Left) = Left.Max_Length then Drop /= Error), + Post => Super_Append'Result.Max_Length = Left.Max_Length, + Contract_Cases => + (Super_Length (Left) < Left.Max_Length + => + Super_Length (Super_Append'Result) = Super_Length (Left) + 1 + and then + Super_Slice (Super_Append'Result, 1, Super_Length (Left)) = + Super_To_String (Left) + and then + Super_Element (Super_Append'Result, Super_Length (Left) + 1) = + Right, + + Super_Length (Left) = Left.Max_Length and then Drop = Strings.Right + => + Super_Length (Super_Append'Result) = Left.Max_Length + and then + Super_To_String (Super_Append'Result) = Super_To_String (Left), + + others -- Drop = Left + => + Super_Length (Super_Append'Result) = Left.Max_Length + and then + String'(Super_Slice (Super_Append'Result, + 1, Left.Max_Length - 1)) = + Super_Slice (Left, 2, Left.Max_Length) + and then + Super_Element (Super_Append'Result, Left.Max_Length) = Right), + Global => null; function Super_Append (Left : Character; Right : Super_String; - Drop : Truncation := Error) return Super_String; + Drop : Truncation := Error) return Super_String + with + Pre => + (if Super_Length (Right) = Right.Max_Length then Drop /= Error), + Post => Super_Append'Result.Max_Length = Right.Max_Length, + Contract_Cases => + (Super_Length (Right) < Right.Max_Length + => + Super_Length (Super_Append'Result) = Super_Length (Right) + 1 + and then + Super_Slice (Super_Append'Result, 2, Super_Length (Right) + 1) = + Super_To_String (Right) + and then Super_Element (Super_Append'Result, 1) = Left, + + Super_Length (Right) = Right.Max_Length and then Drop = Strings.Left + => + Super_Length (Super_Append'Result) = Right.Max_Length + and then + Super_To_String (Super_Append'Result) = Super_To_String (Right), + + others -- Drop = Right + => + Super_Length (Super_Append'Result) = Right.Max_Length + and then + String'(Super_Slice (Super_Append'Result, 2, Right.Max_Length)) = + Super_Slice (Right, 1, Right.Max_Length - 1) + and then Super_Element (Super_Append'Result, 1) = Left), + Global => null; procedure Super_Append (Source : in out Super_String; New_Item : Super_String; - Drop : Truncation := Error); + Drop : Truncation := Error) + with + Pre => + Source.Max_Length = New_Item.Max_Length + and then + (if Super_Length (Source) > + Source.Max_Length - Super_Length (New_Item) + then Drop /= Error), + Contract_Cases => + (Super_Length (Source) <= Source.Max_Length - Super_Length (New_Item) + => + Super_Length (Source) = + Super_Length (Source'Old) + Super_Length (New_Item) + and then + Super_Slice (Source, 1, Super_Length (Source'Old)) = + Super_To_String (Source'Old) + and then + (if Super_Length (New_Item) > 0 then + Super_Slice (Source, + Super_Length (Source'Old) + 1, Super_Length (Source)) = + Super_To_String (New_Item)), + + Super_Length (Source) > Source.Max_Length - Super_Length (New_Item) + and then Drop = Left + => + Super_Length (Source) = Source.Max_Length + and then + (if Super_Length (New_Item) < Source.Max_Length then + String'(Super_Slice (Source, + 1, Source.Max_Length - Super_Length (New_Item))) = + Super_Slice (Source'Old, + Super_Length (Source'Old) - Source.Max_Length + + Super_Length (New_Item) + 1, + Super_Length (Source'Old))) + and then + Super_Slice (Source, + Source.Max_Length - Super_Length (New_Item) + 1, + Source.Max_Length) = + Super_To_String (New_Item), + + others -- Drop = Right + => + Super_Length (Source) = Source.Max_Length + and then + Super_Slice (Source, 1, Super_Length (Source'Old)) = + Super_To_String (Source'Old) + and then + (if Super_Length (Source'Old) < Source.Max_Length then + String'(Super_Slice (Source, + Super_Length (Source'Old) + 1, Source.Max_Length)) = + Super_Slice (New_Item, + 1, Source.Max_Length - Super_Length (Source'Old)))), + Global => null; procedure Super_Append (Source : in out Super_String; New_Item : String; - Drop : Truncation := Error); + Drop : Truncation := Error) + with + Pre => + (if New_Item'Length > Source.Max_Length - Super_Length (Source) + then Drop /= Error), + Contract_Cases => + (Super_Length (Source) <= Source.Max_Length - New_Item'Length + => + Super_Length (Source) = Super_Length (Source'Old) + New_Item'Length + and then + Super_Slice (Source, 1, Super_Length (Source'Old)) = + Super_To_String (Source'Old) + and then + (if New_Item'Length > 0 then + Super_Slice (Source, + Super_Length (Source'Old) + 1, Super_Length (Source)) = + New_Item), + + Super_Length (Source) > Source.Max_Length - New_Item'Length + and then Drop = Left + => + Super_Length (Source) = Source.Max_Length + and then + (if New_Item'Length < Source.Max_Length then + + -- The result is the end of Source followed by New_Item + + String'(Super_Slice (Source, + 1, Source.Max_Length - New_Item'Length)) = + Super_Slice (Source'Old, + Super_Length (Source'Old) - Source.Max_Length + + New_Item'Length + 1, + Super_Length (Source'Old)) + and then + Super_Slice (Source, + Source.Max_Length - New_Item'Length + 1, + Source.Max_Length) = + New_Item + else + -- The result is the last Max_Length characters of + -- New_Item. + + Super_To_String (Source) = New_Item + (New_Item'Last - Source.Max_Length + 1 .. New_Item'Last)), + + others -- Drop = Right + => + Super_Length (Source) = Source.Max_Length + and then + Super_Slice (Source, 1, Super_Length (Source'Old)) = + Super_To_String (Source'Old) + and then + (if Super_Length (Source'Old) < Source.Max_Length then + Super_Slice (Source, + Super_Length (Source'Old) + 1, Source.Max_Length) = + New_Item (New_Item'First + .. Source.Max_Length - Super_Length (Source'Old) - 1 + + New_Item'First))), + Global => null; procedure Super_Append (Source : in out Super_String; New_Item : Character; - Drop : Truncation := Error); + Drop : Truncation := Error) + with + Pre => + (if Super_Length (Source) = Source.Max_Length then Drop /= Error), + Contract_Cases => + (Super_Length (Source) < Source.Max_Length + => + Super_Length (Source) = Super_Length (Source'Old) + 1 + and then + Super_Slice (Source, 1, Super_Length (Source'Old)) = + Super_To_String (Source'Old) + and then + Super_Element (Source, Super_Length (Source'Old) + 1) = New_Item, + + Super_Length (Source) = Source.Max_Length and then Drop = Right + => + Super_Length (Source) = Source.Max_Length + and then Super_To_String (Source) = Super_To_String (Source'Old), + + others -- Drop = Left + => + Super_Length (Source) = Source.Max_Length + and then + String'(Super_Slice (Source, 1, Source.Max_Length - 1)) = + Super_Slice (Source'Old, 2, Source.Max_Length) + and then Super_Element (Source, Source.Max_Length) = New_Item), + Global => null; function Concat (Left : Super_String; - Right : Super_String) return Super_String; + Right : Super_String) return Super_String + with + Pre => Left.Max_Length = Right.Max_Length + and then Super_Length (Left) <= Left.Max_Length - Super_Length (Right), + Post => Concat'Result.Max_Length = Left.Max_Length + and then + Super_Length (Concat'Result) = + Super_Length (Left) + Super_Length (Right) + and then + Super_Slice (Concat'Result, 1, Super_Length (Left)) = + Super_To_String (Left) + and then + (if Super_Length (Right) > 0 then + Super_Slice (Concat'Result, + Super_Length (Left) + 1, Super_Length (Concat'Result)) = + Super_To_String (Right)), + Global => null; function Concat (Left : Super_String; - Right : String) return Super_String; + Right : String) return Super_String + with + Pre => Right'Length <= Left.Max_Length - Super_Length (Left), + Post => Concat'Result.Max_Length = Left.Max_Length + and then + Super_Length (Concat'Result) = Super_Length (Left) + Right'Length + and then + Super_Slice (Concat'Result, 1, Super_Length (Left)) = + Super_To_String (Left) + and then + (if Right'Length > 0 then + Super_Slice (Concat'Result, + Super_Length (Left) + 1, Super_Length (Concat'Result)) = + Right), + Global => null; function Concat (Left : String; - Right : Super_String) return Super_String; + Right : Super_String) return Super_String + with + Pre => Left'Length <= Right.Max_Length - Super_Length (Right), + Post => Concat'Result.Max_Length = Right.Max_Length + and then + Super_Length (Concat'Result) = Left'Length + Super_Length (Right) + and then Super_Slice (Concat'Result, 1, Left'Length) = Left + and then + (if Super_Length (Right) > 0 then + Super_Slice (Concat'Result, + Left'Length + 1, Super_Length (Concat'Result)) = + Super_To_String (Right)), + Global => null; function Concat (Left : Super_String; - Right : Character) return Super_String; + Right : Character) return Super_String + with + Pre => Super_Length (Left) < Left.Max_Length, + Post => Concat'Result.Max_Length = Left.Max_Length + and then Super_Length (Concat'Result) = Super_Length (Left) + 1 + and then + Super_Slice (Concat'Result, 1, Super_Length (Left)) = + Super_To_String (Left) + and then Super_Element (Concat'Result, Super_Length (Left) + 1) = Right, + Global => null; function Concat (Left : Character; - Right : Super_String) return Super_String; + Right : Super_String) return Super_String + with + Pre => Super_Length (Right) < Right.Max_Length, + Post => Concat'Result.Max_Length = Right.Max_Length + and then Super_Length (Concat'Result) = 1 + Super_Length (Right) + and then Super_Element (Concat'Result, 1) = Left + and then + Super_Slice (Concat'Result, 2, Super_Length (Concat'Result)) = + Super_To_String (Right), + Global => null; function Super_Element (Source : Super_String; - Index : Positive) return Character; + Index : Positive) return Character + is (if Index <= Source.Current_Length + then Source.Data (Index) + else raise Index_Error) + with Pre => Index <= Super_Length (Source); procedure Super_Replace_Element (Source : in out Super_String; Index : Positive; - By : Character); + By : Character) + with + Pre => Index <= Super_Length (Source), + Post => Super_Length (Source) = Super_Length (Source'Old) + and then + (for all K in 1 .. Super_Length (Source) => + Super_Element (Source, K) = + (if K = Index then By else Super_Element (Source'Old, K))), + Global => null; function Super_Slice (Source : Super_String; Low : Positive; - High : Natural) return String; + High : Natural) return String + is (if Low - 1 > Source.Current_Length or else High > Source.Current_Length + + -- Note: test of High > Length is in accordance with AI95-00128 + + then raise Index_Error + else + -- Note: in this case, superflat bounds are not a problem, we just + -- get the null string in accordance with normal Ada slice rules. + + String (Source.Data (Low .. High))) + with Pre => Low - 1 <= Super_Length (Source) + and then High <= Super_Length (Source); function Super_Slice (Source : Super_String; Low : Positive; - High : Natural) return Super_String; + High : Natural) return Super_String + with + Pre => + Low - 1 <= Super_Length (Source) and then High <= Super_Length (Source), + Post => Super_Slice'Result.Max_Length = Source.Max_Length + and then + Super_To_String (Super_Slice'Result) = + Super_Slice (Source, Low, High), + Global => null; procedure Super_Slice (Source : Super_String; Target : out Super_String; Low : Positive; - High : Natural); + High : Natural) + with + Pre => Source.Max_Length = Target.Max_Length + and then Low - 1 <= Super_Length (Source) + and then High <= Super_Length (Source), + Post => Super_To_String (Target) = Super_Slice (Source, Low, High), + Global => null; function "=" (Left : Super_String; - Right : Super_String) return Boolean; + Right : Super_String) return Boolean + with + Pre => Left.Max_Length = Right.Max_Length, + Post => "="'Result = (Super_To_String (Left) = Super_To_String (Right)), + Global => null; function Equal (Left : Super_String; @@ -175,59 +691,111 @@ package Ada.Strings.Superbounded is function Equal (Left : Super_String; - Right : String) return Boolean; + Right : String) return Boolean + with + Post => Equal'Result = (Super_To_String (Left) = Right), + Global => null; function Equal (Left : String; - Right : Super_String) return Boolean; + Right : Super_String) return Boolean + with + Post => Equal'Result = (Left = Super_To_String (Right)), + Global => null; function Less (Left : Super_String; - Right : Super_String) return Boolean; + Right : Super_String) return Boolean + with + Pre => Left.Max_Length = Right.Max_Length, + Post => + Less'Result = (Super_To_String (Left) < Super_To_String (Right)), + Global => null; function Less (Left : Super_String; - Right : String) return Boolean; + Right : String) return Boolean + with + Post => Less'Result = (Super_To_String (Left) < Right), + Global => null; function Less (Left : String; - Right : Super_String) return Boolean; + Right : Super_String) return Boolean + with + Post => Less'Result = (Left < Super_To_String (Right)), + Global => null; function Less_Or_Equal (Left : Super_String; - Right : Super_String) return Boolean; + Right : Super_String) return Boolean + with + Pre => Left.Max_Length = Right.Max_Length, + Post => + Less_Or_Equal'Result = + (Super_To_String (Left) <= Super_To_String (Right)), + Global => null; function Less_Or_Equal (Left : Super_String; - Right : String) return Boolean; + Right : String) return Boolean + with + Post => Less_Or_Equal'Result = (Super_To_String (Left) <= Right), + Global => null; function Less_Or_Equal (Left : String; - Right : Super_String) return Boolean; + Right : Super_String) return Boolean + with + Post => Less_Or_Equal'Result = (Left <= Super_To_String (Right)), + Global => null; function Greater (Left : Super_String; - Right : Super_String) return Boolean; + Right : Super_String) return Boolean + with + Pre => Left.Max_Length = Right.Max_Length, + Post => + Greater'Result = (Super_To_String (Left) > Super_To_String (Right)), + Global => null; function Greater (Left : Super_String; - Right : String) return Boolean; + Right : String) return Boolean + with + Post => Greater'Result = (Super_To_String (Left) > Right), + Global => null; function Greater (Left : String; - Right : Super_String) return Boolean; + Right : Super_String) return Boolean + with + Post => Greater'Result = (Left > Super_To_String (Right)), + Global => null; function Greater_Or_Equal (Left : Super_String; - Right : Super_String) return Boolean; + Right : Super_String) return Boolean + with + Pre => Left.Max_Length = Right.Max_Length, + Post => + Greater_Or_Equal'Result = + (Super_To_String (Left) >= Super_To_String (Right)), + Global => null; function Greater_Or_Equal (Left : Super_String; - Right : String) return Boolean; + Right : String) return Boolean + with + Post => Greater_Or_Equal'Result = (Super_To_String (Left) >= Right), + Global => null; function Greater_Or_Equal (Left : String; - Right : Super_String) return Boolean; + Right : Super_String) return Boolean + with + Post => Greater_Or_Equal'Result = (Left >= Super_To_String (Right)), + Global => null; ---------------------- -- Search Functions -- @@ -237,63 +805,449 @@ package Ada.Strings.Superbounded is (Source : Super_String; Pattern : String; Going : Direction := Forward; - Mapping : Maps.Character_Mapping := Maps.Identity) return Natural; + Mapping : Maps.Character_Mapping := Maps.Identity) return Natural + with + Pre => Pattern'Length > 0, + Post => Super_Index'Result <= Super_Length (Source), + Contract_Cases => + + -- If Source is the empty string, then 0 is returned + + (Super_Length (Source) = 0 + => + Super_Index'Result = 0, + + -- If some slice of Source matches Pattern, then a valid index is + -- returned. + + Super_Length (Source) > 0 + and then + (for some J in 1 .. Super_Length (Source) - (Pattern'Length - 1) => + Search.Match (Super_To_String (Source), Pattern, Mapping, J)) + => + -- The result is in the considered range of Source + + Super_Index'Result in + 1 .. Super_Length (Source) - (Pattern'Length - 1) + + -- The slice beginning at the returned index matches Pattern + + and then Search.Match + (Super_To_String (Source), Pattern, Mapping, Super_Index'Result) + + -- The result is the smallest or largest index which satisfies + -- the matching, respectively when Going = Forward and Going = + -- Backward. + + and then + (for all J in 1 .. Super_Length (Source) => + (if (if Going = Forward + then J <= Super_Index'Result - 1 + else J - 1 in Super_Index'Result + .. Super_Length (Source) - Pattern'Length) + then not (Search.Match + (Super_To_String (Source), Pattern, Mapping, J)))), + + -- Otherwise, 0 is returned + + others + => + Super_Index'Result = 0), + Global => null; function Super_Index (Source : Super_String; Pattern : String; Going : Direction := Forward; - Mapping : Maps.Character_Mapping_Function) return Natural; + Mapping : Maps.Character_Mapping_Function) return Natural + with + Pre => Pattern'Length /= 0 and then Mapping /= null, + Post => Super_Index'Result <= Super_Length (Source), + Contract_Cases => + + -- If Source is the empty string, then 0 is returned + + (Super_Length (Source) = 0 + => + Super_Index'Result = 0, + + -- If some slice of Source matches Pattern, then a valid index is + -- returned. + + Super_Length (Source) > 0 + and then + (for some J in 1 .. Super_Length (Source) - (Pattern'Length - 1) => + Search.Match (Super_To_String (Source), Pattern, Mapping, J)) + => + -- The result is in the considered range of Source + + Super_Index'Result in + 1 .. Super_Length (Source) - (Pattern'Length - 1) + + -- The slice beginning at the returned index matches Pattern + + and then Search.Match + (Super_To_String (Source), Pattern, Mapping, Super_Index'Result) + + -- The result is the smallest or largest index which satisfies + -- the matching, respectively when Going = Forward and Going = + -- Backward. + + and then + (for all J in 1 .. Super_Length (Source) => + (if (if Going = Forward + then J <= Super_Index'Result - 1 + else J - 1 in Super_Index'Result + .. Super_Length (Source) - Pattern'Length) + then not (Search.Match + (Super_To_String (Source), Pattern, Mapping, J)))), + + -- Otherwise, 0 is returned + + others + => + Super_Index'Result = 0), + Global => null; function Super_Index (Source : Super_String; Set : Maps.Character_Set; Test : Membership := Inside; - Going : Direction := Forward) return Natural; + Going : Direction := Forward) return Natural + with + Post => Super_Index'Result <= Super_Length (Source), + Contract_Cases => + + -- If no character of Source satisfies the property Test on Set, + -- then 0 is returned. + + ((for all C of Super_To_String (Source) => + (Test = Inside) /= Maps.Is_In (C, Set)) + => + Super_Index'Result = 0, + + -- Otherwise, an index in the range of Source is returned + + others + => + -- The result is in the range of Source + + Super_Index'Result in 1 .. Super_Length (Source) + + -- The character at the returned index satisfies the property + -- Test on Set. + + and then + (Test = Inside) = + Maps.Is_In (Super_Element (Source, Super_Index'Result), Set) + + -- The result is the smallest or largest index which satisfies + -- the property, respectively when Going = Forward and Going = + -- Backward. + + and then + (for all J in 1 .. Super_Length (Source) => + (if J /= Super_Index'Result + and then (J < Super_Index'Result) = (Going = Forward) + then (Test = Inside) + /= Maps.Is_In (Super_Element (Source, J), Set)))), + Global => null; function Super_Index (Source : Super_String; Pattern : String; From : Positive; Going : Direction := Forward; - Mapping : Maps.Character_Mapping := Maps.Identity) return Natural; + Mapping : Maps.Character_Mapping := Maps.Identity) return Natural + with + Pre => + (if Super_Length (Source) /= 0 then From <= Super_Length (Source)) + and then Pattern'Length /= 0, + Post => Super_Index'Result <= Super_Length (Source), + Contract_Cases => + + -- If Source is the empty string, then 0 is returned + + (Super_Length (Source) = 0 + => + Super_Index'Result = 0, + + -- If some slice of Source matches Pattern, then a valid index is + -- returned. + + Super_Length (Source) > 0 + and then + (for some J in + (if Going = Forward then From else 1) + .. (if Going = Forward then Super_Length (Source) else From) + - (Pattern'Length - 1) => + Search.Match (Super_To_String (Source), Pattern, Mapping, J)) + => + -- The result is in the considered range of Source + + Super_Index'Result in + (if Going = Forward then From else 1) + .. (if Going = Forward then Super_Length (Source) else From) + - (Pattern'Length - 1) + + -- The slice beginning at the returned index matches Pattern + + and then Search.Match + (Super_To_String (Source), Pattern, Mapping, Super_Index'Result) + + -- The result is the smallest or largest index which satisfies + -- the matching, respectively when Going = Forward and Going = + -- Backward. + + and then + (for all J in 1 .. Super_Length (Source) => + (if (if Going = Forward + then J in From .. Super_Index'Result - 1 + else J - 1 in Super_Index'Result + .. From - Pattern'Length) + then not (Search.Match + (Super_To_String (Source), Pattern, Mapping, J)))), + + -- Otherwise, 0 is returned + + others + => + Super_Index'Result = 0), + Global => null; function Super_Index (Source : Super_String; Pattern : String; From : Positive; Going : Direction := Forward; - Mapping : Maps.Character_Mapping_Function) return Natural; + Mapping : Maps.Character_Mapping_Function) return Natural + with + Pre => + (if Super_Length (Source) /= 0 then From <= Super_Length (Source)) + and then Pattern'Length /= 0 + and then Mapping /= null, + Post => Super_Index'Result <= Super_Length (Source), + Contract_Cases => + + -- If Source is the empty string, then 0 is returned + + (Super_Length (Source) = 0 + => + Super_Index'Result = 0, + + -- If some slice of Source matches Pattern, then a valid index is + -- returned. + + Super_Length (Source) > 0 + and then + (for some J in + (if Going = Forward then From else 1) + .. (if Going = Forward then Super_Length (Source) else From) + - (Pattern'Length - 1) => + Search.Match (Super_To_String (Source), Pattern, Mapping, J)) + => + -- The result is in the considered range of Source + + Super_Index'Result in + (if Going = Forward then From else 1) + .. (if Going = Forward then Super_Length (Source) else From) + - (Pattern'Length - 1) + + -- The slice beginning at the returned index matches Pattern + + and then Search.Match + (Super_To_String (Source), Pattern, Mapping, Super_Index'Result) + + -- The result is the smallest or largest index which satisfies + -- the matching, respectively when Going = Forward and Going = + -- Backward. + + and then + (for all J in 1 .. Super_Length (Source) => + (if (if Going = Forward + then J in From .. Super_Index'Result - 1 + else J - 1 in Super_Index'Result + .. From - Pattern'Length) + then not (Search.Match + (Super_To_String (Source), Pattern, Mapping, J)))), + + -- Otherwise, 0 is returned + + others + => + Super_Index'Result = 0), + Global => null; function Super_Index (Source : Super_String; Set : Maps.Character_Set; From : Positive; Test : Membership := Inside; - Going : Direction := Forward) return Natural; + Going : Direction := Forward) return Natural + with + Pre => + (if Super_Length (Source) /= 0 then From <= Super_Length (Source)), + Post => Super_Index'Result <= Super_Length (Source), + Contract_Cases => + + -- If Source is the empty string, or no character of the considered + -- slice of Source satisfies the property Test on Set, then 0 is + -- returned. + + (Super_Length (Source) = 0 + or else + (for all J in 1 .. Super_Length (Source) => + (if J = From or else (J > From) = (Going = Forward) then + (Test = Inside) /= + Maps.Is_In (Super_Element (Source, J), Set))) + => + Super_Index'Result = 0, + + -- Otherwise, an index in the considered range of Source is returned + + others + => + -- The result is in the considered range of Source + + Super_Index'Result in 1 .. Super_Length (Source) + and then + (Super_Index'Result = From + or else (Super_Index'Result > From) = (Going = Forward)) + + -- The character at the returned index satisfies the property + -- Test on Set. + + and then + (Test = Inside) = + Maps.Is_In (Super_Element (Source, Super_Index'Result), Set) + + -- The result is the smallest or largest index which satisfies + -- the property, respectively when Going = Forward and Going = + -- Backward. + + and then + (for all J in 1 .. Super_Length (Source) => + (if J /= Super_Index'Result + and then (J < Super_Index'Result) = (Going = Forward) + and then (J = From + or else (J > From) = (Going = Forward)) + then (Test = Inside) + /= Maps.Is_In (Super_Element (Source, J), Set)))), + Global => null; function Super_Index_Non_Blank (Source : Super_String; - Going : Direction := Forward) return Natural; + Going : Direction := Forward) return Natural + with + Post => Super_Index_Non_Blank'Result <= Super_Length (Source), + Contract_Cases => + + -- If all characters of Source are Space characters, then 0 is + -- returned. + + ((for all C of Super_To_String (Source) => C = ' ') + => + Super_Index_Non_Blank'Result = 0, + + -- Otherwise, an index in the range of Source is returned + + others + => + -- The result is in the range of Source + + Super_Index_Non_Blank'Result in 1 .. Super_Length (Source) + + -- The character at the returned index is not a Space character + + and then + Super_Element (Source, Super_Index_Non_Blank'Result) /= ' ' + + -- The result is the smallest or largest index which is not a + -- Space character, respectively when Going = Forward and Going + -- = Backward. + + and then + (for all J in 1 .. Super_Length (Source) => + (if J /= Super_Index_Non_Blank'Result + and then + (J < Super_Index_Non_Blank'Result) = (Going = Forward) + then Super_Element (Source, J) = ' '))), + Global => null; function Super_Index_Non_Blank (Source : Super_String; From : Positive; - Going : Direction := Forward) return Natural; + Going : Direction := Forward) return Natural + with + Pre => + (if Super_Length (Source) /= 0 then From <= Super_Length (Source)), + Post => Super_Index_Non_Blank'Result <= Super_Length (Source), + Contract_Cases => + + -- If Source is the empty string, or all characters of the + -- considered slice of Source are Space characters, then 0 + -- is returned. + + (Super_Length (Source) = 0 + or else + (for all J in 1 .. Super_Length (Source) => + (if J = From or else (J > From) = (Going = Forward) then + Super_Element (Source, J) = ' ')) + => + Super_Index_Non_Blank'Result = 0, + + -- Otherwise, an index in the considered range of Source is returned + + others + => + -- The result is in the considered range of Source + + Super_Index_Non_Blank'Result in 1 .. Super_Length (Source) + and then + (Super_Index_Non_Blank'Result = From + or else + (Super_Index_Non_Blank'Result > From) = (Going = Forward)) + + -- The character at the returned index is not a Space character + + and then + Super_Element (Source, Super_Index_Non_Blank'Result) /= ' ' + + -- The result is the smallest or largest index which isn't a + -- Space character, respectively when Going = Forward and Going + -- = Backward. + + and then + (for all J in 1 .. Super_Length (Source) => + (if J /= Super_Index_Non_Blank'Result + and then + (J < Super_Index_Non_Blank'Result) = (Going = Forward) + and then (J = From + or else (J > From) = (Going = Forward)) + then Super_Element (Source, J) = ' '))), + Global => null; function Super_Count (Source : Super_String; Pattern : String; - Mapping : Maps.Character_Mapping := Maps.Identity) return Natural; + Mapping : Maps.Character_Mapping := Maps.Identity) return Natural + with + Pre => Pattern'Length /= 0, + Global => null; function Super_Count (Source : Super_String; Pattern : String; - Mapping : Maps.Character_Mapping_Function) return Natural; + Mapping : Maps.Character_Mapping_Function) return Natural + with + Pre => Pattern'Length /= 0 and then Mapping /= null, + Global => null; function Super_Count (Source : Super_String; - Set : Maps.Character_Set) return Natural; + Set : Maps.Character_Set) return Natural + with + Global => null; procedure Super_Find_Token (Source : Super_String; @@ -301,14 +1255,112 @@ package Ada.Strings.Superbounded is From : Positive; Test : Membership; First : out Positive; - Last : out Natural); + Last : out Natural) + with + Pre => + (if Super_Length (Source) /= 0 then From <= Super_Length (Source)), + Contract_Cases => + + -- If Source is the empty string, or if no character of the + -- considered slice of Source satisfies the property Test on + -- Set, then First is set to From and Last is set to 0. + + (Super_Length (Source) = 0 + or else + (for all J in From .. Super_Length (Source) => + (Test = Inside) /= Maps.Is_In (Super_Element (Source, J), Set)) + => + First = From and then Last = 0, + + -- Otherwise, First and Last are set to valid indexes + + others + => + -- First and Last are in the considered range of Source + + First in From .. Super_Length (Source) + and then Last in First .. Super_Length (Source) + + -- No character between From and First satisfies the property + -- Test on Set. + + and then + (for all J in From .. First - 1 => + (Test = Inside) /= + Maps.Is_In (Super_Element (Source, J), Set)) + + -- All characters between First and Last satisfy the property + -- Test on Set. + + and then + (for all J in First .. Last => + (Test = Inside) = + Maps.Is_In (Super_Element (Source, J), Set)) + + -- If Last is not Source'Last, then the character at position + -- Last + 1 does not satify the property Test on Set. + + and then + (if Last < Super_Length (Source) + then + (Test = Inside) /= + Maps.Is_In (Super_Element (Source, Last + 1), Set))), + Global => null; procedure Super_Find_Token (Source : Super_String; Set : Maps.Character_Set; Test : Membership; First : out Positive; - Last : out Natural); + Last : out Natural) + with + Contract_Cases => + + -- If Source is the empty string, or if no character of the considered + -- slice of Source satisfies the property Test on Set, then First is + -- set to 1 and Last is set to 0. + + (Super_Length (Source) = 0 + or else + (for all J in 1 .. Super_Length (Source) => + (Test = Inside) /= Maps.Is_In (Super_Element (Source, J), Set)) + => + First = 1 and then Last = 0, + + -- Otherwise, First and Last are set to valid indexes + + others + => + -- First and Last are in the considered range of Source + + First in 1 .. Super_Length (Source) + and then Last in First .. Super_Length (Source) + + -- No character between 1 and First satisfies the property Test on + -- Set. + + and then + (for all J in 1 .. First - 1 => + (Test = Inside) /= + Maps.Is_In (Super_Element (Source, J), Set)) + + -- All characters between First and Last satisfy the property + -- Test on Set. + + and then + (for all J in First .. Last => + (Test = Inside) = + Maps.Is_In (Super_Element (Source, J), Set)) + + -- If Last is not Source'Last, then the character at position + -- Last + 1 does not satify the property Test on Set. + + and then + (if Last < Super_Length (Source) + then + (Test = Inside) /= + Maps.Is_In (Super_Element (Source, Last + 1), Set))), + Global => null; ------------------------------------ -- String Translation Subprograms -- @@ -316,19 +1368,51 @@ package Ada.Strings.Superbounded is function Super_Translate (Source : Super_String; - Mapping : Maps.Character_Mapping) return Super_String; + Mapping : Maps.Character_Mapping) return Super_String + with + Post => Super_Translate'Result.Max_Length = Source.Max_Length + and then Super_Length (Super_Translate'Result) = Super_Length (Source) + and then + (for all K in 1 .. Super_Length (Source) => + Super_Element (Super_Translate'Result, K) = + Ada.Strings.Maps.Value (Mapping, Super_Element (Source, K))), + Global => null; procedure Super_Translate (Source : in out Super_String; - Mapping : Maps.Character_Mapping); + Mapping : Maps.Character_Mapping) + with + Post => Super_Length (Source) = Super_Length (Source'Old) + and then + (for all K in 1 .. Super_Length (Source) => + Super_Element (Source, K) = + Ada.Strings.Maps.Value (Mapping, Super_Element (Source'Old, K))), + Global => null; function Super_Translate (Source : Super_String; - Mapping : Maps.Character_Mapping_Function) return Super_String; + Mapping : Maps.Character_Mapping_Function) return Super_String + with + Pre => Mapping /= null, + Post => Super_Translate'Result.Max_Length = Source.Max_Length + and then Super_Length (Super_Translate'Result) = Super_Length (Source) + and then + (for all K in 1 .. Super_Length (Source) => + Super_Element (Super_Translate'Result, K) = + Mapping (Super_Element (Source, K))), + Global => null; procedure Super_Translate (Source : in out Super_String; - Mapping : Maps.Character_Mapping_Function); + Mapping : Maps.Character_Mapping_Function) + with + Pre => Mapping /= null, + Post => Super_Length (Source) = Super_Length (Source'Old) + and then + (for all K in 1 .. Super_Length (Source) => + Super_Element (Source, K) = + Mapping (Super_Element (Source'Old, K))), + Global => null; --------------------------------------- -- String Transformation Subprograms -- @@ -339,48 +1423,756 @@ package Ada.Strings.Superbounded is Low : Positive; High : Natural; By : String; - Drop : Truncation := Error) return Super_String; + Drop : Truncation := Error) return Super_String + with + Pre => + Low - 1 <= Super_Length (Source) + and then + (if Drop = Error + then (if High >= Low + then Low - 1 + <= Source.Max_Length - By'Length + - Integer'Max (Super_Length (Source) - High, 0) + else Super_Length (Source) <= + Source.Max_Length - By'Length)), + Post => + Super_Replace_Slice'Result.Max_Length = Source.Max_Length, + Contract_Cases => + (Low - 1 <= Source.Max_Length - By'Length - Integer'Max + (Super_Length (Source) - Integer'Max (High, Low - 1), 0) + => + -- Total length is lower than Max_Length: nothing is dropped + + -- Note that if High < Low, the insertion is done before Low, so in + -- all cases the starting position of the slice of Source remaining + -- after the replaced Slice is Integer'Max (High + 1, Low). + + Super_Length (Super_Replace_Slice'Result) = + Low - 1 + By'Length + Integer'Max + (Super_Length (Source) - Integer'Max (High, Low - 1), 0) + and then + String'(Super_Slice (Super_Replace_Slice'Result, 1, Low - 1)) = + Super_Slice (Source, 1, Low - 1) + and then + Super_Slice (Super_Replace_Slice'Result, + Low, Low - 1 + By'Length) = By + and then + (if Integer'Max (High, Low - 1) < Super_Length (Source) then + String'(Super_Slice (Super_Replace_Slice'Result, + Low + By'Length, + Super_Length (Super_Replace_Slice'Result))) = + Super_Slice (Source, + Integer'Max (High + 1, Low), Super_Length (Source))), + + Low - 1 > Source.Max_Length - By'Length - Integer'Max + (Super_Length (Source) - Integer'Max (High, Low - 1), 0) + and then Drop = Left + => + -- Final_Super_Slice is the length of the slice of Source remaining + -- after the replaced part. + (declare + Final_Super_Slice : constant Natural := + Integer'Max + (Super_Length (Source) - Integer'Max (High, Low - 1), 0); + begin + -- The result is of maximal length and ends by the last + -- Final_Super_Slice characters of Source. + + Super_Length (Super_Replace_Slice'Result) = Source.Max_Length + and then + (if Final_Super_Slice > 0 then + String'(Super_Slice (Super_Replace_Slice'Result, + Source.Max_Length - Final_Super_Slice + 1, + Source.Max_Length)) = + Super_Slice (Source, + Integer'Max (High + 1, Low), Super_Length (Source))) + + -- Depending on when we reach Max_Length, either the first + -- part of Source is fully dropped and By is partly dropped, + -- or By is fully added and the first part of Source is partly + -- dropped. + + and then + (if Source.Max_Length - Final_Super_Slice - By'Length <= 0 then + + -- The first (possibly zero) characters of By are dropped + + (if Final_Super_Slice < Source.Max_Length then + Super_Slice (Super_Replace_Slice'Result, + 1, Source.Max_Length - Final_Super_Slice) = + By (By'Last - Source.Max_Length + Final_Super_Slice + + 1 + .. By'Last)) + + else -- By is added to the result + + Super_Slice (Super_Replace_Slice'Result, + Source.Max_Length - Final_Super_Slice - By'Length + 1, + Source.Max_Length - Final_Super_Slice) = + By + + -- The first characters of Source (1 .. Low - 1) are + -- dropped. + + and then + String'(Super_Slice (Super_Replace_Slice'Result, 1, + Source.Max_Length - Final_Super_Slice - By'Length)) = + Super_Slice (Source, + Low - Source.Max_Length + + Final_Super_Slice + By'Length, + Low - 1))), + + others -- Drop = Right + => + -- The result is of maximal length and starts by the first Low - 1 + -- characters of Source. + + Super_Length (Super_Replace_Slice'Result) = Source.Max_Length + and then + String'(Super_Slice (Super_Replace_Slice'Result, 1, Low - 1)) = + Super_Slice (Source, 1, Low - 1) + + -- Depending on when we reach Max_Length, either the last part + -- of Source is fully dropped and By is partly dropped, or By + -- is fully added and the last part of Source is partly dropped. + + and then + (if Low - 1 >= Source.Max_Length - By'Length then + + -- The last characters of By are dropped + + Super_Slice (Super_Replace_Slice'Result, + Low, Source.Max_Length) = + By (By'First .. Source.Max_Length - Low + By'First) + + else -- By is fully added + + Super_Slice (Super_Replace_Slice'Result, + Low, Low + By'Length - 1) = By + + -- Then Source starting from Natural'Max (High + 1, Low) + -- is added but the last characters are dropped. + + and then + String'(Super_Slice (Super_Replace_Slice'Result, + Low + By'Length, Source.Max_Length)) = + Super_Slice (Source, Integer'Max (High + 1, Low), + Integer'Max (High + 1, Low) + + (Source.Max_Length - Low - By'Length)))), + Global => null; procedure Super_Replace_Slice (Source : in out Super_String; Low : Positive; High : Natural; By : String; - Drop : Truncation := Error); + Drop : Truncation := Error) + with + Pre => + Low - 1 <= Super_Length (Source) + and then + (if Drop = Error + then (if High >= Low + then Low - 1 + <= Source.Max_Length - By'Length + - Natural'Max (Super_Length (Source) - High, 0) + else Super_Length (Source) <= + Source.Max_Length - By'Length)), + Contract_Cases => + (Low - 1 <= Source.Max_Length - By'Length - Integer'Max + (Super_Length (Source) - Integer'Max (High, Low - 1), 0) + => + -- Total length is lower than Max_Length: nothing is dropped + + -- Note that if High < Low, the insertion is done before Low, so in + -- all cases the starting position of the slice of Source remaining + -- after the replaced Slice is Integer'Max (High + 1, Low). + + Super_Length (Source) = Low - 1 + By'Length + Integer'Max + (Super_Length (Source'Old) - Integer'Max (High, Low - 1), 0) + and then + String'(Super_Slice (Source, 1, Low - 1)) = + Super_Slice (Source'Old, 1, Low - 1) + and then Super_Slice (Source, Low, Low - 1 + By'Length) = By + and then + (if Integer'Max (High, Low - 1) < Super_Length (Source'Old) then + String'(Super_Slice (Source, + Low + By'Length, Super_Length (Source))) = + Super_Slice (Source'Old, + Integer'Max (High + 1, Low), + Super_Length (Source'Old))), + + Low - 1 > Source.Max_Length - By'Length - Integer'Max + (Super_Length (Source) - Integer'Max (High, Low - 1), 0) + and then Drop = Left + => + -- Final_Super_Slice is the length of the slice of Source remaining + -- after the replaced part. + (declare + Final_Super_Slice : constant Natural := + Integer'Max (0, + Super_Length (Source'Old) - Integer'Max (High, Low - 1)); + begin + -- The result is of maximal length and ends by the last + -- Final_Super_Slice characters of Source. + + Super_Length (Source) = Source.Max_Length + and then + (if Final_Super_Slice > 0 then + String'(Super_Slice (Source, + Source.Max_Length - Final_Super_Slice + 1, + Source.Max_Length)) = + Super_Slice (Source'Old, + Integer'Max (High + 1, Low), + Super_Length (Source'Old))) + + -- Depending on when we reach Max_Length, either the first + -- part of Source is fully dropped and By is partly dropped, + -- or By is fully added and the first part of Source is partly + -- dropped. + + and then + (if Source.Max_Length - Final_Super_Slice - By'Length <= 0 + then + -- The first characters of By are dropped + + (if Final_Super_Slice < Source.Max_Length then + Super_Slice (Source, + 1, Source.Max_Length - Final_Super_Slice) = + By (By'Last - Source.Max_Length + Final_Super_Slice + + 1 + .. By'Last)) + + else -- By is added to the result + + Super_Slice (Source, + Source.Max_Length - Final_Super_Slice - By'Length + 1, + Source.Max_Length - Final_Super_Slice) = By + + -- The first characters of Source (1 .. Low - 1) are + -- dropped. + + and then + String'(Super_Slice (Source, 1, + Source.Max_Length - Final_Super_Slice - By'Length)) = + Super_Slice (Source'Old, + Low - Source.Max_Length + Final_Super_Slice + + By'Length, + Low - 1))), + + others -- Drop = Right + => + -- The result is of maximal length and starts by the first Low - 1 + -- characters of Source. + + Super_Length (Source) = Source.Max_Length + and then + String'(Super_Slice (Source, 1, Low - 1)) = + Super_Slice (Source'Old, 1, Low - 1) + + -- Depending on when we reach Max_Length, either the last part + -- of Source is fully dropped and By is partly dropped, or By + -- is fully added and the last part of Source is partly dropped. + + and then + (if Low - 1 >= Source.Max_Length - By'Length then + + -- The last characters of By are dropped + + Super_Slice (Source, Low, Source.Max_Length) = + By (By'First .. Source.Max_Length - Low + By'First) + + else -- By is fully added + + Super_Slice (Source, Low, Low + By'Length - 1) = By + + -- Then Source starting from Natural'Max (High + 1, Low) + -- is added but the last characters are dropped. + + and then + String'(Super_Slice (Source, + Low + By'Length, Source.Max_Length)) = + Super_Slice (Source'Old, Integer'Max (High + 1, Low), + Integer'Max (High + 1, Low) + + (Source.Max_Length - Low - By'Length)))), + Global => null; function Super_Insert (Source : Super_String; Before : Positive; New_Item : String; - Drop : Truncation := Error) return Super_String; + Drop : Truncation := Error) return Super_String + with + Pre => + Before - 1 <= Super_Length (Source) + and then + (if New_Item'Length > Source.Max_Length - Super_Length (Source) + then Drop /= Error), + Post => Super_Insert'Result.Max_Length = Source.Max_Length, + Contract_Cases => + (Super_Length (Source) <= Source.Max_Length - New_Item'Length + => + -- Total length is lower than Max_Length: nothing is dropped + + Super_Length (Super_Insert'Result) = + Super_Length (Source) + New_Item'Length + and then + String'(Super_Slice (Super_Insert'Result, 1, Before - 1)) = + Super_Slice (Source, 1, Before - 1) + and then + Super_Slice (Super_Insert'Result, + Before, Before - 1 + New_Item'Length) = + New_Item + and then + (if Before <= Super_Length (Source) then + String'(Super_Slice (Super_Insert'Result, + Before + New_Item'Length, + Super_Length (Super_Insert'Result))) = + Super_Slice (Source, Before, Super_Length (Source))), + + Super_Length (Source) > Source.Max_Length - New_Item'Length + and then Drop = Left + => + -- The result is of maximal length and ends by the last characters + -- of Source. + + Super_Length (Super_Insert'Result) = Source.Max_Length + and then + (if Before <= Super_Length (Source) then + String'(Super_Slice (Super_Insert'Result, + Source.Max_Length - Super_Length (Source) + Before, + Source.Max_Length)) = + Super_Slice (Source, Before, Super_Length (Source))) + + -- Depending on when we reach Max_Length, either the first part + -- of Source is fully dropped and New_Item is partly dropped, or + -- New_Item is fully added and the first part of Source is partly + -- dropped. + + and then + (if Source.Max_Length - Super_Length (Source) - 1 + Before + < New_Item'Length + then + -- The first characters of New_Item are dropped + + (if Super_Length (Source) - Before + 1 < Source.Max_Length + then + Super_Slice (Super_Insert'Result, 1, + Source.Max_Length - Super_Length (Source) - 1 + Before) = + New_Item + (New_Item'Last - Source.Max_Length + + Super_Length (Source) - Before + 2 + .. New_Item'Last)) + + else -- New_Item is added to the result + + Super_Slice (Super_Insert'Result, + Source.Max_Length - Super_Length (Source) - New_Item'Length + + Before, + Source.Max_Length - Super_Length (Source) - 1 + Before) = + New_Item + + -- The first characters of Source (1 .. Before - 1) are + -- dropped. + + and then + String'(Super_Slice (Super_Insert'Result, + 1, Source.Max_Length - Super_Length (Source) + - New_Item'Length - 1 + Before)) = + Super_Slice (Source, + Super_Length (Source) - Source.Max_Length + + New_Item'Length + 1, + Before - 1)), + + others -- Drop = Right + => + -- The result is of maximal length and starts by the first + -- characters of Source. + + Super_Length (Super_Insert'Result) = Source.Max_Length + and then + String'(Super_Slice (Super_Insert'Result, 1, Before - 1)) = + Super_Slice (Source, 1, Before - 1) + + -- Depending on when we reach Max_Length, either the last part + -- of Source is fully dropped and New_Item is partly dropped, or + -- New_Item is fully added and the last part of Source is partly + -- dropped. + + and then + (if Before - 1 >= Source.Max_Length - New_Item'Length then + + -- The last characters of New_Item are dropped + + Super_Slice (Super_Insert'Result, Before, Source.Max_Length) = + New_Item (New_Item'First + .. Source.Max_Length - Before + New_Item'First) + + else -- New_Item is fully added + + Super_Slice (Super_Insert'Result, + Before, Before + New_Item'Length - 1) = + New_Item + + -- Then Source starting from Before is added but the + -- last characters are dropped. + + and then + String'(Super_Slice (Super_Insert'Result, + Before + New_Item'Length, Source.Max_Length)) = + Super_Slice (Source, + Before, Source.Max_Length - New_Item'Length))), + Global => null; procedure Super_Insert (Source : in out Super_String; Before : Positive; New_Item : String; - Drop : Truncation := Error); + Drop : Truncation := Error) + with + Pre => + Before - 1 <= Super_Length (Source) + and then + (if New_Item'Length > Source.Max_Length - Super_Length (Source) + then Drop /= Error), + Contract_Cases => + (Super_Length (Source) <= Source.Max_Length - New_Item'Length + => + -- Total length is lower than Max_Length: nothing is dropped + + Super_Length (Source) = Super_Length (Source'Old) + New_Item'Length + and then + String'(Super_Slice (Source, 1, Before - 1)) = + Super_Slice (Source'Old, 1, Before - 1) + and then + Super_Slice (Source, Before, Before - 1 + New_Item'Length) = + New_Item + and then + (if Before <= Super_Length (Source'Old) then + String'(Super_Slice (Source, + Before + New_Item'Length, Super_Length (Source))) = + Super_Slice (Source'Old, + Before, Super_Length (Source'Old))), + + Super_Length (Source) > Source.Max_Length - New_Item'Length + and then Drop = Left + => + -- The result is of maximal length and ends by the last characters + -- of Source. + + Super_Length (Source) = Source.Max_Length + and then + (if Before <= Super_Length (Source'Old) then + String'(Super_Slice (Source, + Source.Max_Length - Super_Length (Source'Old) + Before, + Source.Max_Length)) = + Super_Slice (Source'Old, + Before, Super_Length (Source'Old))) + + -- Depending on when we reach Max_Length, either the first part + -- of Source is fully dropped and New_Item is partly dropped, or + -- New_Item is fully added and the first part of Source is partly + -- dropped. + + and then + (if Source.Max_Length - Super_Length (Source'Old) - 1 + Before + < New_Item'Length + then + -- The first characters of New_Item are dropped + + (if Super_Length (Source'Old) - Before + 1 < Source.Max_Length + then + Super_Slice (Source, + 1, Source.Max_Length - Super_Length (Source'Old) + - 1 + Before) = + New_Item + (New_Item'Last - Source.Max_Length + + Super_Length (Source'Old) - Before + 2 + .. New_Item'Last)) + + else -- New_Item is added to the result + + Super_Slice (Source, + Source.Max_Length - Super_Length (Source'Old) + - New_Item'Length + Before, + Source.Max_Length - Super_Length (Source'Old) - 1 + Before) + = New_Item + + -- The first characters of Source (1 .. Before - 1) are + -- dropped. + + and then + String'(Super_Slice (Source, 1, + Source.Max_Length - Super_Length (Source'Old) + - New_Item'Length - 1 + Before)) = + Super_Slice (Source'Old, + Super_Length (Source'Old) + - Source.Max_Length + New_Item'Length + 1, + Before - 1)), + + others -- Drop = Right + => + -- The result is of maximal length and starts by the first + -- characters of Source. + + Super_Length (Source) = Source.Max_Length + and then + String'(Super_Slice (Source, 1, Before - 1)) = + Super_Slice (Source'Old, 1, Before - 1) + + -- Depending on when we reach Max_Length, either the last part + -- of Source is fully dropped and New_Item is partly dropped, or + -- New_Item is fully added and the last part of Source is partly + -- dropped. + + and then + (if Before - 1 >= Source.Max_Length - New_Item'Length then + + -- The last characters of New_Item are dropped + + Super_Slice (Source, Before, Source.Max_Length) = + New_Item (New_Item'First + .. Source.Max_Length - Before + New_Item'First) + + else -- New_Item is fully added + + Super_Slice (Source, Before, Before + New_Item'Length - 1) = + New_Item + + -- Then Source starting from Before is added but the + -- last characters are dropped. + + and then + String'(Super_Slice (Source, + Before + New_Item'Length, Source.Max_Length)) = + Super_Slice (Source'Old, + Before, Source.Max_Length - New_Item'Length))), + Global => null; function Super_Overwrite (Source : Super_String; Position : Positive; New_Item : String; - Drop : Truncation := Error) return Super_String; + Drop : Truncation := Error) return Super_String + with + Pre => + Position - 1 <= Super_Length (Source) + and then (if New_Item'Length > Source.Max_Length - (Position - 1) + then Drop /= Error), + Post => Super_Overwrite'Result.Max_Length = Source.Max_Length, + Contract_Cases => + (Position - 1 <= Source.Max_Length - New_Item'Length + => + -- The length is unchanged, unless New_Item overwrites further than + -- the end of Source. In this contract case, we suppose New_Item + -- doesn't overwrite further than Max_Length. + + Super_Length (Super_Overwrite'Result) = + Integer'Max (Super_Length (Source), Position - 1 + New_Item'Length) + and then + String'(Super_Slice (Super_Overwrite'Result, 1, Position - 1)) = + Super_Slice (Source, 1, Position - 1) + and then Super_Slice (Super_Overwrite'Result, + Position, Position - 1 + New_Item'Length) = + New_Item + and then + (if Position - 1 + New_Item'Length < Super_Length (Source) then + + -- There are some unchanged characters of Source remaining + -- after New_Item. + + String'(Super_Slice (Super_Overwrite'Result, + Position + New_Item'Length, Super_Length (Source))) = + Super_Slice (Source, + Position + New_Item'Length, Super_Length (Source))), + + Position - 1 > Source.Max_Length - New_Item'Length and then Drop = Left + => + Super_Length (Super_Overwrite'Result) = Source.Max_Length + + -- If a part of the result has to be dropped, it means New_Item is + -- overwriting further than the end of Source. Thus the result is + -- necessarily ending by New_Item. However, we don't know whether + -- New_Item covers all Max_Length characters or some characters of + -- Source are remaining at the left. + + and then + (if New_Item'Length > Source.Max_Length then + + -- New_Item covers all Max_Length characters + + Super_To_String (Super_Overwrite'Result) = + New_Item + (New_Item'Last - Source.Max_Length + 1 .. New_Item'Last) + else + -- New_Item fully appears at the end + + Super_Slice (Super_Overwrite'Result, + Source.Max_Length - New_Item'Length + 1, + Source.Max_Length) = + New_Item + + -- The left of Source is cut + + and then + String'(Super_Slice (Super_Overwrite'Result, + 1, Source.Max_Length - New_Item'Length)) = + Super_Slice (Source, + Position - Source.Max_Length + New_Item'Length, + Position - 1)), + + others -- Drop = Right + => + -- The result is of maximal length and starts by the first + -- characters of Source. + + Super_Length (Super_Overwrite'Result) = Source.Max_Length + and then + String'(Super_Slice (Super_Overwrite'Result, 1, Position - 1)) = + Super_Slice (Source, 1, Position - 1) + + -- Then New_Item is written until Max_Length + + and then Super_Slice (Super_Overwrite'Result, + Position, Source.Max_Length) = + New_Item (New_Item'First + .. Source.Max_Length - Position + New_Item'First)), + Global => null; procedure Super_Overwrite (Source : in out Super_String; Position : Positive; New_Item : String; - Drop : Truncation := Error); + Drop : Truncation := Error) + with + Pre => + Position - 1 <= Super_Length (Source) + and then (if New_Item'Length > Source.Max_Length - (Position - 1) + then Drop /= Error), + Contract_Cases => + (Position - 1 <= Source.Max_Length - New_Item'Length + => + -- The length is unchanged, unless New_Item overwrites further than + -- the end of Source. In this contract case, we suppose New_Item + -- doesn't overwrite further than Max_Length. + + Super_Length (Source) = Integer'Max + (Super_Length (Source'Old), Position - 1 + New_Item'Length) + and then + String'(Super_Slice (Source, 1, Position - 1)) = + Super_Slice (Source'Old, 1, Position - 1) + and then Super_Slice (Source, + Position, Position - 1 + New_Item'Length) = + New_Item + and then + (if Position - 1 + New_Item'Length < Super_Length (Source'Old) + then + -- There are some unchanged characters of Source remaining + -- after New_Item. + + String'(Super_Slice (Source, + Position + New_Item'Length, Super_Length (Source'Old))) = + Super_Slice (Source'Old, + Position + New_Item'Length, Super_Length (Source'Old))), + + Position - 1 > Source.Max_Length - New_Item'Length and then Drop = Left + => + Super_Length (Source) = Source.Max_Length + + -- If a part of the result has to be dropped, it means New_Item is + -- overwriting further than the end of Source. Thus the result is + -- necessarily ending by New_Item. However, we don't know whether + -- New_Item covers all Max_Length characters or some characters of + -- Source are remaining at the left. + + and then + (if New_Item'Length > Source.Max_Length then + + -- New_Item covers all Max_Length characters + + Super_To_String (Source) = + New_Item + (New_Item'Last - Source.Max_Length + 1 .. New_Item'Last) + else + -- New_Item fully appears at the end + + Super_Slice (Source, + Source.Max_Length - New_Item'Length + 1, + Source.Max_Length) = + New_Item + + -- The left of Source is cut + + and then + String'(Super_Slice (Source, + 1, Source.Max_Length - New_Item'Length)) = + Super_Slice (Source'Old, + Position - Source.Max_Length + New_Item'Length, + Position - 1)), + + others -- Drop = Right + => + -- The result is of maximal length and starts by the first + -- characters of Source. + + Super_Length (Source) = Source.Max_Length + and then + String'(Super_Slice (Source, 1, Position - 1)) = + Super_Slice (Source'Old, 1, Position - 1) + + -- New_Item is written until Max_Length + + and then Super_Slice (Source, Position, Source.Max_Length) = + New_Item (New_Item'First + .. Source.Max_Length - Position + New_Item'First)), + Global => null; function Super_Delete (Source : Super_String; From : Positive; - Through : Natural) return Super_String; + Through : Natural) return Super_String + with + Pre => + (if Through >= From then From - 1 <= Super_Length (Source)), + Post => Super_Delete'Result.Max_Length = Source.Max_Length, + Contract_Cases => + (Through >= From => + Super_Length (Super_Delete'Result) = + From - 1 + Natural'Max (Super_Length (Source) - Through, 0) + and then + String'(Super_Slice (Super_Delete'Result, 1, From - 1)) = + Super_Slice (Source, 1, From - 1) + and then + (if Through < Super_Length (Source) then + String'(Super_Slice (Super_Delete'Result, + From, Super_Length (Super_Delete'Result))) = + Super_Slice (Source, Through + 1, Super_Length (Source))), + others => + Super_Delete'Result = Source), + Global => null; procedure Super_Delete (Source : in out Super_String; From : Positive; - Through : Natural); + Through : Natural) + with + Pre => + (if Through >= From then From - 1 <= Super_Length (Source)), + Contract_Cases => + (Through >= From => + Super_Length (Source) = + From - 1 + Natural'Max (Super_Length (Source'Old) - Through, 0) + and then + String'(Super_Slice (Source, 1, From - 1)) = + Super_Slice (Source'Old, 1, From - 1) + and then + (if Through < Super_Length (Source) then + String'(Super_Slice (Source, From, Super_Length (Source))) = + Super_Slice (Source'Old, + Through + 1, Super_Length (Source'Old))), + others => + Source = Source'Old), + Global => null; --------------------------------- -- String Selector Subprograms -- @@ -388,45 +2180,376 @@ package Ada.Strings.Superbounded is function Super_Trim (Source : Super_String; - Side : Trim_End) return Super_String; + Side : Trim_End) return Super_String + with + Post => Super_Trim'Result.Max_Length = Source.Max_Length, + Contract_Cases => + + -- If all characters in Source are Space, the returned string is empty + + ((for all C of Super_To_String (Source) => C = ' ') + => + Super_Length (Super_Trim'Result) = 0, + + -- Otherwise, the returned string is a slice of Source + + others + => + (declare + Low : constant Positive := + (if Side = Right then 1 + else Super_Index_Non_Blank (Source, Forward)); + High : constant Positive := + (if Side = Left then Super_Length (Source) + else Super_Index_Non_Blank (Source, Backward)); + begin + Super_To_String (Super_Trim'Result) = + Super_Slice (Source, Low, High))), + Global => null; procedure Super_Trim (Source : in out Super_String; - Side : Trim_End); + Side : Trim_End) + with + Contract_Cases => + + -- If all characters in Source are Space, the returned string is empty + + ((for all C of Super_To_String (Source) => C = ' ') + => + Super_Length (Source) = 0, + + -- Otherwise, the returned string is a slice of Source + + others + => + (declare + Low : constant Positive := + (if Side = Right then 1 + else Super_Index_Non_Blank (Source'Old, Forward)); + High : constant Positive := + (if Side = Left then Super_Length (Source'Old) + else Super_Index_Non_Blank (Source'Old, Backward)); + begin + Super_To_String (Source) = Super_Slice (Source'Old, Low, High))), + Global => null; function Super_Trim (Source : Super_String; Left : Maps.Character_Set; - Right : Maps.Character_Set) return Super_String; + Right : Maps.Character_Set) return Super_String + with + Post => Super_Trim'Result.Max_Length = Source.Max_Length, + Contract_Cases => + + -- If all characters in Source are contained in one of the sets Left or + -- Right, then the returned string is empty. + + ((for all C of Super_To_String (Source) => Maps.Is_In (C, Left)) + or else + (for all C of Super_To_String (Source) => Maps.Is_In (C, Right)) + => + Super_Length (Super_Trim'Result) = 0, + + -- Otherwise, the returned string is a slice of Source + + others + => + (declare + Low : constant Positive := + Super_Index (Source, Left, Outside, Forward); + High : constant Positive := + Super_Index (Source, Right, Outside, Backward); + begin + Super_To_String (Super_Trim'Result) = + Super_Slice (Source, Low, High))), + Global => null; procedure Super_Trim (Source : in out Super_String; Left : Maps.Character_Set; - Right : Maps.Character_Set); + Right : Maps.Character_Set) + with + Contract_Cases => + + -- If all characters in Source are contained in one of the sets Left or + -- Right, then the returned string is empty. + + ((for all C of Super_To_String (Source) => Maps.Is_In (C, Left)) + or else + (for all C of Super_To_String (Source) => Maps.Is_In (C, Right)) + => + Super_Length (Source) = 0, + + -- Otherwise, the returned string is a slice of Source + + others + => + (declare + Low : constant Positive := + Super_Index (Source'Old, Left, Outside, Forward); + High : constant Positive := + Super_Index (Source'Old, Right, Outside, Backward); + begin + Super_To_String (Source) = Super_Slice (Source'Old, Low, High))), + Global => null; function Super_Head (Source : Super_String; Count : Natural; Pad : Character := Space; - Drop : Truncation := Error) return Super_String; + Drop : Truncation := Error) return Super_String + with + Pre => (if Count > Source.Max_Length then Drop /= Error), + Post => Super_Head'Result.Max_Length = Source.Max_Length, + Contract_Cases => + (Count <= Super_Length (Source) + => + -- Source is cut + + Super_To_String (Super_Head'Result) = Super_Slice (Source, 1, Count), + Count > Super_Length (Source) and then Count <= Source.Max_Length + => + -- Source is followed by Pad characters + + Super_Length (Super_Head'Result) = Count + and then + Super_Slice (Super_Head'Result, 1, Super_Length (Source)) = + Super_To_String (Source) + and then + String'(Super_Slice (Super_Head'Result, + Super_Length (Source) + 1, Count)) = + (1 .. Count - Super_Length (Source) => Pad), + Count > Source.Max_Length and then Drop = Right + => + -- Source is followed by Pad characters + + Super_Length (Super_Head'Result) = Source.Max_Length + and then + Super_Slice (Super_Head'Result, 1, Super_Length (Source)) = + Super_To_String (Source) + and then + String'(Super_Slice (Super_Head'Result, + Super_Length (Source) + 1, Source.Max_Length)) = + (1 .. Source.Max_Length - Super_Length (Source) => Pad), + Count - Super_Length (Source) > Source.Max_Length and then Drop = Left + => + -- Source is fully dropped on the left + + Super_To_String (Super_Head'Result) = + (1 .. Source.Max_Length => Pad), + others + => + -- Source is partly dropped on the left + + Super_Length (Super_Head'Result) = Source.Max_Length + and then + String'(Super_Slice (Super_Head'Result, + 1, Source.Max_Length - Count + Super_Length (Source))) = + Super_Slice (Source, + Count - Source.Max_Length + 1, Super_Length (Source)) + and then + String'(Super_Slice (Super_Head'Result, + Source.Max_Length - Count + Super_Length (Source) + 1, + Source.Max_Length)) = + (1 .. Count - Super_Length (Source) => Pad)), + Global => null; procedure Super_Head (Source : in out Super_String; Count : Natural; Pad : Character := Space; - Drop : Truncation := Error); + Drop : Truncation := Error) + with + Pre => (if Count > Source.Max_Length then Drop /= Error), + Contract_Cases => + (Count <= Super_Length (Source) + => + -- Source is cut + + Super_To_String (Source) = Super_Slice (Source'Old, 1, Count), + Count > Super_Length (Source) and then Count <= Source.Max_Length + => + -- Source is followed by Pad characters + + Super_Length (Source) = Count + and then + Super_Slice (Source, 1, Super_Length (Source'Old)) = + Super_To_String (Source'Old) + and then + String'(Super_Slice (Source, + Super_Length (Source'Old) + 1, Count)) = + (1 .. Count - Super_Length (Source'Old) => Pad), + Count > Source.Max_Length and then Drop = Right + => + -- Source is followed by Pad characters + + Super_Length (Source) = Source.Max_Length + and then + Super_Slice (Source, 1, Super_Length (Source'Old)) = + Super_To_String (Source'Old) + and then + String'(Super_Slice (Source, + Super_Length (Source'Old) + 1, Source.Max_Length)) = + (1 .. Source.Max_Length - Super_Length (Source'Old) => Pad), + Count - Super_Length (Source) > Source.Max_Length and then Drop = Left + => + -- Source is fully dropped on the left + + Super_To_String (Source) = (1 .. Source.Max_Length => Pad), + others + => + -- Source is partly dropped on the left + + Super_Length (Source) = Source.Max_Length + and then + String'(Super_Slice (Source, + 1, Source.Max_Length - Count + Super_Length (Source'Old))) = + Super_Slice (Source'Old, + Count - Source.Max_Length + 1, Super_Length (Source'Old)) + and then + String'(Super_Slice (Source, + Source.Max_Length - Count + Super_Length (Source'Old) + 1, + Source.Max_Length)) = + (1 .. Count - Super_Length (Source'Old) => Pad)), + Global => null; function Super_Tail (Source : Super_String; Count : Natural; Pad : Character := Space; - Drop : Truncation := Error) return Super_String; + Drop : Truncation := Error) return Super_String + with + Pre => (if Count > Source.Max_Length then Drop /= Error), + Post => Super_Tail'Result.Max_Length = Source.Max_Length, + Contract_Cases => + (Count < Super_Length (Source) + => + -- Source is cut + + (if Count > 0 then + Super_To_String (Super_Tail'Result) = + Super_Slice (Source, + Super_Length (Source) - Count + 1, Super_Length (Source)) + else Super_Length (Super_Tail'Result) = 0), + Count >= Super_Length (Source) and then Count < Source.Max_Length + => + -- Source is preceded by Pad characters + + Super_Length (Super_Tail'Result) = Count + and then + String'(Super_Slice (Super_Tail'Result, + 1, Count - Super_Length (Source))) = + (1 .. Count - Super_Length (Source) => Pad) + and then + Super_Slice (Super_Tail'Result, + Count - Super_Length (Source) + 1, Count) = + Super_To_String (Source), + Count >= Source.Max_Length and then Drop = Left + => + -- Source is preceded by Pad characters + + Super_Length (Super_Tail'Result) = Source.Max_Length + and then + String'(Super_Slice (Super_Tail'Result, + 1, Source.Max_Length - Super_Length (Source))) = + (1 .. Source.Max_Length - Super_Length (Source) => Pad) + and then + (if Super_Length (Source) > 0 then + Super_Slice (Super_Tail'Result, + Source.Max_Length - Super_Length (Source) + 1, + Source.Max_Length) = + Super_To_String (Source)), + Count - Super_Length (Source) >= Source.Max_Length + and then Drop /= Left + => + -- Source is fully dropped on the right + + Super_To_String (Super_Tail'Result) = + (1 .. Source.Max_Length => Pad), + others + => + -- Source is partly dropped on the right + + Super_Length (Super_Tail'Result) = Source.Max_Length + and then + String'(Super_Slice (Super_Tail'Result, + 1, Count - Super_Length (Source))) = + (1 .. Count - Super_Length (Source) => Pad) + and then + String'(Super_Slice (Super_Tail'Result, + Count - Super_Length (Source) + 1, Source.Max_Length)) = + Super_Slice (Source, + 1, Source.Max_Length - Count + Super_Length (Source))), + Global => null; procedure Super_Tail (Source : in out Super_String; Count : Natural; Pad : Character := Space; - Drop : Truncation := Error); + Drop : Truncation := Error) + with + Pre => (if Count > Source.Max_Length then Drop /= Error), + Contract_Cases => + (Count < Super_Length (Source) + => + -- Source is cut + + (if Count > 0 then + Super_To_String (Source) = + Super_Slice (Source'Old, + Super_Length (Source'Old) - Count + 1, + Super_Length (Source'Old)) + else Super_Length (Source) = 0), + Count >= Super_Length (Source) and then Count < Source.Max_Length + => + -- Source is preceded by Pad characters + + Super_Length (Source) = Count + and then + String'(Super_Slice (Source, + 1, Count - Super_Length (Source'Old))) = + (1 .. Count - Super_Length (Source'Old) => Pad) + and then + Super_Slice (Source, + Count - Super_Length (Source'Old) + 1, Count) = + Super_To_String (Source'Old), + Count >= Source.Max_Length and then Drop = Left + => + -- Source is preceded by Pad characters + + Super_Length (Source) = Source.Max_Length + and then + String'(Super_Slice (Source, + 1, Source.Max_Length - Super_Length (Source'Old))) = + (1 .. Source.Max_Length - Super_Length (Source'Old) => Pad) + and then + (if Super_Length (Source'Old) > 0 then + Super_Slice (Source, + Source.Max_Length - Super_Length (Source'Old) + 1, + Source.Max_Length) = + Super_To_String (Source'Old)), + Count - Super_Length (Source) >= Source.Max_Length + and then Drop /= Left + => + -- Source is fully dropped on the right + + Super_To_String (Source) = (1 .. Source.Max_Length => Pad), + others + => + -- Source is partly dropped on the right + + Super_Length (Source) = Source.Max_Length + and then + String'(Super_Slice (Source, + 1, Count - Super_Length (Source'Old))) = + (1 .. Count - Super_Length (Source'Old) => Pad) + and then + String'(Super_Slice (Source, + Count - Super_Length (Source'Old) + 1, Source.Max_Length)) = + Super_Slice (Source'Old, + 1, Source.Max_Length - Count + Super_Length (Source'Old))), + Global => null; ------------------------------------ -- String Constructor Subprograms -- @@ -439,37 +2562,135 @@ package Ada.Strings.Superbounded is function Times (Left : Natural; Right : Character; - Max_Length : Positive) return Super_String; + Max_Length : Positive) return Super_String + with + Pre => Left <= Max_Length, + Post => Times'Result.Max_Length = Max_Length + and then Super_To_String (Times'Result) = (1 .. Left => Right), + Global => null; -- Note the additional parameter Max_Length function Times (Left : Natural; Right : String; - Max_Length : Positive) return Super_String; + Max_Length : Positive) return Super_String + with + Pre => (if Left /= 0 then Right'Length <= Max_Length / Left), + Post => Times'Result.Max_Length = Max_Length + and then Super_Length (Times'Result) = Left * Right'Length + and then + (if Right'Length > 0 then + (for all K in 1 .. Left * Right'Length => + Super_Element (Times'Result, K) = + Right (Right'First + (K - 1) mod Right'Length))), + Global => null; -- Note the additional parameter Max_Length function Times (Left : Natural; - Right : Super_String) return Super_String; + Right : Super_String) return Super_String + with + Pre => + (if Left /= 0 then Super_Length (Right) <= Right.Max_Length / Left), + Post => Times'Result.Max_Length = Right.Max_Length + and then Super_Length (Times'Result) = Left * Super_Length (Right) + and then + (if Super_Length (Right) > 0 then + (for all K in 1 .. Left * Super_Length (Right) => + Super_Element (Times'Result, K) = + Super_Element (Right, 1 + (K - 1) mod Super_Length (Right)))), + Global => null; function Super_Replicate (Count : Natural; Item : Character; Drop : Truncation := Error; - Max_Length : Positive) return Super_String; + Max_Length : Positive) return Super_String + with + Pre => (if Count > Max_Length then Drop /= Error), + Post => Super_Replicate'Result.Max_Length = Max_Length + and then Super_To_String (Super_Replicate'Result) = + (1 .. Natural'Min (Max_Length, Count) => Item), + Global => null; -- Note the additional parameter Max_Length function Super_Replicate (Count : Natural; Item : String; Drop : Truncation := Error; - Max_Length : Positive) return Super_String; + Max_Length : Positive) return Super_String + with + Pre => + (if Count /= 0 and then Item'Length > Max_Length / Count + then Drop /= Error), + Post => Super_Replicate'Result.Max_Length = Max_Length, + Contract_Cases => + (Count = 0 or else Item'Length <= Max_Length / Count + => + Super_Length (Super_Replicate'Result) = Count * Item'Length + and then + (if Item'Length > 0 then + (for all K in 1 .. Count * Item'Length => + Super_Element (Super_Replicate'Result, K) = + Item (Item'First + (K - 1) mod Item'Length))), + Count /= 0 + and then Item'Length > Max_Length / Count + and then Drop = Right + => + Super_Length (Super_Replicate'Result) = Max_Length + and then + (for all K in 1 .. Max_Length => + Super_Element (Super_Replicate'Result, K) = + Item (Item'First + (K - 1) mod Item'Length)), + others -- Drop = Left + => + Super_Length (Super_Replicate'Result) = Max_Length + and then + (for all K in 1 .. Max_Length => + Super_Element (Super_Replicate'Result, K) = + Item (Item'Last - (Max_Length - K) mod Item'Length))), + Global => null; -- Note the additional parameter Max_Length function Super_Replicate (Count : Natural; Item : Super_String; - Drop : Truncation := Error) return Super_String; + Drop : Truncation := Error) return Super_String + with + Pre => + (if Count /= 0 + and then Super_Length (Item) > Item.Max_Length / Count + then Drop /= Error), + Post => Super_Replicate'Result.Max_Length = Item.Max_Length, + Contract_Cases => + ((if Count /= 0 then Super_Length (Item) <= Item.Max_Length / Count) + => + Super_Length (Super_Replicate'Result) = Count * Super_Length (Item) + and then + (if Super_Length (Item) > 0 then + (for all K in 1 .. Count * Super_Length (Item) => + Super_Element (Super_Replicate'Result, K) = + Super_Element (Item, + 1 + (K - 1) mod Super_Length (Item)))), + Count /= 0 + and then Super_Length (Item) > Item.Max_Length / Count + and then Drop = Right + => + Super_Length (Super_Replicate'Result) = Item.Max_Length + and then + (for all K in 1 .. Item.Max_Length => + Super_Element (Super_Replicate'Result, K) = + Super_Element (Item, 1 + (K - 1) mod Super_Length (Item))), + others -- Drop = Left + => + Super_Length (Super_Replicate'Result) = Item.Max_Length + and then + (for all K in 1 .. Item.Max_Length => + Super_Element (Super_Replicate'Result, K) = + Super_Element (Item, + Super_Length (Item) + - (Item.Max_Length - K) mod Super_Length (Item)))), + Global => null; private -- Pragma Inline declarations diff --git a/gcc/ada/libgnat/a-strunb.ads b/gcc/ada/libgnat/a-strunb.ads index 13c7612..b3050fd 100644 --- a/gcc/ada/libgnat/a-strunb.ads +++ b/gcc/ada/libgnat/a-strunb.ads @@ -53,11 +53,13 @@ private with Ada.Strings.Text_Buffers; -- and selector operations are provided. package Ada.Strings.Unbounded with + SPARK_Mode, Initial_Condition => Length (Null_Unbounded_String) = 0 is pragma Preelaborate; - type Unbounded_String is private; + type Unbounded_String is private with + Default_Initial_Condition => Length (Unbounded_String) = 0; pragma Preelaborable_Initialization (Unbounded_String); Null_Unbounded_String : constant Unbounded_String; @@ -73,7 +75,7 @@ is -- Provides a (nonprivate) access type for explicit processing of -- unbounded-length strings. - procedure Free (X : in out String_Access); + procedure Free (X : in out String_Access) with SPARK_Mode => Off; -- Performs an unchecked deallocation of an object of type String_Access -------------------------------------------------------- @@ -732,6 +734,8 @@ is -- strings applied to the string represented by Source's original value. private + pragma SPARK_Mode (Off); -- Controlled types are not in SPARK + pragma Inline (Length); package AF renames Ada.Finalization; diff --git a/gcc/ada/libgnat/a-strunb__shared.ads b/gcc/ada/libgnat/a-strunb__shared.ads index 2091bde..2cf6780 100644 --- a/gcc/ada/libgnat/a-strunb__shared.ads +++ b/gcc/ada/libgnat/a-strunb__shared.ads @@ -85,7 +85,8 @@ package Ada.Strings.Unbounded with is pragma Preelaborate; - type Unbounded_String is private; + type Unbounded_String is private with + Default_Initial_Condition => Length (Unbounded_String) = 0; pragma Preelaborable_Initialization (Unbounded_String); Null_Unbounded_String : constant Unbounded_String; diff --git a/gcc/ada/libgnat/a-textio.adb b/gcc/ada/libgnat/a-textio.adb index 717f529..8667360 100644 --- a/gcc/ada/libgnat/a-textio.adb +++ b/gcc/ada/libgnat/a-textio.adb @@ -44,6 +44,7 @@ pragma Elaborate_All (System.File_IO); -- Needed because of calls to Chain_File in package body elaboration package body Ada.Text_IO with + SPARK_Mode => Off, Refined_State => (File_System => (Standard_In, Standard_Out, Standard_Err, diff --git a/gcc/ada/libgnat/a-textio.ads b/gcc/ada/libgnat/a-textio.ads index a06a35c..f94c92d 100644 --- a/gcc/ada/libgnat/a-textio.ads +++ b/gcc/ada/libgnat/a-textio.ads @@ -56,8 +56,9 @@ with System.File_Control_Block; with System.WCh_Con; package Ada.Text_IO with - Abstract_State => (File_System), - Initializes => (File_System), + SPARK_Mode, + Abstract_State => File_System, + Initializes => File_System, Initial_Condition => Line_Length = 0 and Page_Length = 0 is pragma Elaborate_Body; @@ -547,6 +548,7 @@ is Layout_Error : exception renames IO_Exceptions.Layout_Error; private + pragma SPARK_Mode (Off); -- The following procedures have a File_Type formal of mode IN OUT because -- they may close the original file. The Close operation may raise an diff --git a/gcc/ada/libgnat/a-zchhan.adb b/gcc/ada/libgnat/a-zchhan.adb index 3f2a91b..61405f7 100644 --- a/gcc/ada/libgnat/a-zchhan.adb +++ b/gcc/ada/libgnat/a-zchhan.adb @@ -33,6 +33,15 @@ with Ada.Wide_Wide_Characters.Unicode; use Ada.Wide_Wide_Characters.Unicode; package body Ada.Wide_Wide_Characters.Handling is + --------------------------- + -- Character_Set_Version -- + --------------------------- + + function Character_Set_Version return String is + begin + return "Unicode 4.0"; + end Character_Set_Version; + --------------------- -- Is_Alphanumeric -- --------------------- @@ -42,6 +51,13 @@ package body Ada.Wide_Wide_Characters.Handling is return Is_Letter (Item) or else Is_Digit (Item); end Is_Alphanumeric; + -------------- + -- Is_Basic -- + -------------- + + function Is_Basic (Item : Wide_Wide_Character) return Boolean + renames Ada.Wide_Wide_Characters.Unicode.Is_Basic; + ---------------- -- Is_Control -- ---------------- @@ -191,4 +207,22 @@ package body Ada.Wide_Wide_Characters.Handling is return Result; end To_Upper; + -------------- + -- To_Basic -- + -------------- + + function To_Basic (Item : Wide_Wide_Character) return Wide_Wide_Character + renames Ada.Wide_Wide_Characters.Unicode.To_Basic; + + function To_Basic (Item : Wide_Wide_String) return Wide_Wide_String is + Result : Wide_Wide_String (Item'Range); + + begin + for J in Result'Range loop + Result (J) := To_Basic (Item (J)); + end loop; + + return Result; + end To_Basic; + end Ada.Wide_Wide_Characters.Handling; diff --git a/gcc/ada/libgnat/a-zchhan.ads b/gcc/ada/libgnat/a-zchhan.ads index 74fab2a..6ebd1a8 100644 --- a/gcc/ada/libgnat/a-zchhan.ads +++ b/gcc/ada/libgnat/a-zchhan.ads @@ -15,10 +15,12 @@ package Ada.Wide_Wide_Characters.Handling is pragma Pure; - -- This package is clearly intended to be Pure, by analogy with the - -- base Ada.Characters.Handling package. The version in the RM does - -- not yet have this pragma, but that is a clear omission. This will - -- be fixed in a future version of AI05-0266-1. + + function Character_Set_Version return String; + pragma Inline (Character_Set_Version); + -- Returns an implementation-defined identifier that identifies the version + -- of the character set standard that is used for categorizing characters + -- by the implementation. For GNAT this is "Unicode v.v". function Is_Control (Item : Wide_Wide_Character) return Boolean; pragma Inline (Is_Control); @@ -42,6 +44,12 @@ package Ada.Wide_Wide_Characters.Handling is -- Returns True if the Wide_Wide_Character designated by Item is -- categorized as letter_uppercase, otherwise returns false. + function Is_Basic (Item : Wide_Wide_Character) return Boolean; + pragma Inline (Is_Basic); + -- Returns True if the Wide_Wide_Character designated by Item has no + -- Decomposition Mapping in the code charts of ISO/IEC 10646:2017, + -- otherwise returns False. + function Is_Digit (Item : Wide_Wide_Character) return Boolean; pragma Inline (Is_Digit); -- Returns True if the Wide_Wide_Character designated by Item is @@ -135,4 +143,17 @@ package Ada.Wide_Wide_Characters.Handling is -- designated by Item. The result is the null Wide_Wide_String if the value -- of the formal parameter is the null Wide_Wide_String. + function To_Basic (Item : Wide_Wide_Character) return Wide_Wide_Character; + pragma Inline (To_Basic); + -- Returns the Wide_Wide_Character whose code point is given + -- by the first value of its Decomposition Mapping in the code charts + -- of ISO/IEC 10646:2017 if any, returns Item otherwise. + + function To_Basic (Item : Wide_Wide_String) return Wide_Wide_String; + -- Returns the result of applying the To_Basic conversion to each + -- Wide_Wide_Character element of the Wide_Wide_String designated by Item. + -- The result is the null Wide_Wide_String if the value of the formal + -- parameter is the null Wide_Wide_String. The lower bound of the result + -- Wide_Wide_String is 1. + end Ada.Wide_Wide_Characters.Handling; diff --git a/gcc/ada/libgnat/a-zchuni.adb b/gcc/ada/libgnat/a-zchuni.adb index 2bbe584..3c6e720 100644 --- a/gcc/ada/libgnat/a-zchuni.adb +++ b/gcc/ada/libgnat/a-zchuni.adb @@ -43,6 +43,15 @@ package body Ada.Wide_Wide_Characters.Unicode is end Get_Category; -------------- + -- Is_Basic -- + -------------- + + function Is_Basic (U : Wide_Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Basic (Wide_Wide_Character'Pos (U)); + end Is_Basic; + + -------------- -- Is_Digit -- -------------- @@ -158,6 +167,16 @@ package body Ada.Wide_Wide_Characters.Unicode is return G.Is_UTF_32_Space (G.Category (C)); end Is_Space; + -------------- + -- To_Basic -- + -------------- + + function To_Basic (U : Wide_Wide_Character) return Wide_Wide_Character is + begin + return Wide_Wide_Character'Val + (G.UTF_32_To_Basic (Wide_Wide_Character'Pos (U))); + end To_Basic; + ------------------- -- To_Lower_Case -- ------------------- diff --git a/gcc/ada/libgnat/a-zchuni.ads b/gcc/ada/libgnat/a-zchuni.ads index 51f7c92..0030fd1 100644 --- a/gcc/ada/libgnat/a-zchuni.ads +++ b/gcc/ada/libgnat/a-zchuni.ads @@ -177,6 +177,18 @@ package Ada.Wide_Wide_Characters.Unicode is -- in the list of categories above. This means that these characters can -- be included in character and string literals. + function Is_Basic (U : Wide_Wide_Character) return Boolean; + pragma Inline (Is_Basic); + -- Returns True if the Wide_Wide_Character designated by Item has no + -- Decomposition Mapping in the code charts of ISO/IEC 10646:2017, + -- otherwise returns False. + + function To_Basic (U : Wide_Wide_Character) return Wide_Wide_Character; + pragma Inline (To_Basic); + -- Returns the Wide_Wide_Character whose code point is given by the first + -- value of its Decomposition Mapping in the code charts of + -- ISO/IEC 10646:2017 if any, returns Item otherwise. + -- The following function is used to fold to upper case, as required by -- the Ada 2005 standard rules for identifier case folding. Two -- identifiers are equivalent if they are identical after folding all diff --git a/gcc/ada/libgnat/g-forstr.adb b/gcc/ada/libgnat/g-forstr.adb index 64c4cb6..04539be 100644 --- a/gcc/ada/libgnat/g-forstr.adb +++ b/gcc/ada/libgnat/g-forstr.adb @@ -420,11 +420,11 @@ package body GNAT.Formatted_String is -- Zero padding if required and possible - if F_Spec.Left_Justify = False + if not F_Spec.Left_Justify and then F_Spec.Zero_Pad and then F_Spec.Width > Len + Value'First - S then - Append (Res, String'((F_Spec.Width - Len + Value'First - S) * '0')); + Append (Res, String'((F_Spec.Width - (Len + Value'First - S)) * '0')); end if; -- Add the value now @@ -519,7 +519,7 @@ package body GNAT.Formatted_String is J := J + 1; end loop; - if F (J) /= '%' or else J = F'Last then + if J >= F'Last or else F (J) /= '%' then raise Format_Error with "no format specifier found for parameter" & Positive'Image (Format.D.Current); end if; diff --git a/gcc/ada/libgnat/i-vxwork.ads b/gcc/ada/libgnat/i-vxwork.ads index c5686bb..0ba1e6e 100644 --- a/gcc/ada/libgnat/i-vxwork.ads +++ b/gcc/ada/libgnat/i-vxwork.ads @@ -133,6 +133,9 @@ package Interfaces.VxWorks is OK : constant STATUS := 0; ERROR : constant STATUS := -1; + type BOOL is new int; + -- Equivalent of the C type BOOL + type VOIDFUNCPTR is access procedure (parameter : System.Address); type Interrupt_Vector is new System.Address; type Exception_Vector is new System.Address; @@ -145,9 +148,9 @@ package Interfaces.VxWorks is -- The routine generates a wrapper around the user handler to save and -- restore context - function intContext return int; - -- Binding to the C routine intContext. This function returns 1 only if the - -- current execution state is in interrupt context. + function intContext return BOOL; + -- Binding to the C routine intContext. This function returns 1 (TRUE) + -- only if the current execution state is in interrupt context. function intVecGet (Vector : Interrupt_Vector) return VOIDFUNCPTR; diff --git a/gcc/ada/libgnat/i-vxwork__x86.ads b/gcc/ada/libgnat/i-vxwork__x86.ads index ed9bb42..659167f 100644 --- a/gcc/ada/libgnat/i-vxwork__x86.ads +++ b/gcc/ada/libgnat/i-vxwork__x86.ads @@ -128,6 +128,9 @@ package Interfaces.VxWorks is OK : constant STATUS := 0; ERROR : constant STATUS := -1; + type BOOL is new int; + -- Equivalent of the C type BOOL + type VOIDFUNCPTR is access procedure (parameter : System.Address); type Interrupt_Vector is new System.Address; type Exception_Vector is new System.Address; @@ -140,9 +143,9 @@ package Interfaces.VxWorks is -- The routine generates a wrapper around the user handler to save and -- restore context - function intContext return int; - -- Binding to the C routine intContext. This function returns 1 only if the - -- current execution state is in interrupt context. + function intContext return BOOL; + -- Binding to the C routine intContext. This function returns 1 (TRUE) + -- only if the current execution state is in interrupt context. function intVecGet (Vector : Interrupt_Vector) return VOIDFUNCPTR; diff --git a/gcc/ada/libgnat/memtrack.adb b/gcc/ada/libgnat/memtrack.adb index e622fec..b34ac04 100644 --- a/gcc/ada/libgnat/memtrack.adb +++ b/gcc/ada/libgnat/memtrack.adb @@ -69,10 +69,13 @@ pragma Source_File_Name (System.Memory, Body_File_Name => "memtrack.adb"); with Ada.Exceptions; +with GNAT.IO; + with System.Soft_Links; with System.Traceback; with System.Traceback_Entries; -with GNAT.IO; +with System.CRTL; +with System.OS_Lib; with System.OS_Primitives; package body System.Memory is @@ -93,30 +96,14 @@ package body System.Memory is (Ptr : System.Address; Size : size_t) return System.Address; pragma Import (C, c_realloc, "realloc"); - subtype File_Ptr is System.Address; - - function fopen (Path : String; Mode : String) return File_Ptr; - pragma Import (C, fopen); - - procedure OS_Exit (Status : Integer); - pragma Import (C, OS_Exit, "__gnat_os_exit"); - pragma No_Return (OS_Exit); - In_Child_After_Fork : Integer; pragma Import (C, In_Child_After_Fork, "__gnat_in_child_after_fork"); - procedure fwrite - (Ptr : System.Address; - Size : size_t; - Nmemb : size_t; - Stream : File_Ptr); - pragma Import (C, fwrite); + subtype File_Ptr is CRTL.FILEs; - procedure fputc (C : Integer; Stream : File_Ptr); - pragma Import (C, fputc); + procedure Write (Ptr : System.Address; Size : size_t); - procedure fclose (Stream : File_Ptr); - pragma Import (C, fclose); + procedure Putc (Char : Character); procedure Finalize; pragma Export (C, Finalize, "__gnat_finalize"); @@ -210,20 +197,17 @@ package body System.Memory is Timestamp := System.OS_Primitives.Clock; Call_Chain (Tracebk, Max_Call_Stack, Num_Calls, Skip_Frames => 2); - fputc (Character'Pos ('A'), Gmemfile); - fwrite (Result'Address, Address_Size, 1, Gmemfile); - fwrite (Actual_Size'Address, size_t'Max_Size_In_Storage_Elements, 1, - Gmemfile); - fwrite (Timestamp'Address, Duration'Max_Size_In_Storage_Elements, 1, - Gmemfile); - fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1, - Gmemfile); + Putc ('A'); + Write (Result'Address, Address_Size); + Write (Actual_Size'Address, size_t'Max_Size_In_Storage_Elements); + Write (Timestamp'Address, Duration'Max_Size_In_Storage_Elements); + Write (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements); for J in Tracebk'First .. Tracebk'First + Num_Calls - 1 loop declare Ptr : System.Address := PC_For (Tracebk (J)); begin - fwrite (Ptr'Address, Address_Size, 1, Gmemfile); + Write (Ptr'Address, Address_Size); end; end loop; @@ -246,8 +230,8 @@ package body System.Memory is procedure Finalize is begin - if not Needs_Init then - fclose (Gmemfile); + if not Needs_Init and then CRTL.fclose (Gmemfile) /= 0 then + Put_Line ("gmem close error: " & OS_Lib.Errno_Message); end if; end Finalize; @@ -275,18 +259,16 @@ package body System.Memory is Call_Chain (Tracebk, Max_Call_Stack, Num_Calls, Skip_Frames => 2); Timestamp := System.OS_Primitives.Clock; - fputc (Character'Pos ('D'), Gmemfile); - fwrite (Addr'Address, Address_Size, 1, Gmemfile); - fwrite (Timestamp'Address, Duration'Max_Size_In_Storage_Elements, 1, - Gmemfile); - fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1, - Gmemfile); + Putc ('D'); + Write (Addr'Address, Address_Size); + Write (Timestamp'Address, Duration'Max_Size_In_Storage_Elements); + Write (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements); for J in Tracebk'First .. Tracebk'First + Num_Calls - 1 loop declare Ptr : System.Address := PC_For (Tracebk (J)); begin - fwrite (Ptr'Address, Address_Size, 1, Gmemfile); + Write (Ptr'Address, Address_Size); end; end loop; @@ -304,29 +286,41 @@ package body System.Memory is procedure Gmem_Initialize is Timestamp : aliased Duration; - + File_Mode : constant String := "wb" & ASCII.NUL; begin if Needs_Init then Needs_Init := False; System.OS_Primitives.Initialize; Timestamp := System.OS_Primitives.Clock; - Gmemfile := fopen (Gmemfname, "wb" & ASCII.NUL); + Gmemfile := CRTL.fopen (Gmemfname'Address, File_Mode'Address); if Gmemfile = System.Null_Address then Put_Line ("Couldn't open gnatmem log file for writing"); - OS_Exit (255); + OS_Lib.OS_Exit (255); end if; declare S : constant String := "GMEM DUMP" & ASCII.LF; begin - fwrite (S'Address, S'Length, 1, Gmemfile); - fwrite (Timestamp'Address, Duration'Max_Size_In_Storage_Elements, - 1, Gmemfile); + Write (S'Address, S'Length); + Write (Timestamp'Address, Duration'Max_Size_In_Storage_Elements); end; end if; end Gmem_Initialize; + ---------- + -- Putc -- + ---------- + + procedure Putc (Char : Character) is + C : constant Integer := Character'Pos (Char); + + begin + if CRTL.fputc (C, Gmemfile) /= C then + Put_Line ("gmem fputc error: " & OS_Lib.Errno_Message); + end if; + end Putc; + ------------- -- Realloc -- ------------- @@ -360,18 +354,16 @@ package body System.Memory is Call_Chain (Tracebk, Max_Call_Stack, Num_Calls, Skip_Frames => 2); Timestamp := System.OS_Primitives.Clock; - fputc (Character'Pos ('D'), Gmemfile); - fwrite (Addr'Address, Address_Size, 1, Gmemfile); - fwrite (Timestamp'Address, Duration'Max_Size_In_Storage_Elements, 1, - Gmemfile); - fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1, - Gmemfile); + Putc ('D'); + Write (Addr'Address, Address_Size); + Write (Timestamp'Address, Duration'Max_Size_In_Storage_Elements); + Write (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements); for J in Tracebk'First .. Tracebk'First + Num_Calls - 1 loop declare Ptr : System.Address := PC_For (Tracebk (J)); begin - fwrite (Ptr'Address, Address_Size, 1, Gmemfile); + Write (Ptr'Address, Address_Size); end; end loop; @@ -381,20 +373,17 @@ package body System.Memory is -- Log allocation call using the same backtrace - fputc (Character'Pos ('A'), Gmemfile); - fwrite (Result'Address, Address_Size, 1, Gmemfile); - fwrite (Size'Address, size_t'Max_Size_In_Storage_Elements, 1, - Gmemfile); - fwrite (Timestamp'Address, Duration'Max_Size_In_Storage_Elements, 1, - Gmemfile); - fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1, - Gmemfile); + Putc ('A'); + Write (Result'Address, Address_Size); + Write (Size'Address, size_t'Max_Size_In_Storage_Elements); + Write (Timestamp'Address, Duration'Max_Size_In_Storage_Elements); + Write (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements); for J in Tracebk'First .. Tracebk'First + Num_Calls - 1 loop declare Ptr : System.Address := PC_For (Tracebk (J)); begin - fwrite (Ptr'Address, Address_Size, 1, Gmemfile); + Write (Ptr'Address, Address_Size); end; end loop; @@ -411,4 +400,22 @@ package body System.Memory is return Result; end Realloc; + ----------- + -- Write -- + ----------- + + procedure Write (Ptr : System.Address; Size : size_t) is + function fwrite + (buffer : System.Address; + size : size_t; + count : size_t; + stream : File_Ptr) return size_t; + pragma Import (C, fwrite); + + begin + if fwrite (Ptr, Size, 1, Gmemfile) /= 1 then + Put_Line ("gmem fwrite error: " & OS_Lib.Errno_Message); + end if; + end Write; + end System.Memory; diff --git a/gcc/ada/libgnat/s-arit128.ads b/gcc/ada/libgnat/s-arit128.ads index 6213cfb..fa6fedc 100644 --- a/gcc/ada/libgnat/s-arit128.ads +++ b/gcc/ada/libgnat/s-arit128.ads @@ -81,4 +81,11 @@ package System.Arith_128 is -- then Q is the rounded quotient. The remainder R is not affected by the -- setting of the Round flag. +private + -- Make it callable from strub contexts. + -- There is a matching setting in trans.c, + -- for calls issued by Gigi. + pragma Machine_Attribute (Multiply_With_Ovflo_Check128, + "strub", "callable"); + end System.Arith_128; diff --git a/gcc/ada/libgnat/s-arit64.ads b/gcc/ada/libgnat/s-arit64.ads index c9141f5..68d2149 100644 --- a/gcc/ada/libgnat/s-arit64.ads +++ b/gcc/ada/libgnat/s-arit64.ads @@ -93,4 +93,11 @@ package System.Arith_64 is Round : Boolean) renames Double_Divide64; -- Renamed procedure to preserve compatibility with earlier versions +private + -- Make it callable from strub contexts. + -- There is a matching setting in trans.c, + -- for calls issued by Gigi. + pragma Machine_Attribute (Multiply_With_Ovflo_Check64, + "strub", "callable"); + end System.Arith_64; diff --git a/gcc/ada/libgnat/s-imenne.adb b/gcc/ada/libgnat/s-imenne.adb deleted file mode 100644 index 4ca7a12..0000000 --- a/gcc/ada/libgnat/s-imenne.adb +++ /dev/null @@ -1,170 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- S Y S T E M . I M G _ E N U M _ N E W -- --- -- --- B o d y -- --- -- --- Copyright (C) 2000-2021, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -pragma Compiler_Unit_Warning; - -with Ada.Unchecked_Conversion; - -package body System.Img_Enum_New is - - ------------------------- - -- Image_Enumeration_8 -- - ------------------------- - - procedure Image_Enumeration_8 - (Pos : Natural; - S : in out String; - P : out Natural; - Names : String; - Indexes : System.Address) - is - pragma Assert (S'First = 1); - - type Natural_8 is range 0 .. 2 ** 7 - 1; - subtype Names_Index is - Natural_8 range Natural_8 (Names'First) - .. Natural_8 (Names'Last) + 1; - subtype Index is Natural range Natural'First .. Names'Length; - type Index_Table is array (Index) of Names_Index; - type Index_Table_Ptr is access Index_Table; - - function To_Index_Table_Ptr is - new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr); - - IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes); - - pragma Assert (Pos in IndexesT'Range); - pragma Assert (Pos + 1 in IndexesT'Range); - - Start : constant Natural := Natural (IndexesT (Pos)); - Next : constant Natural := Natural (IndexesT (Pos + 1)); - - pragma Assert (Next - 1 >= Start); - pragma Assert (Start >= Names'First); - pragma Assert (Next - 1 <= Names'Last); - - pragma Assert (Next - Start <= S'Last); - -- The caller should guarantee that S is large enough to contain the - -- enumeration image. - begin - S (1 .. Next - Start) := Names (Start .. Next - 1); - P := Next - Start; - end Image_Enumeration_8; - - -------------------------- - -- Image_Enumeration_16 -- - -------------------------- - - procedure Image_Enumeration_16 - (Pos : Natural; - S : in out String; - P : out Natural; - Names : String; - Indexes : System.Address) - is - pragma Assert (S'First = 1); - - type Natural_16 is range 0 .. 2 ** 15 - 1; - subtype Names_Index is - Natural_16 range Natural_16 (Names'First) - .. Natural_16 (Names'Last) + 1; - subtype Index is Natural range Natural'First .. Names'Length; - type Index_Table is array (Index) of Names_Index; - type Index_Table_Ptr is access Index_Table; - - function To_Index_Table_Ptr is - new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr); - - IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes); - - pragma Assert (Pos in IndexesT'Range); - pragma Assert (Pos + 1 in IndexesT'Range); - - Start : constant Natural := Natural (IndexesT (Pos)); - Next : constant Natural := Natural (IndexesT (Pos + 1)); - - pragma Assert (Next - 1 >= Start); - pragma Assert (Start >= Names'First); - pragma Assert (Next - 1 <= Names'Last); - - pragma Assert (Next - Start <= S'Last); - -- The caller should guarantee that S is large enough to contain the - -- enumeration image. - begin - S (1 .. Next - Start) := Names (Start .. Next - 1); - P := Next - Start; - end Image_Enumeration_16; - - -------------------------- - -- Image_Enumeration_32 -- - -------------------------- - - procedure Image_Enumeration_32 - (Pos : Natural; - S : in out String; - P : out Natural; - Names : String; - Indexes : System.Address) - is - pragma Assert (S'First = 1); - - type Natural_32 is range 0 .. 2 ** 31 - 1; - subtype Names_Index is - Natural_32 range Natural_32 (Names'First) - .. Natural_32 (Names'Last) + 1; - subtype Index is Natural range Natural'First .. Names'Length; - type Index_Table is array (Index) of Names_Index; - type Index_Table_Ptr is access Index_Table; - - function To_Index_Table_Ptr is - new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr); - - IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes); - - pragma Assert (Pos in IndexesT'Range); - pragma Assert (Pos + 1 in IndexesT'Range); - - Start : constant Natural := Natural (IndexesT (Pos)); - Next : constant Natural := Natural (IndexesT (Pos + 1)); - - pragma Assert (Next - 1 >= Start); - pragma Assert (Start >= Names'First); - pragma Assert (Next - 1 <= Names'Last); - - pragma Assert (Next - Start <= S'Last); - -- The caller should guarantee that S is large enough to contain the - -- enumeration image. - begin - S (1 .. Next - Start) := Names (Start .. Next - 1); - P := Next - Start; - end Image_Enumeration_32; - -end System.Img_Enum_New; diff --git a/gcc/ada/libgnat/s-imenne.ads b/gcc/ada/libgnat/s-imenne.ads deleted file mode 100644 index eba31c2..0000000 --- a/gcc/ada/libgnat/s-imenne.ads +++ /dev/null @@ -1,85 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- S Y S T E M . I M G _ E N U M _ N E W -- --- -- --- S p e c -- --- -- --- Copyright (C) 2000-2021, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- Enumeration_Type'Image for all enumeration types except those in package --- Standard (where we have no opportunity to build image tables), and in --- package System (where it is too early to start building image tables). --- Special routines exist for the enumeration types in these packages. - --- Note: this is an obsolete package replaced by instantiations of the generic --- package System.Image_N. The reason we maintain this package is that when --- bootstrapping with an old compiler, the old compiler will search for this --- unit, expecting to find these functions. The new compiler will search for --- procedures in the instances of System.Image_N instead. - -pragma Compiler_Unit_Warning; - -package System.Img_Enum_New is - pragma Pure; - - procedure Image_Enumeration_8 - (Pos : Natural; - S : in out String; - P : out Natural; - Names : String; - Indexes : System.Address); - -- Used to compute Enum'Image (Str) where Enum is some enumeration type - -- other than those defined in package Standard. Names is a string with - -- a lower bound of 1 containing the characters of all the enumeration - -- literals concatenated together in sequence. Indexes is the address of - -- an array of type array (0 .. N) of Natural_8, where N is the number of - -- enumeration literals in the type. The Indexes values are the starting - -- subscript of each enumeration literal, indexed by Pos values, with an - -- extra entry at the end containing Names'Length + 1. The reason that - -- Indexes is passed by address is that the actual type is created on the - -- fly by the expander. The desired 'Image value is stored in S (1 .. P) - -- and P is set on return. The caller guarantees that S is long enough to - -- hold the result and that the lower bound is 1. - - procedure Image_Enumeration_16 - (Pos : Natural; - S : in out String; - P : out Natural; - Names : String; - Indexes : System.Address); - -- Identical to Set_Image_Enumeration_8 except that it handles types using - -- array (0 .. Num) of Natural_16 for the Indexes table. - - procedure Image_Enumeration_32 - (Pos : Natural; - S : in out String; - P : out Natural; - Names : String; - Indexes : System.Address); - -- Identical to Set_Image_Enumeration_8 except that it handles types using - -- array (0 .. Num) of Natural_32 for the Indexes table. - -end System.Img_Enum_New; diff --git a/gcc/ada/libgnat/s-imglli.ads b/gcc/ada/libgnat/s-imglli.ads index 2e0b42c..e6e3efc 100644 --- a/gcc/ada/libgnat/s-imglli.ads +++ b/gcc/ada/libgnat/s-imglli.ads @@ -30,8 +30,8 @@ ------------------------------------------------------------------------------ -- This package contains the routines for supporting the Image attribute for --- signed integer types larger Integer, and also for conversion operations --- required in Text_IO.Integer_IO for such types. +-- signed integer types larger than Integer, and also for conversion +-- operations required in Text_IO.Integer_IO for such types. with System.Image_I; diff --git a/gcc/ada/libgnat/s-parame__vxworks.ads b/gcc/ada/libgnat/s-parame__vxworks.ads index 11b408b..b22d858 100644 --- a/gcc/ada/libgnat/s-parame__vxworks.ads +++ b/gcc/ada/libgnat/s-parame__vxworks.ads @@ -108,11 +108,11 @@ package System.Parameters is -- Select the appropriate time_t_bits for the VSB in use, then rebuild -- the runtime using instructions in adainclude/libada.gpr. - time_t_bits : constant := Long_Integer'Size; + -- time_t_bits : constant := Long_Integer'Size; -- Number of bits in type time_t for SR0650 and before and SR0660 with -- non-default configuration. - -- time_t_bits : constant := Long_Long_Integer'Size; + time_t_bits : constant := Long_Long_Integer'Size; -- Number of bits in type time_t for SR0660 with default configuration. ---------------------------------------------- diff --git a/gcc/ada/libgnat/s-regpat.adb b/gcc/ada/libgnat/s-regpat.adb index 7e33067..b40f682 100644 --- a/gcc/ada/libgnat/s-regpat.adb +++ b/gcc/ada/libgnat/s-regpat.adb @@ -3463,18 +3463,58 @@ package body System.Regpat is end; elsif Self.First /= ASCII.NUL then - -- We know what char it must start with + -- We know what char (modulo casing) it must start with - declare - Next_Try : Natural := Index (First_In_Data, Self.First); + if (Self.Flags and Case_Insensitive) = 0 + or else Self.First not in 'a' .. 'z' + then + declare + Next_Try : Natural := Index (First_In_Data, Self.First); + begin + while Next_Try /= 0 loop + Matched := Try (Next_Try); + exit when Matched; + Next_Try := Index (Next_Try + 1, Self.First); + end loop; + end; + else + declare + Uc_First : constant Character := To_Upper (Self.First); + + function Case_Insensitive_Index + (Start : Positive) return Natural; + -- Search for both Self.First and To_Upper (Self.First). + -- If both are nonzero, return the smaller one; if exactly + -- one is nonzero, return it; if both are zero, return zero. + + --------------------------- + -- Case_Insenstive_Index -- + --------------------------- + + function Case_Insensitive_Index + (Start : Positive) return Natural + is + Lc_Index : constant Natural := Index (Start, Self.First); + Uc_Index : constant Natural := Index (Start, Uc_First); + begin + if Lc_Index = 0 then + return Uc_Index; + elsif Uc_Index = 0 then + return Lc_Index; + else + return Natural'Min (Lc_Index, Uc_Index); + end if; + end Case_Insensitive_Index; - begin - while Next_Try /= 0 loop - Matched := Try (Next_Try); - exit when Matched; - Next_Try := Index (Next_Try + 1, Self.First); - end loop; - end; + Next_Try : Natural := Case_Insensitive_Index (First_In_Data); + begin + while Next_Try /= 0 loop + Matched := Try (Next_Try); + exit when Matched; + Next_Try := Case_Insensitive_Index (Next_Try + 1); + end loop; + end; + end if; else -- Messy cases: try all locations (including for the empty string) @@ -3634,6 +3674,9 @@ package body System.Regpat is if Program (Scan) = EXACT then Self.First := Program (String_Operand (Scan)); + elsif Program (Scan) = EXACTF then + Self.First := To_Lower (Program (String_Operand (Scan))); + elsif Program (Scan) = BOL or else Program (Scan) = SBOL or else Program (Scan) = MBOL diff --git a/gcc/ada/libgnat/s-regpat.ads b/gcc/ada/libgnat/s-regpat.ads index b1a1366f..8fac30a 100644 --- a/gcc/ada/libgnat/s-regpat.ads +++ b/gcc/ada/libgnat/s-regpat.ads @@ -482,18 +482,17 @@ package System.Regpat is -- Data_First is the lower bound for the match, i.e. Data (Data_First) -- will be the first character to be examined. If Data_First is set to -- the special value of -1 (the default), then the first character to - -- be examined is Data (Data_First). However, the regular expression - -- character ^ (start of string) still refers to the first character + -- be examined is Data (Data'First). However, the regular expression + -- character ^ (start of string) always refers to the first character -- of the full string (Data (Data'First)), which is why there is a -- separate mechanism for specifying Data_First. -- Data_Last is the upper bound for the match, i.e. Data (Data_Last) -- will be the last character to be examined. If Data_Last is set to -- the special value of Positive'Last (the default), then the last - -- character to be examined is Data (Data_Last). However, the regular - -- expression character $ (end of string) still refers to the last - -- character of the full string (Data (Data'Last)), which is why there - -- is a separate mechanism for specifying Data_Last. + -- character to be examined is Data (Data'Last). However, the regular + -- expression character $ (end of string) always refers to the last + -- character of the full string (Data (Data'Last)). -- Note: the use of Data_First and Data_Last is not equivalent to -- simply passing a slice as Expression because of the handling of diff --git a/gcc/ada/libgnat/s-secsta.ads b/gcc/ada/libgnat/s-secsta.ads index 7d6b1b9..6648c23 100644 --- a/gcc/ada/libgnat/s-secsta.ads +++ b/gcc/ada/libgnat/s-secsta.ads @@ -440,4 +440,9 @@ private function Get_Stack_Info (Stack : SS_Stack_Ptr) return Stack_Info; -- Obtain the information attributes of secondary stack Stack + pragma Machine_Attribute (SS_Allocate, "strub", "callable"); + pragma Machine_Attribute (SS_Mark, "strub", "callable"); + pragma Machine_Attribute (SS_Release, "strub", "callable"); + -- Enable these to be called from within strub contexts. + end System.Secondary_Stack; |