+2016-04-21 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnatlink.adb (Gnatlink): Robustify detection of Windows target.
+ * alloc.ads: Minor comment fixes.
+ * einfo.ads: Fix typo.
+
+2016-04-21 Arnaud Charlet <charlet@adacore.com>
+
+ * 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 <schonberg@adacore.com>
+
+ * 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 <schonberg@adacore.com>
+
+ * 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 <lambourg@adacore.com>
+
+ * krunch.adb (Krunch): Fix krunching of i-vxworks.
+
2016-04-21 Gary Dismukes <dismukes@adacore.com>
* exp_aggr.adb: Minor reformatting and code cleanup.
-- --
-- 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- --
------------------------------------------------------------------------------
-- 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
-- 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
-- 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,
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;
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 --
-----------------------------------
-- 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
-- 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,
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
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;
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");
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
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);
projects / gcc.git / commitdiff