+2015-10-26 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_disp.adb (Check_Controlling_Type): Handle properly the
+ case of an incomplete type whose full view is tagged, when a
+ primitive operation of the type is declared between the two views.
+
+2015-10-26 Bob Duff <duff@adacore.com>
+
+ * adaint.c (__gnat_locate_exec_on_path): If the PATH environment
+ variable is not set, do not return NULL, because we can still find
+ the executable if it includes a directory name.
+
+2015-10-26 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_elab.adb (Elab_Warning): Under dynamic elaboration, when
+ elaboration warnings are enabled, emit proper warning header
+ when triggered by an access attribute.
+
+2015-10-26 Steve Baird <baird@adacore.com>
+
+ * exp_ch11.adb: If CodePeer_Mode is true, generate simplified
+ SCIL for exception declarations.
+ * exp_ch11.adb (Expand_N_Exception_Declaration) If CodePeer_Mode
+ is True, initialize the Full_Name component of the exception
+ record to null instead of to the result of an unchecked
+ conversion.
+
+2015-10-26 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_unst.adb (Note_Uplevel_Ref) : Handle properly a reference
+ that denotes a function returning a constrained array, that has
+ been rewritten as a procedure.
+ * makeutl.ads: Minor edit.
+
2015-10-26 Yannick Moy <moy@adacore.com>
* lib-xref-spark_specific.adb (Traverse_Protected_Declaration): New
apath_val = (char *) alloca (EXPAND_BUFFER_SIZE);
WS2SC (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
- return __gnat_locate_exec (exec_name, apath_val);
#else
char *path_val = getenv ("PATH");
- if (path_val == NULL) return NULL;
+ /* If PATH is not defined, proceed with __gnat_locate_exec anyway, so we can
+ find files that contain directory names. */
+
+ if (path_val == NULL) path_val = "";
apath_val = (char *) alloca (strlen (path_val) + 1);
strcpy (apath_val, path_val);
- return __gnat_locate_exec (exec_name, apath_val);
#endif
+
+ return __gnat_locate_exec (exec_name, apath_val);
}
/* Dummy functions for Osint import for non-VMS systems.
-- Full_Name component: Standard.A_Char!(Nam'Address)
- Append_To (L, Unchecked_Convert_To (Standard_A_Char,
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Ex_Id, Loc),
- Attribute_Name => Name_Address)));
+ -- The unchecked conversion causes capacity issues for CodePeer in some
+ -- cases and is never useful, so we set the Full_Name component to null
+ -- instead for CodePeer.
+
+ if CodePeer_Mode then
+ Append_To (L, Make_Null (Loc));
+ else
+ Append_To (L, Unchecked_Convert_To (Standard_A_Char,
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Ex_Id, Loc),
+ Attribute_Name => Name_Address)));
+ end if;
-- HTable_Ptr component: null
if Caller = Callee then
return;
+
+ -- Callee may be a function that returns an array, and
+ -- that has been rewritten as a procedure. If caller is
+ -- that procedure, nothing to do either.
+
+ elsif Ekind (Callee) = E_Function
+ and then Rewritten_For_C (Callee)
+ and then Next_Entity (Callee) = Caller
+ then
+ return;
end if;
-- We have a new uplevel referenced entity
function Number_Of_Mains (Tree : Project_Tree_Ref) return Natural;
-- Returns the number of mains in this project tree (if Tree is null, it
- -- returns the total number of project trees)
+ -- returns the total number of project trees).
procedure Fill_From_Project
(Root_Project : Project_Id;
Tagged_Type := Base_Type (T);
end if;
+ -- If the type is incomplete, it may have been declared without a
+ -- Tagged indication, but the full view may be tagged, in which case
+ -- that is the controlling type of the subprogram. This is one of the
+ -- approx. 579 places in the language where a lookahead would help.
+
+ elsif Ekind (T) = E_Incomplete_Type
+ and then Present (Full_View (T))
+ and then Is_Tagged_Type (Full_View (T))
+ then
+ Set_Is_Tagged_Type (T);
+ Tagged_Type := Full_View (T);
+
elsif Ekind (T) = E_Anonymous_Access_Type
and then Is_Tagged_Type (Designated_Type (T))
then
and then Is_Entity_Name (Name (Par))
then
declare
+ Enc_Subp : constant Entity_Id := Entity (Name (Par));
A : Node_Id;
F : Entity_Id;
begin
- -- Find formal for which call is the actual.
+ -- Find formal for which call is the actual, and is
+ -- a controlling argument.
- F := First_Formal (Entity (Name (Par)));
+ F := First_Formal (Enc_Subp);
A := First_Actual (Par);
+
while Present (F) loop
if Is_Controlling_Formal (F)
and then (N = A or else Parent (N) = A)
-- If the call doesn't have a controlling actual but does have an
-- indeterminate actual that requires dispatching treatment, then an
-- object is needed that will serve as the controlling argument for
- -- a dispatching call on the indeterminate actual. This can only
- -- occur in the unusual situation of a default actual given by
- -- a tag-indeterminate call and where the type of the call is an
- -- ancestor of the type associated with a containing call to an
- -- inherited operation (see AI-239).
+ -- a dispatching call on the indeterminate actual. This can occur
+ -- in the unusual situation of a default actual given by a tag-
+ -- indeterminate call and where the type of the call is an ancestor
+ -- of the type associated with a containing call to an inherited
+ -- operation (see AI-239).
-- Rather than create an object of the tagged type, which would
-- be problematic for various reasons (default initialization,
end if;
else
+
-- If dispatching on result, the enclosing call, if any, will
-- determine the controlling argument. Otherwise this is the
-- primitive operation of the root type.
if Msg_D /= "" and then Elab_Warnings then
Error_Msg_NE (Msg_D, N, Ent);
end if;
+
+ -- In the access case emit first warning message as well,
+ -- otherwise list of calls will appear as errors.
+
+ elsif Elab_Warnings then
+ Error_Msg_NE (Msg_S, N, Ent);
end if;
-- Static elaboration checks, info message
projects / gcc.git / commitdiff