diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index af254c97de9..567d644f188 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,39 @@ +2013-10-14 Robert Dewar + + * einfo.ads, einfo.adb (Default_Aspect_Component_Value): Is on base type + only. + * exp_aggr.adb (Expand_Array_Aggregate): Handle proper + initialization of <> component. + * exp_ch3.adb, exp_tss.adb: Minor reformatting + * sem_ch13.adb (Default_Aspect_Component_Value, Default_Aspect_Value): + Is on base type only. + * sinfo.ads: Minor comment revision. + +2013-10-14 Robert Dewar + + * g-decstr.adb (Decode_Wide_Wide_Character): Fix failure + to detect invalid sequences where longer than necessary + sequences are used for encoding. + (Validate_Wide_Character): + Call Decode_Wide_Character to get the above validations. + (Validate_Wide_Wide_Character): Same fix + * g-decstr.ads: Add documentation making it clear that the UTF-8 + implementation here recognizes all valid UTF-8 sequences, rather + than the well-formed subset corresponding to characters defined + in Unicode. + (Next_Wide_Character): Remove comment about this + being more efficient than Decode_Wide_Character (because this + no longer the case). + (Prev_Wide_Character): Add note that valid encoding is assumed. + +2013-10-14 Robert Dewar + + * a-wichha.adb (Character_Set_Version): New function. + * a-wichha.ads: Remove comments for pragma Pure (final RM has + this). + (Character_Set_Version): New function. + * gnat_rm.texi: Update doc. + 2013-10-14 Hristian Kirtchev * einfo.adb: Flag263 is now known as Has_Null_Refinement. diff --git a/gcc/ada/a-wichha.adb b/gcc/ada/a-wichha.adb index 8cdc7efb400..6692cbf445f 100644 --- a/gcc/ada/a-wichha.adb +++ b/gcc/ada/a-wichha.adb @@ -33,6 +33,11 @@ with Ada.Wide_Characters.Unicode; use Ada.Wide_Characters.Unicode; package body Ada.Wide_Characters.Handling is + function Character_Set_Version return String is + begin + return "Unicode 6.2"; + end Character_Set_Version; + --------------------- -- Is_Alphanumeric -- --------------------- diff --git a/gcc/ada/a-wichha.ads b/gcc/ada/a-wichha.ads index 7964756e5be..583308ec6a0 100644 --- a/gcc/ada/a-wichha.ads +++ b/gcc/ada/a-wichha.ads @@ -15,10 +15,12 @@ package Ada.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_Character) return Boolean; pragma Inline (Is_Control); diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index a78452dd93e..8b6b3614b47 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -853,13 +853,13 @@ package body Einfo is function Default_Aspect_Component_Value (Id : E) return N is begin pragma Assert (Is_Array_Type (Id)); - return Node19 (Id); + return Node19 (Base_Type (Id)); end Default_Aspect_Component_Value; function Default_Aspect_Value (Id : E) return N is begin pragma Assert (Is_Scalar_Type (Id)); - return Node19 (Id); + return Node19 (Base_Type (Id)); end Default_Aspect_Value; function Default_Expr_Function (Id : E) return E is @@ -3456,13 +3456,13 @@ package body Einfo is procedure Set_Default_Aspect_Component_Value (Id : E; V : E) is begin - pragma Assert (Is_Array_Type (Id)); + pragma Assert (Is_Array_Type (Id) and then Is_Base_Type (Id)); Set_Node19 (Id, V); end Set_Default_Aspect_Component_Value; procedure Set_Default_Aspect_Value (Id : E; V : E) is begin - pragma Assert (Is_Scalar_Type (Id)); + pragma Assert (Is_Scalar_Type (Id) and then Is_Base_Type (Id)); Set_Node19 (Id, V); end Set_Default_Aspect_Value; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 1f69fef0229..c1ffa0018d4 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -738,13 +738,13 @@ package Einfo is -- subprograms, this returns the {function,procedure}_specification, not -- the subprogram_declaration. --- Default_Aspect_Component_Value (Node19) +-- Default_Aspect_Component_Value (Node19) [base type only] -- Defined in array types. Holds the static value specified in a --- default_component_value aspect specification for the array type. +-- Default_Component_Value aspect specification for the array type. --- Default_Aspect_Value (Node19) +-- Default_Aspect_Value (Node19) [base type only] -- Defined in scalar types. Holds the static value specified in a --- default_value aspect specification for the type. +-- Default_Value aspect specification for the type. -- Default_Expr_Function (Node21) -- Defined in parameters. It holds the entity of the parameterless @@ -5171,7 +5171,7 @@ package Einfo is -- E_Array_Type -- E_Array_Subtype -- First_Index (Node17) - -- Default_Aspect_Component_Value (Node19) + -- Default_Aspect_Component_Value (Node19) (base type only) -- Component_Type (Node20) (base type only) -- Original_Array_Type (Node21) -- Component_Size (Uint22) (base type only) @@ -5354,7 +5354,7 @@ package Einfo is -- Lit_Indexes (Node15) (root type only) -- Lit_Strings (Node16) (root type only) -- First_Literal (Node17) - -- Default_Aspect_Value (Node19) + -- Default_Aspect_Value (Node19) (base type only) -- Scalar_Range (Node20) -- Enum_Pos_To_Rep (Node23) (type only) -- Static_Predicate (List25) @@ -5386,7 +5386,7 @@ package Einfo is -- E_Floating_Point_Subtype -- Digits_Value (Uint17) -- Float_Rep (Uint10) (Float_Rep_Kind) - -- Default_Aspect_Value (Node19) + -- Default_Aspect_Value (Node19) (base type only) -- Scalar_Range (Node20) -- Machine_Emax_Value (synth) -- Machine_Emin_Value (synth) @@ -5564,7 +5564,7 @@ package Einfo is -- E_Modular_Integer_Type -- E_Modular_Integer_Subtype -- Modulus (Uint17) (base type only) - -- Default_Aspect_Value (Node19) + -- Default_Aspect_Value (Node19) (base type only) -- Original_Array_Type (Node21) -- Scalar_Range (Node20) -- Static_Predicate (List25) @@ -5599,7 +5599,7 @@ package Einfo is -- E_Ordinary_Fixed_Point_Type -- E_Ordinary_Fixed_Point_Subtype -- Delta_Value (Ureal18) - -- Default_Aspect_Value (Node19) + -- Default_Aspect_Value (Node19) (base type only) -- Scalar_Range (Node20) -- Small_Value (Ureal21) -- Has_Small_Clause (Flag67) @@ -5853,7 +5853,7 @@ package Einfo is -- E_Signed_Integer_Type -- E_Signed_Integer_Subtype - -- Default_Aspect_Value (Node19) + -- Default_Aspect_Value (Node19) (base type only) -- Scalar_Range (Node20) -- Static_Predicate (List25) -- Has_Biased_Representation (Flag139) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index e0a91324a80..e58e5b22f67 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4878,6 +4878,43 @@ package body Exp_Aggr is Check_Same_Aggr_Bounds (N, 1); end if; + -- STEP 1d + + -- If we have a default component value, or simple initialization is + -- required for the component type, then we replace <> in component + -- associations by the required default value. + + declare + Default_Val : Node_Id; + Assoc : Node_Id; + + begin + if (Present (Default_Aspect_Component_Value (Typ)) + or else Needs_Simple_Initialization (Ctyp)) + and then Present (Component_Associations (N)) + then + Assoc := First (Component_Associations (N)); + while Present (Assoc) loop + if Nkind (Assoc) = N_Component_Association + and then Box_Present (Assoc) + then + Set_Box_Present (Assoc, False); + + if Present (Default_Aspect_Component_Value (Typ)) then + Default_Val := Default_Aspect_Component_Value (Typ); + else + Default_Val := Get_Simple_Init_Val (Ctyp, N); + end if; + + Set_Expression (Assoc, New_Copy_Tree (Default_Val)); + Analyze_And_Resolve (Expression (Assoc), Ctyp); + end if; + + Next (Assoc); + end loop; + end if; + end; + -- STEP 2 -- Here we test for is packed array aggregate that we can handle at diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 98ad0e21cf2..6b3a19327a4 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -4940,7 +4940,7 @@ package body Exp_Ch3 is Next_Elmt (Discr); end loop; - -- Now collect values of initialized components. + -- Now collect values of initialized components Comp := First_Component (Full_Type); while Present (Comp) loop @@ -4957,11 +4957,11 @@ package body Exp_Ch3 is Next_Component (Comp); end loop; - -- Finally, box-initialize remaining components. + -- Finally, box-initialize remaining components Append_To (Component_Associations (Aggr), Make_Component_Association (Loc, - Choices => New_List (Make_Others_Choice (Loc)), + Choices => New_List (Make_Others_Choice (Loc)), Expression => Empty)); Set_Box_Present (Last (Component_Associations (Aggr))); Set_Expression (N, Aggr); diff --git a/gcc/ada/exp_tss.adb b/gcc/ada/exp_tss.adb index 8b19f9190db..2b6dc92d315 100644 --- a/gcc/ada/exp_tss.adb +++ b/gcc/ada/exp_tss.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -211,7 +211,7 @@ package body Exp_Tss is begin return Present (BIP) and then (Restriction_Active (No_Default_Initialization) - or else not Is_Null_Init_Proc (BIP)); + or else not Is_Null_Init_Proc (BIP)); end Has_Non_Null_Base_Init_Proc; --------------- diff --git a/gcc/ada/g-decstr.adb b/gcc/ada/g-decstr.adb index a08584f22e3..255e78a2614 100644 --- a/gcc/ada/g-decstr.adb +++ b/gcc/ada/g-decstr.adb @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2007-2010, AdaCore -- +-- Copyright (C) 2007-2013, AdaCore -- -- -- -- 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- -- @@ -192,6 +192,11 @@ package body GNAT.Decode_String is elsif (U and 2#11100000#) = 2#110_00000# then W := U and 2#00011111#; Get_UTF_Byte; + + if W not in 16#00_0080# .. 16#00_07FF# then + Bad; + end if; + Result := Wide_Wide_Character'Val (W); -- 16#00_0800#-16#00_ffff#: 1110xxxx 10xxxxxx 10xxxxxx @@ -200,6 +205,11 @@ package body GNAT.Decode_String is W := U and 2#00001111#; Get_UTF_Byte; Get_UTF_Byte; + + if W not in 16#00_0800# .. 16#00_FFFF# then + Bad; + end if; + Result := Wide_Wide_Character'Val (W); -- 16#01_0000#-16#10_FFFF#: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx @@ -211,6 +221,10 @@ package body GNAT.Decode_String is Get_UTF_Byte; end loop; + if W not in 16#01_0000# .. 16#10_FFFF# then + Bad; + end if; + Result := Wide_Wide_Character'Val (W); -- 16#0020_0000#-16#03FF_FFFF#: 111110xx 10xxxxxx 10xxxxxx @@ -223,6 +237,10 @@ package body GNAT.Decode_String is Get_UTF_Byte; end loop; + if W not in 16#0020_0000# .. 16#03FF_FFFF# then + Bad; + end if; + Result := Wide_Wide_Character'Val (W); -- All other cases are invalid, note that this includes: @@ -304,100 +322,10 @@ package body GNAT.Decode_String is ------------------------- procedure Next_Wide_Character (Input : String; Ptr : in out Natural) is + Discard : Wide_Character; + pragma Unreferenced (Discard); begin - if Ptr < Input'First then - Past_End; - end if; - - -- Special efficient encoding for UTF-8 case - - if Encoding_Method = WCEM_UTF8 then - UTF8 : declare - U : Unsigned_32; - - procedure Getc; - pragma Inline (Getc); - -- Gets the character at Input (Ptr) and returns code in U as - -- Unsigned_32 value. On return Ptr is bumped past the character. - - procedure Skip_UTF_Byte; - pragma Inline (Skip_UTF_Byte); - -- Skips past one encoded byte which must be 2#10xxxxxx# - - ---------- - -- Getc -- - ---------- - - procedure Getc is - begin - if Ptr > Input'Last then - Past_End; - else - U := Unsigned_32 (Character'Pos (Input (Ptr))); - Ptr := Ptr + 1; - end if; - end Getc; - - ------------------- - -- Skip_UTF_Byte -- - ------------------- - - procedure Skip_UTF_Byte is - begin - Getc; - - if (U and 2#11000000#) /= 2#10_000000# then - Bad; - end if; - end Skip_UTF_Byte; - - -- Start of processing for UTF-8 case - - begin - -- 16#00_0000#-16#00_007F#: 0xxxxxxx - - Getc; - - if (U and 2#10000000#) = 2#00000000# then - return; - - -- 16#00_0080#-16#00_07FF#: 110xxxxx 10xxxxxx - - elsif (U and 2#11100000#) = 2#110_00000# then - Skip_UTF_Byte; - - -- 16#00_0800#-16#00_ffff#: 1110xxxx 10xxxxxx 10xxxxxx - - elsif (U and 2#11110000#) = 2#1110_0000# then - Skip_UTF_Byte; - Skip_UTF_Byte; - - -- Any other code is invalid, note that this includes: - - -- 16#01_0000#-16#10_FFFF#: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx - - -- 16#0020_0000#-16#03FF_FFFF#: 111110xx 10xxxxxx 10xxxxxx - -- 10xxxxxx 10xxxxxx - - -- 16#0400_0000#-16#7FFF_FFFF#: 1111110x 10xxxxxx 10xxxxxx - -- 10xxxxxx 10xxxxxx 10xxxxxx - - -- since Wide_Character does not allow codes > 16#FFFF# - - else - Bad; - end if; - end UTF8; - - -- Non-UTF-8 case - - else - declare - Discard : Wide_Character; - begin - Decode_Wide_Character (Input, Ptr, Discard); - end; - end if; + Decode_Wide_Character (Input, Ptr, Discard); end Next_Wide_Character; ------------------------------ @@ -405,110 +333,10 @@ package body GNAT.Decode_String is ------------------------------ procedure Next_Wide_Wide_Character (Input : String; Ptr : in out Natural) is + Discard : Wide_Wide_Character; + pragma Unreferenced (Discard); begin - -- Special efficient encoding for UTF-8 case - - if Encoding_Method = WCEM_UTF8 then - UTF8 : declare - U : Unsigned_32; - - procedure Getc; - pragma Inline (Getc); - -- Gets the character at Input (Ptr) and returns code in U as - -- Unsigned_32 value. On return Ptr is bumped past the character. - - procedure Skip_UTF_Byte; - pragma Inline (Skip_UTF_Byte); - -- Skips past one encoded byte which must be 2#10xxxxxx# - - ---------- - -- Getc -- - ---------- - - procedure Getc is - begin - if Ptr > Input'Last then - Past_End; - else - U := Unsigned_32 (Character'Pos (Input (Ptr))); - Ptr := Ptr + 1; - end if; - end Getc; - - ------------------- - -- Skip_UTF_Byte -- - ------------------- - - procedure Skip_UTF_Byte is - begin - Getc; - - if (U and 2#11000000#) /= 2#10_000000# then - Bad; - end if; - end Skip_UTF_Byte; - - -- Start of processing for UTF-8 case - - begin - if Ptr < Input'First then - Past_End; - end if; - - -- 16#00_0000#-16#00_007F#: 0xxxxxxx - - Getc; - - if (U and 2#10000000#) = 2#00000000# then - null; - - -- 16#00_0080#-16#00_07FF#: 110xxxxx 10xxxxxx - - elsif (U and 2#11100000#) = 2#110_00000# then - Skip_UTF_Byte; - - -- 16#00_0800#-16#00_ffff#: 1110xxxx 10xxxxxx 10xxxxxx - - elsif (U and 2#11110000#) = 2#1110_0000# then - Skip_UTF_Byte; - Skip_UTF_Byte; - - -- 16#01_0000#-16#10_FFFF#: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx - - elsif (U and 2#11111000#) = 2#11110_000# then - for K in 1 .. 3 loop - Skip_UTF_Byte; - end loop; - - -- 16#0020_0000#-16#03FF_FFFF#: 111110xx 10xxxxxx 10xxxxxx - -- 10xxxxxx 10xxxxxx - - elsif (U and 2#11111100#) = 2#111110_00# then - for K in 1 .. 4 loop - Skip_UTF_Byte; - end loop; - - -- Any other code is invalid, note that this includes: - - -- 16#0400_0000#-16#7FFF_FFFF#: 1111110x 10xxxxxx 10xxxxxx - -- 10xxxxxx 10xxxxxx 10xxxxxx - - -- since Wide_Wide_Character does not allow codes > 16#03FF_FFFF# - - else - Bad; - end if; - end UTF8; - - -- Non-UTF-8 case - - else - declare - Discard : Wide_Wide_Character; - begin - Decode_Wide_Wide_Character (Input, Ptr, Discard); - end; - end if; + Decode_Wide_Wide_Character (Input, Ptr, Discard); end Next_Wide_Wide_Character; -------------- diff --git a/gcc/ada/g-decstr.ads b/gcc/ada/g-decstr.ads index e4d7b7f1633..d59f10dcb20 100644 --- a/gcc/ada/g-decstr.ads +++ b/gcc/ada/g-decstr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2007-2010, AdaCore -- +-- Copyright (C) 2007-2013, AdaCore -- -- -- -- 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- -- @@ -47,6 +47,17 @@ -- does not make any assumptions about the character coding. See also the -- packages Ada.Wide_[Wide_]Characters.Unicode for unicode specific functions. +-- In particular, in the case of UTF-8, all valid UTF-8 encodings, as listed +-- in table 3.6 of the Unicode Standard, version 6.2.0, are recognized as +-- legitimate. This includes the full range 16#0000_0000# .. 16#03FF_FFFF#. +-- This includes codes in the range 16#D800# - 16#DFFF#. These codes all +-- have UTF-8 encoding sequences that are well-defined (e.g. the encoding for +-- 16#D800# is ED A0 80). But these codes do not correspond to defined Unicode +-- characters and are thus considered to be "not well-formed" (see table 3.7 +-- of the Unicode Standard). If you need to exclude these codes, you must do +-- that manually, e.g. use Decode_Wide_Character/Decode_Wide_String and check +-- that the resulting code(s) are not in this range. + -- Note on the use of brackets encoding (WCEM_Brackets). The brackets encoding -- method is ambiguous in the context of this package, since there is no way -- to tell if ["1234"] is eight unencoded characters or one encoded character. @@ -86,7 +97,6 @@ package GNAT.Decode_String is -- will be raised. function Decode_Wide_Wide_String (S : String) return Wide_Wide_String; - pragma Inline (Decode_Wide_Wide_String); -- Same as above function but for Wide_Wide_String output procedure Decode_Wide_Wide_String @@ -124,16 +134,17 @@ package GNAT.Decode_String is (Input : String; Ptr : in out Natural; Result : out Wide_Wide_Character); + pragma Inline (Decode_Wide_Wide_Character); -- Same as above procedure but with Wide_Wide_Character input procedure Next_Wide_Character (Input : String; Ptr : in out Natural); + pragma Inline (Next_Wide_Character); -- This procedure examines the input string starting at Input (Ptr), and -- advances Ptr past one character in the encoded string, so that on return -- Ptr points to the next encoded character. Constraint_Error is raised if -- an invalid encoding is encountered, or the end of the string is reached -- or if Ptr is less than String'First on entry, or if the character - -- skipped is not a valid Wide_Character code. This call may be more - -- efficient than calling Decode_Wide_Character and discarding the result. + -- skipped is not a valid Wide_Character code. procedure Prev_Wide_Character (Input : String; Ptr : in out Natural); -- This procedure is similar to Next_Encoded_Character except that it moves @@ -149,8 +160,12 @@ package GNAT.Decode_String is -- WCEM_Brackets). For all other encodings, we work by starting at the -- beginning of the string and moving forward till Ptr is reached, which -- is correct but slow. + -- + -- Note: this routine assumes that the sequence prior to Ptr is correctly + -- encoded, it does not have a defined behavior if this is not the case. procedure Next_Wide_Wide_Character (Input : String; Ptr : in out Natural); + pragma Inline (Next_Wide_Wide_Character); -- Similar to Next_Wide_Character except that codes skipped must be valid -- Wide_Wide_Character codes. diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 9ea370b2c78..3c62f3d2127 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -12217,7 +12217,18 @@ See items describing the integer and floating-point types supported. @sp 1 @cartouche @noindent -@strong{61}. The accuracy actually achieved by the elementary +@strong{61}. The string returned by @code{Character_Set_Version}. +See A.3.5(3). +@end cartouche +@noindent +@code{Ada.Wide_Characters.Handling.Character_Set_Version} returns +the string "Unicode 6.2", referring to version 6.2.x of the +Unicode specification. + +@sp 1 +@cartouche +@noindent +@strong{62}. The accuracy actually achieved by the elementary functions. See A.5.1(1). @end cartouche @noindent @@ -12227,7 +12238,7 @@ library. Only fast math mode is implemented. @sp 1 @cartouche @noindent -@strong{62}. The sign of a zero result from some of the operators or +@strong{63}. The sign of a zero result from some of the operators or functions in @code{Numerics.Generic_Elementary_Functions}, when @code{Float_Type'Signed_Zeros} is @code{True}. See A.5.1(46). @end cartouche @@ -12238,7 +12249,7 @@ floating-point. @sp 1 @cartouche @noindent -@strong{63}. The value of +@strong{64}. The value of @code{Numerics.Float_Random.Max_Image_Width}. See A.5.2(27). @end cartouche @noindent @@ -12247,7 +12258,7 @@ Maximum image width is 6864, see library file @file{s-rannum.ads}. @sp 1 @cartouche @noindent -@strong{64}. The value of +@strong{65}. The value of @code{Numerics.Discrete_Random.Max_Image_Width}. See A.5.2(27). @end cartouche @noindent @@ -12256,7 +12267,7 @@ Maximum image width is 6864, see library file @file{s-rannum.ads}. @sp 1 @cartouche @noindent -@strong{65}. The algorithms for random number generation. See +@strong{66}. The algorithms for random number generation. See A.5.2(32). @end cartouche @noindent @@ -12267,7 +12278,7 @@ The algorithm is the Mersenne Twister, as documented in the source file @sp 1 @cartouche @noindent -@strong{66}. The string representation of a random number generator's +@strong{67}. The string representation of a random number generator's state. See A.5.2(38). @end cartouche @noindent @@ -12278,7 +12289,7 @@ of the state vector. @sp 1 @cartouche @noindent -@strong{67}. The minimum time interval between calls to the +@strong{68}. The minimum time interval between calls to the time-dependent Reset procedure that are guaranteed to initiate different random number sequences. See A.5.2(45). @end cartouche @@ -12289,7 +12300,7 @@ random numbers is one microsecond. @sp 1 @cartouche @noindent -@strong{68}. The values of the @code{Model_Mantissa}, +@strong{69}. The values of the @code{Model_Mantissa}, @code{Model_Emin}, @code{Model_Epsilon}, @code{Model}, @code{Safe_First}, and @code{Safe_Last} attributes, if the Numerics Annex is not supported. See A.5.3(72). @@ -12301,7 +12312,7 @@ Run the compiler with @option{-gnatS} to produce a listing of package @sp 1 @cartouche @noindent -@strong{69}. Any implementation-defined characteristics of the +@strong{70}. Any implementation-defined characteristics of the input-output packages. See A.7(14). @end cartouche @noindent @@ -12311,7 +12322,7 @@ packages. @sp 1 @cartouche @noindent -@strong{70}. The value of @code{Buffer_Size} in @code{Storage_IO}. See +@strong{71}. The value of @code{Buffer_Size} in @code{Storage_IO}. See A.9(10). @end cartouche @noindent @@ -12322,7 +12333,7 @@ boundary. @sp 1 @cartouche @noindent -@strong{71}. External files for standard input, standard output, and +@strong{72}. External files for standard input, standard output, and standard error See A.10(5). @end cartouche @noindent @@ -12332,7 +12343,7 @@ libraries. See source file @file{i-cstrea.ads} for further details. @sp 1 @cartouche @noindent -@strong{72}. The accuracy of the value produced by @code{Put}. See +@strong{73}. The accuracy of the value produced by @code{Put}. See A.10.9(36). @end cartouche @noindent @@ -12343,7 +12354,7 @@ significant digit positions. @sp 1 @cartouche @noindent -@strong{73}. The meaning of @code{Argument_Count}, @code{Argument}, and +@strong{74}. The meaning of @code{Argument_Count}, @code{Argument}, and @code{Command_Name}. See A.15(1). @end cartouche @noindent @@ -12353,7 +12364,7 @@ main program in the natural manner. @sp 1 @cartouche @noindent -@strong{74}. The interpretation of the @code{Form} parameter in procedure +@strong{75}. The interpretation of the @code{Form} parameter in procedure @code{Create_Directory}. See A.16(56). @end cartouche @noindent @@ -12362,7 +12373,7 @@ The @code{Form} parameter is not used. @sp 1 @cartouche @noindent -@strong{75}. The interpretation of the @code{Form} parameter in procedure +@strong{76}. The interpretation of the @code{Form} parameter in procedure @code{Create_Path}. See A.16(60). @end cartouche @noindent @@ -12371,7 +12382,7 @@ The @code{Form} parameter is not used. @sp 1 @cartouche @noindent -@strong{76}. The interpretation of the @code{Form} parameter in procedure +@strong{77}. The interpretation of the @code{Form} parameter in procedure @code{Copy_File}. See A.16(68). @end cartouche @noindent @@ -12450,7 +12461,7 @@ Form => "mode=internal, preserve=timestamps" @sp 1 @cartouche @noindent -@strong{77}. Implementation-defined convention names. See B.1(11). +@strong{78}. Implementation-defined convention names. See B.1(11). @end cartouche @noindent The following convention names are supported @@ -12517,7 +12528,7 @@ implementations, these names are accepted silently. @sp 1 @cartouche @noindent -@strong{78}. The meaning of link names. See B.1(36). +@strong{79}. The meaning of link names. See B.1(36). @end cartouche @noindent Link names are the actual names used by the linker. @@ -12525,7 +12536,7 @@ Link names are the actual names used by the linker. @sp 1 @cartouche @noindent -@strong{79}. The manner of choosing link names when neither the link +@strong{80}. The manner of choosing link names when neither the link name nor the address of an imported or exported entity is specified. See B.1(36). @end cartouche @@ -12537,7 +12548,7 @@ letters. @sp 1 @cartouche @noindent -@strong{80}. The effect of pragma @code{Linker_Options}. See B.1(37). +@strong{81}. The effect of pragma @code{Linker_Options}. See B.1(37). @end cartouche @noindent The string passed to @code{Linker_Options} is presented uninterpreted as @@ -12558,7 +12569,7 @@ from the corresponding package spec. @sp 1 @cartouche @noindent -@strong{81}. The contents of the visible part of package +@strong{82}. The contents of the visible part of package @code{Interfaces} and its language-defined descendants. See B.2(1). @end cartouche @noindent @@ -12567,7 +12578,7 @@ See files with prefix @file{i-} in the distributed library. @sp 1 @cartouche @noindent -@strong{82}. Implementation-defined children of package +@strong{83}. Implementation-defined children of package @code{Interfaces}. The contents of the visible part of package @code{Interfaces}. See B.2(11). @end cartouche @@ -12577,7 +12588,7 @@ See files with prefix @file{i-} in the distributed library. @sp 1 @cartouche @noindent -@strong{83}. The types @code{Floating}, @code{Long_Floating}, +@strong{84}. The types @code{Floating}, @code{Long_Floating}, @code{Binary}, @code{Long_Binary}, @code{Decimal_ Element}, and @code{COBOL_Character}; and the initialization of the variables @code{Ada_To_COBOL} and @code{COBOL_To_Ada}, in @@ -12605,7 +12616,7 @@ For initialization, see the file @file{i-cobol.ads} in the distributed library. @sp 1 @cartouche @noindent -@strong{84}. Support for access to machine instructions. See C.1(1). +@strong{85}. Support for access to machine instructions. See C.1(1). @end cartouche @noindent See documentation in file @file{s-maccod.ads} in the distributed library. @@ -12613,7 +12624,7 @@ See documentation in file @file{s-maccod.ads} in the distributed library. @sp 1 @cartouche @noindent -@strong{85}. Implementation-defined aspects of access to machine +@strong{86}. Implementation-defined aspects of access to machine operations. See C.1(9). @end cartouche @noindent @@ -12622,7 +12633,7 @@ See documentation in file @file{s-maccod.ads} in the distributed library. @sp 1 @cartouche @noindent -@strong{86}. Implementation-defined aspects of interrupts. See C.3(2). +@strong{87}. Implementation-defined aspects of interrupts. See C.3(2). @end cartouche @noindent Interrupts are mapped to signals or conditions as appropriate. See @@ -12633,7 +12644,7 @@ on the interrupts supported on a particular target. @sp 1 @cartouche @noindent -@strong{87}. Implementation-defined aspects of pre-elaboration. See +@strong{88}. Implementation-defined aspects of pre-elaboration. See C.4(13). @end cartouche @noindent @@ -12643,7 +12654,7 @@ except under control of the debugger. @sp 1 @cartouche @noindent -@strong{88}. The semantics of pragma @code{Discard_Names}. See C.5(7). +@strong{89}. The semantics of pragma @code{Discard_Names}. See C.5(7). @end cartouche @noindent Pragma @code{Discard_Names} causes names of enumeration literals to @@ -12654,7 +12665,7 @@ Pos values. @sp 1 @cartouche @noindent -@strong{89}. The result of the @code{Task_Identification.Image} +@strong{90}. The result of the @code{Task_Identification.Image} attribute. See C.7.1(7). @end cartouche @noindent @@ -12684,7 +12695,7 @@ virtual address of the control block of the task. @sp 1 @cartouche @noindent -@strong{90}. The value of @code{Current_Task} when in a protected entry +@strong{91}. The value of @code{Current_Task} when in a protected entry or interrupt handler. See C.7.1(17). @end cartouche @noindent @@ -12694,7 +12705,7 @@ convenient thread, so the value of @code{Current_Task} is undefined. @sp 1 @cartouche @noindent -@strong{91}. The effect of calling @code{Current_Task} from an entry +@strong{92}. The effect of calling @code{Current_Task} from an entry body or interrupt handler. See C.7.1(19). @end cartouche @noindent @@ -12705,7 +12716,7 @@ executing the code. @sp 1 @cartouche @noindent -@strong{92}. Implementation-defined aspects of +@strong{93}. Implementation-defined aspects of @code{Task_Attributes}. See C.7.2(19). @end cartouche @noindent @@ -12714,7 +12725,7 @@ There are no implementation-defined aspects of @code{Task_Attributes}. @sp 1 @cartouche @noindent -@strong{93}. Values of all @code{Metrics}. See D(2). +@strong{94}. Values of all @code{Metrics}. See D(2). @end cartouche @noindent The metrics information for GNAT depends on the performance of the @@ -12729,7 +12740,7 @@ the required metrics. @sp 1 @cartouche @noindent -@strong{94}. The declarations of @code{Any_Priority} and +@strong{95}. The declarations of @code{Any_Priority} and @code{Priority}. See D.1(11). @end cartouche @noindent @@ -12738,7 +12749,7 @@ See declarations in file @file{system.ads}. @sp 1 @cartouche @noindent -@strong{95}. Implementation-defined execution resources. See D.1(15). +@strong{96}. Implementation-defined execution resources. See D.1(15). @end cartouche @noindent There are no implementation-defined execution resources. @@ -12746,7 +12757,7 @@ There are no implementation-defined execution resources. @sp 1 @cartouche @noindent -@strong{96}. Whether, on a multiprocessor, a task that is waiting for +@strong{97}. Whether, on a multiprocessor, a task that is waiting for access to a protected object keeps its processor busy. See D.2.1(3). @end cartouche @noindent @@ -12756,7 +12767,7 @@ object does not keep its processor busy. @sp 1 @cartouche @noindent -@strong{97}. The affect of implementation defined execution resources +@strong{98}. The affect of implementation defined execution resources on task dispatching. See D.2.1(9). @end cartouche @noindent @@ -12767,7 +12778,7 @@ underlying operating system. @sp 1 @cartouche @noindent -@strong{98}. Implementation-defined @code{policy_identifiers} allowed +@strong{99}. Implementation-defined @code{policy_identifiers} allowed in a pragma @code{Task_Dispatching_Policy}. See D.2.2(3). @end cartouche @noindent @@ -12777,7 +12788,7 @@ pragma. @sp 1 @cartouche @noindent -@strong{99}. Implementation-defined aspects of priority inversion. See +@strong{100}. Implementation-defined aspects of priority inversion. See D.2.2(16). @end cartouche @noindent @@ -12787,7 +12798,7 @@ of delay expirations for lower priority tasks. @sp 1 @cartouche @noindent -@strong{100}. Implementation-defined task dispatching. See D.2.2(18). +@strong{101}. Implementation-defined task dispatching. See D.2.2(18). @end cartouche @noindent The policy is the same as that of the underlying threads implementation. @@ -12795,7 +12806,7 @@ The policy is the same as that of the underlying threads implementation. @sp 1 @cartouche @noindent -@strong{101}. Implementation-defined @code{policy_identifiers} allowed +@strong{102}. Implementation-defined @code{policy_identifiers} allowed in a pragma @code{Locking_Policy}. See D.3(4). @end cartouche @noindent @@ -12812,7 +12823,7 @@ concurrently. @sp 1 @cartouche @noindent -@strong{102}. Default ceiling priorities. See D.3(10). +@strong{103}. Default ceiling priorities. See D.3(10). @end cartouche @noindent The ceiling priority of protected objects of the type @@ -12822,7 +12833,7 @@ Reference Manual D.3(10), @sp 1 @cartouche @noindent -@strong{103}. The ceiling of any protected object used internally by +@strong{104}. The ceiling of any protected object used internally by the implementation. See D.3(16). @end cartouche @noindent @@ -12832,7 +12843,7 @@ The ceiling priority of internal protected objects is @sp 1 @cartouche @noindent -@strong{104}. Implementation-defined queuing policies. See D.4(1). +@strong{105}. Implementation-defined queuing policies. See D.4(1). @end cartouche @noindent There are no implementation-defined queuing policies. @@ -12840,7 +12851,7 @@ There are no implementation-defined queuing policies. @sp 1 @cartouche @noindent -@strong{105}. On a multiprocessor, any conditions that cause the +@strong{106}. On a multiprocessor, any conditions that cause the completion of an aborted construct to be delayed later than what is specified for a single processor. See D.6(3). @end cartouche @@ -12851,7 +12862,7 @@ processor, there are no further delays. @sp 1 @cartouche @noindent -@strong{106}. Any operations that implicitly require heap storage +@strong{107}. Any operations that implicitly require heap storage allocation. See D.7(8). @end cartouche @noindent @@ -12861,7 +12872,7 @@ task creation. @sp 1 @cartouche @noindent -@strong{107}. Implementation-defined aspects of pragma +@strong{108}. Implementation-defined aspects of pragma @code{Restrictions}. See D.7(20). @end cartouche @noindent @@ -12870,7 +12881,7 @@ There are no such implementation-defined aspects. @sp 1 @cartouche @noindent -@strong{108}. Implementation-defined aspects of package +@strong{109}. Implementation-defined aspects of package @code{Real_Time}. See D.8(17). @end cartouche @noindent @@ -12879,7 +12890,7 @@ There are no implementation defined aspects of package @code{Real_Time}. @sp 1 @cartouche @noindent -@strong{109}. Implementation-defined aspects of +@strong{110}. Implementation-defined aspects of @code{delay_statements}. See D.9(8). @end cartouche @noindent @@ -12889,7 +12900,7 @@ delayed (see D.9(7)). @sp 1 @cartouche @noindent -@strong{110}. The upper bound on the duration of interrupt blocking +@strong{111}. The upper bound on the duration of interrupt blocking caused by the implementation. See D.12(5). @end cartouche @noindent @@ -12899,7 +12910,7 @@ no cases is it more than 10 milliseconds. @sp 1 @cartouche @noindent -@strong{111}. The means for creating and executing distributed +@strong{112}. The means for creating and executing distributed programs. See E(5). @end cartouche @noindent @@ -12909,7 +12920,7 @@ distributed programs. See the GLADE reference manual for further details. @sp 1 @cartouche @noindent -@strong{112}. Any events that can result in a partition becoming +@strong{113}. Any events that can result in a partition becoming inaccessible. See E.1(7). @end cartouche @noindent @@ -12918,7 +12929,7 @@ See the GLADE reference manual for full details on such events. @sp 1 @cartouche @noindent -@strong{113}. The scheduling policies, treatment of priorities, and +@strong{114}. The scheduling policies, treatment of priorities, and management of shared resources between partitions in certain cases. See E.1(11). @end cartouche @@ -12929,7 +12940,7 @@ multi-partition execution. @sp 1 @cartouche @noindent -@strong{114}. Events that cause the version of a compilation unit to +@strong{115}. Events that cause the version of a compilation unit to change. See E.3(5). @end cartouche @noindent @@ -12942,7 +12953,7 @@ comments. @sp 1 @cartouche @noindent -@strong{115}. Whether the execution of the remote subprogram is +@strong{116}. Whether the execution of the remote subprogram is immediately aborted as a result of cancellation. See E.4(13). @end cartouche @noindent @@ -12952,7 +12963,7 @@ a distributed application. @sp 1 @cartouche @noindent -@strong{116}. Implementation-defined aspects of the PCS@. See E.5(25). +@strong{117}. Implementation-defined aspects of the PCS@. See E.5(25). @end cartouche @noindent See the GLADE reference manual for a full description of all implementation @@ -12961,7 +12972,7 @@ defined aspects of the PCS@. @sp 1 @cartouche @noindent -@strong{117}. Implementation-defined interfaces in the PCS@. See +@strong{118}. Implementation-defined interfaces in the PCS@. See E.5(26). @end cartouche @noindent @@ -12971,7 +12982,7 @@ implementation defined interfaces. @sp 1 @cartouche @noindent -@strong{118}. The values of named numbers in the package +@strong{119}. The values of named numbers in the package @code{Decimal}. See F.2(7). @end cartouche @noindent @@ -12991,7 +13002,7 @@ implementation defined interfaces. @sp 1 @cartouche @noindent -@strong{119}. The value of @code{Max_Picture_Length} in the package +@strong{120}. The value of @code{Max_Picture_Length} in the package @code{Text_IO.Editing}. See F.3.3(16). @end cartouche @noindent @@ -13000,7 +13011,7 @@ implementation defined interfaces. @sp 1 @cartouche @noindent -@strong{120}. The value of @code{Max_Picture_Length} in the package +@strong{121}. The value of @code{Max_Picture_Length} in the package @code{Wide_Text_IO.Editing}. See F.3.4(5). @end cartouche @noindent @@ -13009,7 +13020,7 @@ implementation defined interfaces. @sp 1 @cartouche @noindent -@strong{121}. The accuracy actually achieved by the complex elementary +@strong{122}. The accuracy actually achieved by the complex elementary functions and by other complex arithmetic operations. See G.1(1). @end cartouche @noindent @@ -13019,7 +13030,7 @@ operations. Only fast math mode is currently supported. @sp 1 @cartouche @noindent -@strong{122}. The sign of a zero result (or a component thereof) from +@strong{123}. The sign of a zero result (or a component thereof) from any operator or function in @code{Numerics.Generic_Complex_Types}, when @code{Real'Signed_Zeros} is True. See G.1.1(53). @end cartouche @@ -13030,7 +13041,7 @@ implementation advice. @sp 1 @cartouche @noindent -@strong{123}. The sign of a zero result (or a component thereof) from +@strong{124}. The sign of a zero result (or a component thereof) from any operator or function in @code{Numerics.Generic_Complex_Elementary_Functions}, when @code{Real'Signed_Zeros} is @code{True}. See G.1.2(45). @@ -13042,7 +13053,7 @@ implementation advice. @sp 1 @cartouche @noindent -@strong{124}. Whether the strict mode or the relaxed mode is the +@strong{125}. Whether the strict mode or the relaxed mode is the default. See G.2(2). @end cartouche @noindent @@ -13052,7 +13063,7 @@ provides a highly efficient implementation of strict mode. @sp 1 @cartouche @noindent -@strong{125}. The result interval in certain cases of fixed-to-float +@strong{126}. The result interval in certain cases of fixed-to-float conversion. See G.2.1(10). @end cartouche @noindent @@ -13063,7 +13074,7 @@ floating-point format. @sp 1 @cartouche @noindent -@strong{126}. The result of a floating point arithmetic operation in +@strong{127}. The result of a floating point arithmetic operation in overflow situations, when the @code{Machine_Overflows} attribute of the result type is @code{False}. See G.2.1(13). @end cartouche @@ -13080,7 +13091,7 @@ properly generated. @sp 1 @cartouche @noindent -@strong{127}. The result interval for division (or exponentiation by a +@strong{128}. The result interval for division (or exponentiation by a negative exponent), when the floating point hardware implements division as multiplication by a reciprocal. See G.2.1(16). @end cartouche @@ -13090,7 +13101,7 @@ Not relevant, division is IEEE exact. @sp 1 @cartouche @noindent -@strong{128}. The definition of close result set, which determines the +@strong{129}. The definition of close result set, which determines the accuracy of certain fixed point multiplications and divisions. See G.2.3(5). @end cartouche @@ -13103,7 +13114,7 @@ is converted to the target type. @sp 1 @cartouche @noindent -@strong{129}. Conditions on a @code{universal_real} operand of a fixed +@strong{130}. Conditions on a @code{universal_real} operand of a fixed point multiplication or division for which the result shall be in the perfect result set. See G.2.3(22). @end cartouche @@ -13115,7 +13126,7 @@ representable in 64-bits. @sp 1 @cartouche @noindent -@strong{130}. The result of a fixed point arithmetic operation in +@strong{131}. The result of a fixed point arithmetic operation in overflow situations, when the @code{Machine_Overflows} attribute of the result type is @code{False}. See G.2.3(27). @end cartouche @@ -13126,7 +13137,7 @@ types. @sp 1 @cartouche @noindent -@strong{131}. The result of an elementary function reference in +@strong{132}. The result of an elementary function reference in overflow situations, when the @code{Machine_Overflows} attribute of the result type is @code{False}. See G.2.4(4). @end cartouche @@ -13136,7 +13147,7 @@ IEEE infinite and Nan values are produced as appropriate. @sp 1 @cartouche @noindent -@strong{132}. The value of the angle threshold, within which certain +@strong{133}. The value of the angle threshold, within which certain elementary functions, complex arithmetic operations, and complex elementary functions yield results conforming to a maximum relative error bound. See G.2.4(10). @@ -13147,7 +13158,7 @@ Information on this subject is not yet available. @sp 1 @cartouche @noindent -@strong{133}. The accuracy of certain elementary functions for +@strong{134}. The accuracy of certain elementary functions for parameters beyond the angle threshold. See G.2.4(10). @end cartouche @noindent @@ -13156,7 +13167,7 @@ Information on this subject is not yet available. @sp 1 @cartouche @noindent -@strong{134}. The result of a complex arithmetic operation or complex +@strong{135}. The result of a complex arithmetic operation or complex elementary function reference in overflow situations, when the @code{Machine_Overflows} attribute of the corresponding real type is @code{False}. See G.2.6(5). @@ -13167,7 +13178,7 @@ IEEE infinite and Nan values are produced as appropriate. @sp 1 @cartouche @noindent -@strong{135}. The accuracy of certain complex arithmetic operations and +@strong{136}. The accuracy of certain complex arithmetic operations and certain complex elementary functions for parameters (or components thereof) beyond the angle threshold. See G.2.6(8). @end cartouche @@ -13177,7 +13188,7 @@ Information on those subjects is not yet available. @sp 1 @cartouche @noindent -@strong{136}. Information regarding bounded errors and erroneous +@strong{137}. Information regarding bounded errors and erroneous execution. See H.2(1). @end cartouche @noindent @@ -13186,7 +13197,7 @@ Information on this subject is not yet available. @sp 1 @cartouche @noindent -@strong{137}. Implementation-defined aspects of pragma +@strong{138}. Implementation-defined aspects of pragma @code{Inspection_Point}. See H.3.2(8). @end cartouche @noindent @@ -13196,7 +13207,7 @@ be examined by the debugger at the inspection point. @sp 1 @cartouche @noindent -@strong{138}. Implementation-defined aspects of pragma +@strong{139}. Implementation-defined aspects of pragma @code{Restrictions}. See H.4(25). @end cartouche @noindent @@ -13207,7 +13218,7 @@ generated code. Checks must suppressed by use of pragma @code{Suppress}. @sp 1 @cartouche @noindent -@strong{139}. Any restrictions on pragma @code{Restrictions}. See +@strong{140}. Any restrictions on pragma @code{Restrictions}. See H.4(27). @end cartouche @noindent diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index c584560b22f..fb5abed1c43 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -770,17 +770,9 @@ package body Sem_Ch13 is Set_Has_Default_Aspect (Base_Type (Ent)); if Is_Scalar_Type (Ent) then - Set_Default_Aspect_Value (Ent, Expr); - - -- Place default value of base type as well, because that is - -- the semantics of the aspect. It is convenient to link the - -- aspect to both the (possibly anonymous) base type and to - -- the given first subtype. - Set_Default_Aspect_Value (Base_Type (Ent), Expr); - else - Set_Default_Aspect_Component_Value (Ent, Expr); + Set_Default_Aspect_Component_Value (Base_Type (Ent), Expr); end if; end Analyze_Aspect_Default_Value; @@ -9457,6 +9449,7 @@ package body Sem_Ch13 is -- Default_Component_Value if Is_Array_Type (Typ) + and then Is_Base_Type (Typ) and then Has_Rep_Item (Typ, Name_Default_Component_Value, False) and then Has_Rep_Item (Typ, Name_Default_Component_Value) then @@ -9468,6 +9461,7 @@ package body Sem_Ch13 is -- Default_Value if Is_Scalar_Type (Typ) + and then Is_Base_Type (Typ) and then Has_Rep_Item (Typ, Name_Default_Value, False) and then Has_Rep_Item (Typ, Name_Default_Value) then diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 5abe9224387..c39f3c4885c 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -3596,7 +3596,7 @@ package Sinfo is -- Sloc points to first selector name -- Choices (List1) -- Loop_Actions (List2-Sem) - -- Expression (Node3) + -- Expression (Node3) (empty if Box_Present) -- Box_Present (Flag15) -- Inherited_Discriminant (Flag13)