From 9b7924dd177330167865a83f5696a9ae34554972 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 21 Apr 2016 10:57:30 +0200 Subject: [PATCH] [multiple changes] 2016-04-21 Eric Botcazou * gnatlink.adb (Gnatlink): Robustify detection of Windows target. * alloc.ads: Minor comment fixes. * einfo.ads: Fix typo. 2016-04-21 Arnaud Charlet * exp_aggr.adb (Component_Not_OK_For_Backend): Redo previous changes to handle all cases of components depending on the discriminant, not just string literals. 2016-04-21 Ed Schonberg * sem_ch3.adb (Analyze_Subtype_Declaration): If the subtype declaration is the generated declaration for a generic actual, inherit predicates from the actual if it is a predicated subtype. 2016-04-21 Ed Schonberg * exp_ch6.adb (Rewrite_Function_Call_For_C): If the function is inherited and its result is controlling, introduce a conversion on the actual for the corresponding procedure call, to avoid spurious type errors. 2016-04-21 Jerome Lambourg * krunch.adb (Krunch): Fix krunching of i-vxworks. From-SVN: r235317 --- gcc/ada/ChangeLog | 29 +++++++++++++++++++++++++++++ gcc/ada/alloc.ads | 10 +++++----- gcc/ada/einfo.ads | 6 +++--- gcc/ada/exp_aggr.adb | 25 ++++++++++++++++++++++++- gcc/ada/exp_ch6.adb | 17 +++++++++++++++-- gcc/ada/gnatlink.adb | 13 +++++++------ gcc/ada/krunch.adb | 2 +- gcc/ada/sem_ch3.adb | 18 ++++++++++++++++++ 8 files changed, 102 insertions(+), 18 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c4845dc9f1e..ced75bf61e0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2016-04-21 Eric Botcazou + + * gnatlink.adb (Gnatlink): Robustify detection of Windows target. + * alloc.ads: Minor comment fixes. + * einfo.ads: Fix typo. + +2016-04-21 Arnaud Charlet + + * exp_aggr.adb (Component_Not_OK_For_Backend): Redo previous + changes to handle all cases of components depending on the + discriminant, not just string literals. + +2016-04-21 Ed Schonberg + + * sem_ch3.adb (Analyze_Subtype_Declaration): If the subtype + declaration is the generated declaration for a generic actual, + inherit predicates from the actual if it is a predicated subtype. + +2016-04-21 Ed Schonberg + + * exp_ch6.adb (Rewrite_Function_Call_For_C): If the function is + inherited and its result is controlling, introduce a conversion + on the actual for the corresponding procedure call, to avoid + spurious type errors. + +2016-04-21 Jerome Lambourg + + * krunch.adb (Krunch): Fix krunching of i-vxworks. + 2016-04-21 Gary Dismukes * exp_aggr.adb: Minor reformatting and code cleanup. diff --git a/gcc/ada/alloc.ads b/gcc/ada/alloc.ads index e175f8b433d..4cdb1d23d26 100644 --- a/gcc/ada/alloc.ads +++ b/gcc/ada/alloc.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -30,14 +30,14 @@ ------------------------------------------------------------------------------ -- This package contains definitions for initial sizes and growth increments --- for the various dynamic arrays used for principle compiler data strcutures. +-- for the various dynamic arrays used for the main compiler data structures. -- The indicated initial size is allocated for the start of each file, and -- the increment factor is a percentage used to increase the table size when -- it needs expanding (e.g. a value of 100 = 100% increase = double) --- Note: the initial values here are multiplied by Table_Factor, as set --- by the -gnatTnn switch. This variable is defined in Opt, as is the --- default value for the table factor. +-- Note: the initial values here are multiplied by Table_Factor as set by the +-- -gnatTnn switch. This variable is defined in Opt, as is the default value +-- for the table factor. package Alloc is diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index d403f77d830..84ce2e2cb24 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -4170,9 +4170,9 @@ package Einfo is -- of the predicate function. This is the original expression given as -- the predicate except that occurrences of the type are replaced by -- occurrences of the formal parameter of the predicate function (note --- that the spec of this function including this formal parameter name) --- is available from the Subprograms_For_Type field (it can be accessed --- as Predicate_Function (typ). Also, in the case where a predicate is +-- that the spec of this function including this formal parameter name +-- is available from the Subprograms_For_Type field; it can be accessed +-- as Predicate_Function (typ)). Also, in the case where a predicate is -- inherited, the expression is of the form: -- -- xxxPredicate (typ2 (ent)) AND THEN expression diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 5d6907b67a2..efaee5e6766 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -5918,6 +5918,10 @@ package body Exp_Aggr is -- semantics of Ada complicate the analysis and lead to anomalies in -- the gcc back-end if the aggregate is not expanded into assignments. + function Has_Per_Object_Constraint (L : List_Id) return Boolean; + -- Return True if any element of L has Has_Per_Object_Constraint set. + -- L should be the Choices component of an N_Component_Association. + function Has_Visible_Private_Ancestor (Id : E) return Boolean; -- If any ancestor of the current type is private, the aggregate -- cannot be built in place. We cannot rely on Has_Private_Ancestor, @@ -6024,7 +6028,8 @@ package body Exp_Aggr is return True; elsif Modify_Tree_For_C - and then Ekind (Etype (Expr_Q)) = E_String_Literal_Subtype + and then Nkind (C) = N_Component_Association + and then Has_Per_Object_Constraint (Choices (C)) then Static_Components := False; return True; @@ -6051,6 +6056,24 @@ package body Exp_Aggr is return False; end Component_Not_OK_For_Backend; + ------------------------------- + -- Has_Per_Object_Constraint -- + ------------------------------- + + function Has_Per_Object_Constraint (L : List_Id) return Boolean is + N : Node_Id := First (L); + begin + while Present (N) loop + if Has_Per_Object_Constraint (Associated_Node (N)) then + return True; + end if; + + Next (N); + end loop; + + return False; + end Has_Per_Object_Constraint; + ----------------------------------- -- Has_Visible_Private_Ancestor -- ----------------------------------- diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 162849eac0f..599e46235c4 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -8432,11 +8432,13 @@ package body Exp_Ch6 is -- Local variables - Func_Id : constant Entity_Id := Ultimate_Alias (Entity (Name (N))); + Orig_Func : constant Entity_Id := Entity (Name (N)); + Func_Id : constant Entity_Id := Ultimate_Alias (Orig_Func); Par : constant Node_Id := Parent (N); Proc_Id : constant Entity_Id := Rewritten_For_C_Proc_Id (Func_Id); Loc : constant Source_Ptr := Sloc (Par); Actuals : List_Id; + Last_Actual : Node_Id; Last_Formal : Entity_Id; -- Start of processing for Rewrite_Function_Call_For_C @@ -8467,12 +8469,23 @@ package body Exp_Ch6 is -- Proc_Call (..., LHS); + -- If function is inherited, a conversion may be necessary. + if Nkind (Par) = N_Assignment_Statement then + Last_Actual := Name (Par); + + if not Comes_From_Source (Orig_Func) + and then Etype (Orig_Func) /= Etype (Func_Id) + then + Last_Actual := + Unchecked_Convert_To (Etype (Func_Id), Last_Actual); + end if; + Append_To (Actuals, Make_Parameter_Association (Loc, Selector_Name => Make_Identifier (Loc, Chars (Last_Formal)), - Explicit_Actual_Parameter => Name (Par))); + Explicit_Actual_Parameter => Last_Actual)); Rewrite (Par, Make_Procedure_Call_Statement (Loc, diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index a46580acf26..74170933950 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -154,6 +154,8 @@ procedure Gnatlink is Base_Command_Name : String_Access; + Target_Debuggable_Suffix : String_Access; + Tname : Temp_File_Name; Tname_FD : File_Descriptor := Invalid_FD; -- Temporary file used by linker to pass list of object files on @@ -1646,12 +1648,14 @@ begin Write_Header; + Target_Debuggable_Suffix := Get_Target_Debuggable_Suffix; + -- If no output name specified, then use the base name of .ali file name if Output_File_Name = null then Output_File_Name := new String'(Base_Name (Ali_File_Name.all) - & Get_Target_Debuggable_Suffix.all); + & Target_Debuggable_Suffix.all); end if; Linker_Options.Increment_Last; @@ -1711,12 +1715,9 @@ begin FN (J) := Csets.Fold_Lower (FN (J)); end loop; - -- For now we detect windows by an output executable name ending with - -- the suffix .exe. + -- For now we detect Windows by its executable suffix of .exe - if FN'Length > 5 - and then FN (FN'Last - 3 .. FN'Last) = ".exe" - then + if Target_Debuggable_Suffix.all = ".exe" then Check_File_Name ("install"); Check_File_Name ("setup"); Check_File_Name ("update"); diff --git a/gcc/ada/krunch.adb b/gcc/ada/krunch.adb index 6c3b785452a..12b8f713711 100644 --- a/gcc/ada/krunch.adb +++ b/gcc/ada/krunch.adb @@ -106,7 +106,7 @@ begin or else (Curlen = 13 and then Buffer (3 .. 13) = "definitions") or else (Curlen = 9 and then Buffer (3 .. 9) = "fortran") or else (Curlen = 16 and then Buffer (3 .. 16) = "packed_decimal") - or else (Curlen > 9 and then Buffer (3 .. 9) = "vxworks") + or else (Curlen > 8 and then Buffer (3 .. 9) = "vxworks") then Krlen := 8; else diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 615a7d25e75..19f4844a6bc 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -5063,6 +5063,24 @@ package body Sem_Ch3 is Set_Is_Generic_Actual_Type (Id, Is_Generic_Actual_Type (T)); end if; + -- If this is a subtype declaration for an actual in an instance, + -- inherit static and dynamic predicates if any. + + if In_Instance + and then not Comes_From_Source (N) + and then Has_Predicates (T) + and then Present (Predicate_Function (T)) + then + Set_Subprograms_For_Type (Id, Subprograms_For_Type (T)); + + if Has_Static_Predicate (T) then + Set_Static_Discrete_Predicate (Id, + Static_Discrete_Predicate (T)); + end if; + end if; + + -- Remaining processing depends on characteristics of base type + T := Etype (Id); Set_Is_Immediately_Visible (Id, True);