diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/exp_imgv.adb | 42 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-vaen16.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-vaen32.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-vaenu8.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-valboo.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-valcha.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-valuen.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-valuen.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-valuti.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-valuti.ads | 14 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-valwch.adb | 2 |
11 files changed, 69 insertions, 26 deletions
diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index b350542..ef2a3a3 100644 --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -1431,11 +1431,11 @@ package body Exp_Imgv is procedure Expand_Valid_Value_Attribute (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); + Args : constant List_Id := Expressions (N); Btyp : constant Entity_Id := Base_Type (Entity (Prefix (N))); Rtyp : constant Entity_Id := Root_Type (Btyp); pragma Assert (Is_Enumeration_Type (Rtyp)); - Args : constant List_Id := Expressions (N); Func : RE_Id; Ttyp : Entity_Id; @@ -1443,7 +1443,7 @@ package body Exp_Imgv is -- Generate: -- Valid_Value_Enumeration_NN - -- (typS, typN'Address, typH'Unrestricted_Access, Num, X) + -- (typS, typN'Address, typH'Unrestricted_Access, Num, Is_Wide, X) Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp))); @@ -1455,6 +1455,10 @@ package body Exp_Imgv is Func := RE_Valid_Value_Enumeration_32; end if; + -- The Valid_[Wide_]Wide_Value attribute does not exist + + Prepend_To (Args, New_Occurrence_Of (Standard_False, Loc)); + Prepend_To (Args, Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Rtyp, Loc), @@ -1546,7 +1550,7 @@ package body Exp_Imgv is -- Enum'Val -- (Value_Enumeration_NN - -- (typS, typN'Address, typH'Unrestricted_Access, Num, X)) + -- (typS, typN'Address, typH'Unrestricted_Access, Num, Is_Wide, X)) -- where typS, typN and typH are the Lit_Strings, Lit_Indexes and Lit_Hash -- entities from T's root type entity, and Num is Enum'Pos (Enum'Last). @@ -1558,14 +1562,15 @@ package body Exp_Imgv is procedure Expand_Value_Attribute (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); + Args : constant List_Id := Expressions (N); Btyp : constant Entity_Id := Etype (N); pragma Assert (Is_Base_Type (Btyp)); pragma Assert (Btyp = Base_Type (Entity (Prefix (N)))); Rtyp : constant Entity_Id := Root_Type (Btyp); - Args : constant List_Id := Expressions (N); - Ttyp : Entity_Id; - Vid : RE_Id; + Is_Wide : Boolean; + Ttyp : Entity_Id; + Vid : RE_Id; begin -- Fall through for all cases except user-defined enumeration type @@ -1717,9 +1722,9 @@ package body Exp_Imgv is -- Normal case where we have enumeration tables, build - -- T'Val - -- (Value_Enumeration_NN - -- (typS, typN'Address, typH'Unrestricted_Access, Num, X)) + -- T'Val + -- (Value_Enumeration_NN + -- (typS, typN'Address, typH'Unrestricted_Access, Num, Is_Wide, X)) else Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp))); @@ -1732,6 +1737,25 @@ package body Exp_Imgv is Vid := RE_Value_Enumeration_32; end if; + if Nkind (First (Args)) = N_Function_Call + and then Is_Entity_Name (Name (First (Args))) + then + declare + E : constant Entity_Id := Entity (Name (First (Args))); + + begin + Is_Wide := Is_RTE (E, RE_Wide_String_To_String) + or else + Is_RTE (E, RE_Wide_Wide_String_To_String); + end; + + else + Is_Wide := False; + end if; + + Prepend_To (Args, + New_Occurrence_Of (Boolean_Literals (Is_Wide), Loc)); + Prepend_To (Args, Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Rtyp, Loc), diff --git a/gcc/ada/libgnat/s-vaen16.ads b/gcc/ada/libgnat/s-vaen16.ads index 5ac8beb..7cc98be 100644 --- a/gcc/ada/libgnat/s-vaen16.ads +++ b/gcc/ada/libgnat/s-vaen16.ads @@ -45,6 +45,7 @@ package System.Val_Enum_16 is Indexes : System.Address; Hash : Impl.Hash_Function_Ptr; Num : Natural; + Is_Wide : Boolean; Str : String) return Natural renames Impl.Value_Enumeration; @@ -54,6 +55,7 @@ package System.Val_Enum_16 is Indexes : System.Address; Hash : Impl.Hash_Function_Ptr; Num : Natural; + Is_Wide : Boolean; Str : String) return Boolean renames Impl.Valid_Value_Enumeration; diff --git a/gcc/ada/libgnat/s-vaen32.ads b/gcc/ada/libgnat/s-vaen32.ads index ee540f1..0900d18 100644 --- a/gcc/ada/libgnat/s-vaen32.ads +++ b/gcc/ada/libgnat/s-vaen32.ads @@ -45,6 +45,7 @@ package System.Val_Enum_32 is Indexes : System.Address; Hash : Impl.Hash_Function_Ptr; Num : Natural; + Is_Wide : Boolean; Str : String) return Natural renames Impl.Value_Enumeration; @@ -54,6 +55,7 @@ package System.Val_Enum_32 is Indexes : System.Address; Hash : Impl.Hash_Function_Ptr; Num : Natural; + Is_Wide : Boolean; Str : String) return Boolean renames Impl.Valid_Value_Enumeration; diff --git a/gcc/ada/libgnat/s-vaenu8.ads b/gcc/ada/libgnat/s-vaenu8.ads index 6d34533..62e9fa3 100644 --- a/gcc/ada/libgnat/s-vaenu8.ads +++ b/gcc/ada/libgnat/s-vaenu8.ads @@ -45,6 +45,7 @@ package System.Val_Enum_8 is Indexes : System.Address; Hash : Impl.Hash_Function_Ptr; Num : Natural; + Is_Wide : Boolean; Str : String) return Natural renames Impl.Value_Enumeration; @@ -54,6 +55,7 @@ package System.Val_Enum_8 is Indexes : System.Address; Hash : Impl.Hash_Function_Ptr; Num : Natural; + Is_Wide : Boolean; Str : String) return Boolean renames Impl.Valid_Value_Enumeration; diff --git a/gcc/ada/libgnat/s-valboo.adb b/gcc/ada/libgnat/s-valboo.adb index 5cb3b98..f7a13ba 100644 --- a/gcc/ada/libgnat/s-valboo.adb +++ b/gcc/ada/libgnat/s-valboo.adb @@ -53,7 +53,7 @@ is S : String (Str'Range) := Str; begin - Normalize_String (S, F, L); + Normalize_String (S, F, L, To_Upper_Case => True); pragma Assert (F = System.Val_Spec.First_Non_Space_Ghost (S, Str'First, Str'Last)); diff --git a/gcc/ada/libgnat/s-valcha.adb b/gcc/ada/libgnat/s-valcha.adb index 46f3eb4..13cbcb5 100644 --- a/gcc/ada/libgnat/s-valcha.adb +++ b/gcc/ada/libgnat/s-valcha.adb @@ -43,7 +43,9 @@ package body System.Val_Char is S : String (Str'Range) := Str; begin - Normalize_String (S, F, L); + -- The names of control characters use upper case letters + + Normalize_String (S, F, L, To_Upper_Case => True); -- Accept any single character enclosed in quotes diff --git a/gcc/ada/libgnat/s-valuen.adb b/gcc/ada/libgnat/s-valuen.adb index caf4fc6..8fa4c26 100644 --- a/gcc/ada/libgnat/s-valuen.adb +++ b/gcc/ada/libgnat/s-valuen.adb @@ -40,6 +40,7 @@ package body System.Value_N is Indexes : System.Address; Hash : Hash_Function_Ptr; Num : Natural; + Is_Wide : Boolean; Str : String) return Integer with Pure_Function; -- Same as Value_Enumeration, except returns negative if Value_Enumeration @@ -54,6 +55,7 @@ package body System.Value_N is Indexes : System.Address; Hash : Hash_Function_Ptr; Num : Natural; + Is_Wide : Boolean; Str : String) return Integer is @@ -76,7 +78,7 @@ package body System.Value_N is pragma Assert (Num + 1 in IndexesT'Range); begin - Normalize_String (S, F, L); + Normalize_String (S, F, L, To_Upper_Case => not Is_Wide); declare Normal : String renames S (F .. L); @@ -120,11 +122,13 @@ package body System.Value_N is Indexes : System.Address; Hash : Hash_Function_Ptr; Num : Natural; + Is_Wide : Boolean; Str : String) return Boolean is begin - return Value_Enumeration_Pos (Names, Indexes, Hash, Num, Str) >= 0; + return + Value_Enumeration_Pos (Names, Indexes, Hash, Num, Is_Wide, Str) >= 0; end Valid_Value_Enumeration; ----------------------- @@ -136,11 +140,12 @@ package body System.Value_N is Indexes : System.Address; Hash : Hash_Function_Ptr; Num : Natural; + Is_Wide : Boolean; Str : String) return Natural is Result : constant Integer := - Value_Enumeration_Pos (Names, Indexes, Hash, Num, Str); + Value_Enumeration_Pos (Names, Indexes, Hash, Num, Is_Wide, Str); begin -- The comparison eliminates the need for a range check on return diff --git a/gcc/ada/libgnat/s-valuen.ads b/gcc/ada/libgnat/s-valuen.ads index 83ffd71..fe2babf 100644 --- a/gcc/ada/libgnat/s-valuen.ads +++ b/gcc/ada/libgnat/s-valuen.ads @@ -47,6 +47,7 @@ package System.Value_N is Indexes : System.Address; Hash : Hash_Function_Ptr; Num : Natural; + Is_Wide : Boolean; Str : String) return Natural with Inline; -- Used to compute Enum'Value (Str) where Enum is some enumeration type @@ -60,7 +61,8 @@ package System.Value_N is -- The parameter Hash is a (perfect) hash function for Names and Indexes. -- The parameter Num is the value N - 1 (i.e. Enum'Pos (Enum'Last)). -- The reason that Indexes is passed by address is that the actual type - -- is created on the fly by the expander. + -- is created on the fly by the expander. The parameter Is_Wide is True + -- if the original attribute was [Wide_]Wide_Value. -- -- Str is the argument of the attribute function, and may have leading -- and trailing spaces, and letters can be upper or lower case or mixed. @@ -72,6 +74,7 @@ package System.Value_N is Indexes : System.Address; Hash : Hash_Function_Ptr; Num : Natural; + Is_Wide : Boolean; Str : String) return Boolean with Inline; -- Returns True if Str is a valid Image of some enumeration literal, False diff --git a/gcc/ada/libgnat/s-valuti.adb b/gcc/ada/libgnat/s-valuti.adb index 147a10a..50e7f6a 100644 --- a/gcc/ada/libgnat/s-valuti.adb +++ b/gcc/ada/libgnat/s-valuti.adb @@ -67,8 +67,9 @@ is ---------------------- procedure Normalize_String - (S : in out String; - F, L : out Integer) + (S : in out String; + F, L : out Integer; + To_Upper_Case : Boolean) is begin F := S'First; @@ -106,9 +107,9 @@ is L := L - 1; end loop; - -- Except in the case of a character literal, convert to upper case + -- Convert to upper case if requested and not a character literal - if S (F) /= ''' then + if To_Upper_Case and then S (F) /= ''' then for J in F .. L loop S (J) := To_Upper (S (J)); pragma Loop_Invariant diff --git a/gcc/ada/libgnat/s-valuti.ads b/gcc/ada/libgnat/s-valuti.ads index 70585477..cc804f4 100644 --- a/gcc/ada/libgnat/s-valuti.ads +++ b/gcc/ada/libgnat/s-valuti.ads @@ -60,8 +60,9 @@ is -- Raises constraint error with message: bad input for 'Value: "xxx" procedure Normalize_String - (S : in out String; - F, L : out Integer) + (S : in out String; + F, L : out Integer; + To_Upper_Case : Boolean) with Post => (if Sp.Only_Space_Ghost (S'Old, S'First, S'Last) then F > L @@ -76,7 +77,7 @@ is (if L < S'Last then Sp.Only_Space_Ghost (S'Old, L + 1, S'Last)) and then - (if S'Old (F) /= ''' then + (if To_Upper_Case and then S'Old (F) /= ''' then (for all J in S'Range => (if J in F .. L then S (J) = System.Case_Util.To_Upper (S'Old (J)) @@ -84,9 +85,10 @@ is S (J) = S'Old (J))))); -- This procedure scans the string S setting F to be the index of the first -- non-blank character of S and L to be the index of the last non-blank - -- character of S. Any lower case characters present in S will be folded to - -- their upper case equivalent except for character literals. If S consists - -- of entirely blanks (including when S = "") then we return with F > L. + -- character of S. If To_Upper_Case is True and S does not represent a + -- character literal, then any lower case characters in S are changed to + -- their upper case counterparts. If S consists of only blank characters + -- (including when S = "") then we return with F > L. procedure Scan_Sign (Str : String; diff --git a/gcc/ada/libgnat/s-valwch.adb b/gcc/ada/libgnat/s-valwch.adb index e452e31..4162bc1 100644 --- a/gcc/ada/libgnat/s-valwch.adb +++ b/gcc/ada/libgnat/s-valwch.adb @@ -67,7 +67,7 @@ package body System.Val_WChar is S : String (Str'Range) := Str; begin - Normalize_String (S, F, L); + Normalize_String (S, F, L, To_Upper_Case => False); -- Character literal case |