From: Pierre-Marie de Rodat Date: Fri, 20 Oct 2017 15:08:36 +0000 (+0000) Subject: exp_aggr.adb (Initialize_Array_Component): Avoid adjusting a component of an array... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=e201023c0e13ee6f7f62da6c58dee872a92ce359;p=gcc.git exp_aggr.adb (Initialize_Array_Component): Avoid adjusting a component of an array aggregate if... gcc/ada/ 2017-10-20 Bob Duff * exp_aggr.adb (Initialize_Array_Component): Avoid adjusting a component of an array aggregate if it is initialized by a build-in-place function call. * exp_ch6.adb (Is_Build_In_Place_Result_Type): Use -gnatd.9 to disable bip for nonlimited types. * debug.adb: Document -gnatd.9. 2017-10-20 Bob Duff * sem_ch12.adb: Remove redundant setting of Parent. 2017-10-20 Eric Botcazou * sem_ch4.adb (Find_Concatenation_Types): Filter out operators if one of the operands is a string literal. 2017-10-20 Bob Duff * einfo.ads: Comment fix. 2017-10-20 Clement Fumex * switch-c.adb: Remove -gnatwm from the switches triggered by -gnateC. 2017-10-20 Ed Schonberg * sem_dim.adb (Extract_Power): Accept dimension values that are not non-negative integers when the dimensioned base type is an Integer type. gcc/testsuite/ 2017-10-20 Ed Schonberg * gnat.dg/dimensions.adb, gnat.dg/dimensions.ads: New testcase. From-SVN: r253941 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index af7038eaa79..24618873c15 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +2017-10-20 Bob Duff + + * exp_aggr.adb (Initialize_Array_Component): Avoid adjusting a + component of an array aggregate if it is initialized by a + build-in-place function call. + * exp_ch6.adb (Is_Build_In_Place_Result_Type): Use -gnatd.9 to disable + bip for nonlimited types. + * debug.adb: Document -gnatd.9. + +2017-10-20 Bob Duff + + * sem_ch12.adb: Remove redundant setting of Parent. + +2017-10-20 Eric Botcazou + + * sem_ch4.adb (Find_Concatenation_Types): Filter out operators if one + of the operands is a string literal. + +2017-10-20 Bob Duff + + * einfo.ads: Comment fix. + +2017-10-20 Clement Fumex + + * switch-c.adb: Remove -gnatwm from the switches triggered by -gnateC. + +2017-10-20 Ed Schonberg + + * sem_dim.adb (Extract_Power): Accept dimension values that are not + non-negative integers when the dimensioned base type is an Integer + type. + 2017-10-20 Bob Duff * sinfo.ads, sinfo.adb (Alloc_For_BIP_Return): New flag to indicate diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index b8d61a86095..e3d875bc8cc 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -646,8 +646,9 @@ package body Bindgen is -- stack globals. if Sec_Stack_Used then - -- Elaborate the body of the binder to initialize the - -- default-sized secondary stack pool. + + -- Elaborate the body of the binder to initialize the default- + -- sized secondary stack pool. WBI (""); WBI (" " & Get_Ada_Main_Name & "'Elab_Body;"); @@ -656,12 +657,13 @@ package body Bindgen is -- related secondary stack globals. Set_String (" Default_Secondary_Stack_Size := "); + if Opt.Default_Sec_Stack_Size /= Opt.No_Stack_Size then Set_Int (Opt.Default_Sec_Stack_Size); else - Set_String - ("System.Parameters.Runtime_Default_Sec_Stack_Size"); + Set_String ("System.Parameters.Runtime_Default_Sec_Stack_Size"); end if; + Set_Char (';'); Write_Statement_Buffer; @@ -988,8 +990,9 @@ package body Bindgen is -- stack globals. if Sec_Stack_Used then - -- Elaborate the body of the binder to initialize the - -- default-sized secondary stack pool. + + -- Elaborate the body of the binder to initialize the default- + -- sized secondary stack pool. WBI (" " & Get_Ada_Main_Name & "'Elab_Body;"); @@ -997,11 +1000,13 @@ package body Bindgen is -- related secondary stack globals. Set_String (" Default_Secondary_Stack_Size := "); + if Opt.Default_Sec_Stack_Size /= Opt.No_Stack_Size then Set_Int (Opt.Default_Sec_Stack_Size); else Set_String ("System.Parameters.Runtime_Default_Sec_Stack_Size"); end if; + Set_Char (';'); Write_Statement_Buffer; @@ -1011,17 +1016,19 @@ package body Bindgen is Write_Statement_Buffer; Set_String (" Default_Sized_SS_Pool := "); + if Num_Sec_Stacks > 0 then Set_String ("Sec_Default_Sized_Stacks'Address;"); else Set_String ("System.Null_Address;"); end if; - Write_Statement_Buffer; + Write_Statement_Buffer; WBI (""); end if; -- Generate call to Runtime_Initialize + WBI (" Runtime_Initialize (1);"); end if; @@ -2195,9 +2202,11 @@ package body Bindgen is end if; for J in Units.First .. Units.Last loop - Num_Primary_Stacks := Num_Primary_Stacks + - Units.Table (J).Primary_Stack_Count; - Num_Sec_Stacks := Num_Sec_Stacks + Units.Table (J).Sec_Stack_Count; + Num_Primary_Stacks := + Num_Primary_Stacks + Units.Table (J).Primary_Stack_Count; + + Num_Sec_Stacks := + Num_Sec_Stacks + Units.Table (J).Sec_Stack_Count; end loop; -- Generate output file in appropriate language @@ -2525,11 +2534,13 @@ package body Bindgen is Set_String (" : array (1 .. "); Set_Int (Num_Sec_Stacks); Set_String (") of aliased System.Secondary_Stack.SS_Stack ("); + if Opt.Default_Sec_Stack_Size /= No_Stack_Size then Set_Int (Opt.Default_Sec_Stack_Size); else Set_String ("System.Parameters.Runtime_Default_Sec_Stack_Size"); end if; + Set_String (");"); Write_Statement_Buffer; WBI (""); @@ -2568,8 +2579,8 @@ package body Bindgen is if not Suppress_Standard_Library_On_Target then - -- The B.1(39) implementation advice says that the adainit - -- and adafinal routines should be idempotent. Generate a flag to + -- The B.1(39) implementation advice says that the adainit and + -- adafinal routines should be idempotent. Generate a flag to -- ensure that. This is not needed if we are suppressing the -- standard library since it would never be referenced. diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 2a812046247..442ce0873e5 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -163,7 +163,7 @@ package body Debug is -- d.6 Do not avoid declaring unreferenced types in C code -- d.7 -- d.8 - -- d.9 Enable build-in-place for nonlimited types + -- d.9 Disable build-in-place for nonlimited types -- Debug flags for binder (GNATBIND) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index d20440bcbf2..2b2a8382e3b 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1312,9 +1312,9 @@ package Einfo is -- that represents an activation record pointer is an extra formal. -- Extra_Formals (Node28) --- Applies to subprograms and subprogram types, and also to entries --- and entry families. Returns first extra formal of the subprogram --- or entry. Returns Empty if there are no extra formals. +-- Applies to subprograms, subprogram types, entries, and entry +-- families. Returns first extra formal of the subprogram or entry. +-- Returns Empty if there are no extra formals. -- Finalization_Master (Node23) [root type only] -- Defined in access-to-controlled or access-to-class-wide types. The diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 9faed933b9f..86621a4a06a 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -1251,6 +1251,7 @@ package body Exp_Aggr is if Finalization_OK and then not Is_Limited_Type (Comp_Typ) + and then not Is_Build_In_Place_Function_Call (Init_Expr) and then not (Is_Array_Type (Comp_Typ) and then Is_Controlled (Component_Type (Comp_Typ)) diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 55c6ec6f662..70d39b7a916 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -1765,7 +1765,6 @@ package body Exp_Attr is if Attribute_Name (Parent (Pref)) = Name_Old then null; - else Make_Build_In_Place_Call_In_Anonymous_Context (Pref); end if; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index ea739384d69..043a02c64ba 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -5792,6 +5792,7 @@ package body Exp_Ch3 is Sec_Stacks : out Int) is Component : Entity_Id; + begin -- To calculate the number of default-sized task stacks required for -- an object of Typ, a depth-first recursive traversal of the AST @@ -5806,8 +5807,8 @@ package body Exp_Ch3 is end if; case Ekind (Typ) is - when E_Task_Type - | E_Task_Subtype + when E_Task_Subtype + | E_Task_Type => -- A task type is found marking the bottom of the descent. If -- the type has no representation aspect for the corresponding @@ -5825,8 +5826,8 @@ package body Exp_Ch3 is Sec_Stacks := 1; end if; - when E_Array_Type - | E_Array_Subtype + when E_Array_Subtype + | E_Array_Type => -- First find the number of default stacks contained within an -- array component. @@ -5848,10 +5849,10 @@ package body Exp_Ch3 is Sec_Stacks := Sec_Stacks * Quantity; end; - when E_Record_Type - | E_Record_Subtype + when E_Protected_Subtype | E_Protected_Type - | E_Protected_Subtype + | E_Record_Subtype + | E_Record_Type => Component := First_Component_Or_Discriminant (Typ); @@ -5862,7 +5863,9 @@ package body Exp_Ch3 is while Present (Component) loop if Has_Task (Etype (Component)) then declare - P, S : Int; + P : Int; + S : Int; + begin Count_Default_Sized_Task_Stacks (Etype (Component), P, S); @@ -5874,10 +5877,10 @@ package body Exp_Ch3 is Next_Component_Or_Discriminant (Component); end loop; - when E_Limited_Private_Type - | E_Limited_Private_Subtype - | E_Record_Type_With_Private + when E_Limited_Private_Subtype + | E_Limited_Private_Type | E_Record_Subtype_With_Private + | E_Record_Type_With_Private => -- Switch to the full view of the private type to continue -- search. diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 7a72a366c6d..abf6d635451 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -5564,6 +5564,7 @@ package body Exp_Ch4 is declare Cnn : constant Entity_Id := Make_Temporary (Loc, 'C', N); Ptr_Typ : constant Entity_Id := Make_Temporary (Loc, 'A'); + begin -- Generate: -- type Ann is access all Typ; @@ -5641,6 +5642,7 @@ package body Exp_Ch4 is then declare Cnn : constant Node_Id := Make_Temporary (Loc, 'C', N); + begin Insert_Action (N, Make_Object_Declaration (Loc, @@ -5681,6 +5683,7 @@ package body Exp_Ch4 is declare Cnn : constant Node_Id := Make_Temporary (Loc, 'C', N); + begin Decl := Make_Object_Declaration (Loc, diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 593a0d041cc..c7cd2a664e1 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -7248,7 +7248,12 @@ package body Exp_Ch6 is if Is_Limited_View (Typ) then return Ada_Version >= Ada_2005 and then not Debug_Flag_Dot_L; + else + if Debug_Flag_Dot_9 then + return False; + end if; + if Has_Interfaces (Typ) then return False; end if; @@ -7284,16 +7289,15 @@ package body Exp_Ch6 is declare Result : Boolean; + -- So we can stop here in the debugger begin -- ???For now, enable build-in-place for a very narrow set of -- controlled types. Change "if True" to "if False" to -- experiment more controlled types. Eventually, we would -- like to enable build-in-place for all tagged types, all -- types that need finalization, and all caller-unknown-size - -- types. We will eventually use Debug_Flag_Dot_9 to disable - -- build-in-place for nonlimited types. + -- types. --- if Debug_Flag_Dot_9 then if True then Result := Is_Controlled (T) and then Present (Enclosing_Subprogram (T)) diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index be205e47a7e..bcac6ff02b0 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -5432,8 +5432,8 @@ package body Exp_Ch9 is (Restriction_Active (No_Implicit_Heap_Allocations) or else Restriction_Active (No_Implicit_Task_Allocations)) and then not Restriction_Active (No_Secondary_Stack) - and then Has_Rep_Item (T, Name_Secondary_Stack_Size, - Check_Parents => False); + and then Has_Rep_Item + (T, Name_Secondary_Stack_Size, Check_Parents => False); end Create_Secondary_Stack_For_Task; ------------------------------------- @@ -11978,8 +11978,7 @@ package body Exp_Ch9 is Get_Rep_Item (TaskId, Name_Secondary_Stack_Size, Check_Parents => False); - -- Get Secondary_Stack_Size expression. Can be a pragma or - -- aspect. + -- Get Secondary_Stack_Size expression. Can be a pragma or aspect. if Nkind (Ritem) = N_Pragma then Size_Expr := @@ -11993,21 +11992,22 @@ package body Exp_Ch9 is -- Create the secondary stack for the task - Decl_SS := Make_Component_Declaration (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, Name_uSecondary_Stack), - - Component_Definition => - Make_Component_Definition (Loc, - Aliased_Present => True, - Subtype_Indication => Make_Subtype_Indication (Loc, - Subtype_Mark => - New_Occurrence_Of (RTE (RE_SS_Stack), Loc), - Constraint => - Make_Index_Or_Discriminant_Constraint (Loc, - Constraints => New_List ( - Make_Integer_Literal (Loc, - Expr_Value (Size_Expr))))))); + Decl_SS := + Make_Component_Declaration (Loc, + Defining_Identifier => + Make_Defining_Identifier (Loc, Name_uSecondary_Stack), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => True, + Subtype_Indication => + Make_Subtype_Indication (Loc, + Subtype_Mark => + New_Occurrence_Of (RTE (RE_SS_Stack), Loc), + Constraint => + Make_Index_Or_Discriminant_Constraint (Loc, + Constraints => New_List ( + Make_Integer_Literal (Loc, + Expr_Value (Size_Expr))))))); Append_To (Cdecls, Decl_SS); end; @@ -14223,8 +14223,8 @@ package body Exp_Ch9 is Prefix => Make_Selected_Component (Loc, Prefix => Make_Identifier (Loc, Name_uInit), - Selector_Name => - Make_Identifier (Loc, Name_uSecondary_Stack)), + Selector_Name => + Make_Identifier (Loc, Name_uSecondary_Stack)), Attribute_Name => Name_Unrestricted_Access)); else diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 4d6ec05a24f..2fb0e88346f 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -10820,7 +10820,10 @@ package body Exp_Util is -- Could be e.g. a loop that was transformed into a block or null -- statement. Do nothing for terminate alternatives. - when N_Block_Statement | N_Null_Statement | N_Terminate_Alternative => + when N_Block_Statement + | N_Null_Statement + | N_Terminate_Alternative + => null; when others => diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index f2b195c75c2..c9686992f5a 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -455,16 +455,19 @@ package Lib is function Generate_Code (U : Unit_Number_Type) return Boolean; function Ident_String (U : Unit_Number_Type) return Node_Id; function Has_RACW (U : Unit_Number_Type) return Boolean; - function Is_Predefined_Renaming (U : Unit_Number_Type) return Boolean; - function Is_Internal_Unit (U : Unit_Number_Type) return Boolean; - function Is_Predefined_Unit (U : Unit_Number_Type) return Boolean; + function Is_Predefined_Renaming + (U : Unit_Number_Type) return Boolean; + function Is_Internal_Unit (U : Unit_Number_Type) return Boolean; + function Is_Predefined_Unit + (U : Unit_Number_Type) return Boolean; function Loading (U : Unit_Number_Type) return Boolean; function Main_CPU (U : Unit_Number_Type) return Int; function Main_Priority (U : Unit_Number_Type) return Int; function Munit_Index (U : Unit_Number_Type) return Nat; function No_Elab_Code_All (U : Unit_Number_Type) return Boolean; function OA_Setting (U : Unit_Number_Type) return Character; - function Primary_Stack_Count (U : Unit_Number_Type) return Int; + function Primary_Stack_Count + (U : Unit_Number_Type) return Int; function Sec_Stack_Count (U : Unit_Number_Type) return Int; function Source_Index (U : Unit_Number_Type) return Source_File_Index; function Unit_File_Name (U : Unit_Number_Type) return File_Name_Type; diff --git a/gcc/ada/libgnat/s-parame.adb b/gcc/ada/libgnat/s-parame.adb index 27e352f2b46..359edacb95e 100644 --- a/gcc/ada/libgnat/s-parame.adb +++ b/gcc/ada/libgnat/s-parame.adb @@ -61,8 +61,10 @@ package body System.Parameters is begin -- There are two situations where the default secondary stack size is -- set to zero: + -- -- * The user sets it to zero erroneously thinking it will disable -- the secondary stack. + -- -- * Or more likely, we are building with an old compiler and -- Default_SS_Size is never set. -- diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 223703d2a43..9820330f523 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -5305,8 +5305,7 @@ package body Sem_Ch12 is Valid_Operator_Definition (Act_Decl_Id); end if; - Set_Alias (Act_Decl_Id, Anon_Id); - Set_Parent (Act_Decl_Id, Parent (Anon_Id)); + Set_Alias (Act_Decl_Id, Anon_Id); Set_Has_Completion (Act_Decl_Id); Set_Related_Instance (Pack_Id, Act_Decl_Id); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index fad52ebd106..538023524e3 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -6431,10 +6431,24 @@ package body Sem_Ch4 is Op_Id : Entity_Id; N : Node_Id) is - Op_Type : constant Entity_Id := Etype (Op_Id); + Is_String : constant Boolean := Nkind (L) = N_String_Literal + or else + Nkind (R) = N_String_Literal; + Op_Type : constant Entity_Id := Etype (Op_Id); begin if Is_Array_Type (Op_Type) + + -- Small but very effective optimization: if at least one operand is a + -- string literal, then the type of the operator must be either array + -- of characters or array of strings. + + and then (not Is_String + or else + Is_Character_Type (Component_Type (Op_Type)) + or else + Is_String_Type (Component_Type (Op_Type))) + and then not Is_Limited_Type (Op_Type) and then (Has_Compatible_Type (L, Op_Type) diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb index 6330703e071..2363eedc69a 100644 --- a/gcc/ada/sem_dim.adb +++ b/gcc/ada/sem_dim.adb @@ -518,25 +518,17 @@ package body Sem_Dim is Position : Dimension_Position) is begin - -- Integer case - - if Is_Integer_Type (Def_Id) then - - -- Dimension value must be an integer literal - - if Nkind (Expr) = N_Integer_Literal then - Dimensions (Position) := +Whole (UI_To_Int (Intval (Expr))); - else - Error_Msg_N ("integer literal expected", Expr); - end if; + Dimensions (Position) := Create_Rational_From (Expr, True); + Processed (Position) := True; - -- Float case + -- If the dimensioned root type is an integer type, it is not + -- particularly useful, and fractional dimensions do not make + -- much sense for such types, so previously we used to reject + -- dimensions of integer types that were not integer literals. + -- However, the manipulation of dimensions does not depend on + -- the kind of root type, so we can accept this usage for rare + -- cases where dimensions are specified for integer values. - else - Dimensions (Position) := Create_Rational_From (Expr, True); - end if; - - Processed (Position) := True; end Extract_Power; ------------------------ diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index f0562ae59a6..eae149805fa 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -13242,25 +13242,21 @@ package body Sem_Prag is Set_SCO_Pragma_Enabled (Loc); end if; - -- Deal with analyzing the string argument + -- Deal with analyzing the string argument. If checks are not + -- on we don't want any expansion (since such expansion would + -- not get properly deleted) but we do want to analyze (to get + -- proper references). The Preanalyze_And_Resolve routine does + -- just what we want. Ditto if pragma is active, because it will + -- be rewritten as an if-statement whose analysis will complete + -- analysis and expansion of the string message. This makes a + -- difference in the unusual case where the expression for the + -- string may have a side effect, such as raising an exception. + -- This is mandated by RM 11.4.2, which specifies that the string + -- expression is only evaluated if the check fails and + -- Assertion_Error is to be raised. if Arg_Count = 3 then - - -- If checks are not on we don't want any expansion (since - -- such expansion would not get properly deleted) but - -- we do want to analyze (to get proper references). - -- The Preanalyze_And_Resolve routine does just what we want. - -- Ditto if pragma is active, because it will be rewritten - -- as an if-statement whose analysis will complete analysis - -- and expansion of the string message. This makes a - -- difference in the unusual case where the expression for - -- the string may have a side effect, such as raising an - -- exception. This is mandated by RM 11.4.2, which specifies - -- that the string expression is only evaluated if the - -- check fails and Assertion_Error is to be raised. - Preanalyze_And_Resolve (Str, Standard_String); - end if; -- Now you might think we could just do the same with the Boolean diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 68c1a0892a6..f5c5f9e96dc 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -4843,9 +4843,8 @@ package body Sem_Res is (Comes_From_Source (Parent (N)) or else (Ekind (Current_Scope) = E_Function - and then Nkind - (Original_Node (Unit_Declaration_Node (Current_Scope))) - = N_Expression_Function)) + and then Nkind (Original_Node (Unit_Declaration_Node + (Current_Scope))) = N_Expression_Function)) and then not In_Instance_Body then if not OK_For_Limited_Init (Etype (E), Expression (E)) then diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index cd6b2006e22..5ad10e348a5 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -548,7 +548,6 @@ package body Switch.C is Warn_On_Bad_Fixed_Value := True; -- -gnatwb Warn_On_Biased_Representation := True; -- -gnatw.b Warn_On_Export_Import := True; -- -gnatwx - Warn_On_Modified_Unread := True; -- -gnatwm Warn_On_No_Value_Assigned := True; -- -gnatwv Warn_On_Object_Renames_Function := True; -- -gnatw.r Warn_On_Overlap := True; -- -gnatw.i diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d3d10ddb2bd..30d3203b186 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2017-10-20 Ed Schonberg + + * gnat.dg/dimensions.adb, gnat.dg/dimensions.ads: New testcase. + 2017-10-20 Richard Biener PR tree-optimization/82473 diff --git a/gcc/testsuite/gnat.dg/dimensions.adb b/gcc/testsuite/gnat.dg/dimensions.adb new file mode 100644 index 00000000000..86fc6eef670 --- /dev/null +++ b/gcc/testsuite/gnat.dg/dimensions.adb @@ -0,0 +1,5 @@ +-- { dg-do compile } + +package body Dimensions is + procedure Dummy is null; +end Dimensions; diff --git a/gcc/testsuite/gnat.dg/dimensions.ads b/gcc/testsuite/gnat.dg/dimensions.ads new file mode 100644 index 00000000000..54bab081470 --- /dev/null +++ b/gcc/testsuite/gnat.dg/dimensions.ads @@ -0,0 +1,29 @@ +package Dimensions is + + type Mks_Int_Type is new Integer + with + Dimension_System => ( + (Unit_Name => Meter, Unit_Symbol => 'm', Dim_Symbol => 'L'), + (Unit_Name => Kilogram, Unit_Symbol => "kg", Dim_Symbol => 'M'), + (Unit_Name => Second, Unit_Symbol => 's', Dim_Symbol => 'T'), + (Unit_Name => Ampere, Unit_Symbol => 'A', Dim_Symbol => 'I'), + (Unit_Name => Kelvin, Unit_Symbol => 'K', Dim_Symbol => '@'), + (Unit_Name => Mole, Unit_Symbol => "mol", Dim_Symbol => 'N'), + (Unit_Name => Candela, Unit_Symbol => "cd", Dim_Symbol => 'J')); + + subtype Int_Length is Mks_Int_Type + with + Dimension => (Symbol => 'm', + Meter => 1, + others => 0); + + subtype Int_Speed is Mks_Int_Type + with + Dimension => ( + Meter => 1, + Second => -1, + others => 0); + + procedure Dummy; + +end Dimensions;