[multiple changes]
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. From-SVN: r229340
This commit is contained in:
parent
bed87f4f07
commit
ec6cfc5dc2
|
@ -1,3 +1,37 @@
|
||||||
|
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>
|
2015-10-26 Yannick Moy <moy@adacore.com>
|
||||||
|
|
||||||
* lib-xref-spark_specific.adb (Traverse_Protected_Declaration): New
|
* lib-xref-spark_specific.adb (Traverse_Protected_Declaration): New
|
||||||
|
|
|
@ -2787,16 +2787,19 @@ __gnat_locate_exec_on_path (char *exec_name)
|
||||||
apath_val = (char *) alloca (EXPAND_BUFFER_SIZE);
|
apath_val = (char *) alloca (EXPAND_BUFFER_SIZE);
|
||||||
|
|
||||||
WS2SC (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
|
WS2SC (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
|
||||||
return __gnat_locate_exec (exec_name, apath_val);
|
|
||||||
|
|
||||||
#else
|
#else
|
||||||
char *path_val = getenv ("PATH");
|
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);
|
apath_val = (char *) alloca (strlen (path_val) + 1);
|
||||||
strcpy (apath_val, path_val);
|
strcpy (apath_val, path_val);
|
||||||
return __gnat_locate_exec (exec_name, apath_val);
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
return __gnat_locate_exec (exec_name, apath_val);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Dummy functions for Osint import for non-VMS systems.
|
/* Dummy functions for Osint import for non-VMS systems.
|
||||||
|
|
|
@ -1288,10 +1288,18 @@ package body Exp_Ch11 is
|
||||||
|
|
||||||
-- Full_Name component: Standard.A_Char!(Nam'Address)
|
-- Full_Name component: Standard.A_Char!(Nam'Address)
|
||||||
|
|
||||||
Append_To (L, Unchecked_Convert_To (Standard_A_Char,
|
-- The unchecked conversion causes capacity issues for CodePeer in some
|
||||||
Make_Attribute_Reference (Loc,
|
-- cases and is never useful, so we set the Full_Name component to null
|
||||||
Prefix => New_Occurrence_Of (Ex_Id, Loc),
|
-- instead for CodePeer.
|
||||||
Attribute_Name => Name_Address)));
|
|
||||||
|
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
|
-- HTable_Ptr component: null
|
||||||
|
|
||||||
|
|
|
@ -466,6 +466,16 @@ package body Exp_Unst is
|
||||||
|
|
||||||
if Caller = Callee then
|
if Caller = Callee then
|
||||||
return;
|
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;
|
end if;
|
||||||
|
|
||||||
-- We have a new uplevel referenced entity
|
-- We have a new uplevel referenced entity
|
||||||
|
|
|
@ -476,7 +476,7 @@ package Makeutl is
|
||||||
|
|
||||||
function Number_Of_Mains (Tree : Project_Tree_Ref) return Natural;
|
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 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
|
procedure Fill_From_Project
|
||||||
(Root_Project : Project_Id;
|
(Root_Project : Project_Id;
|
||||||
|
|
|
@ -316,6 +316,18 @@ package body Sem_Disp is
|
||||||
Tagged_Type := Base_Type (T);
|
Tagged_Type := Base_Type (T);
|
||||||
end if;
|
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
|
elsif Ekind (T) = E_Anonymous_Access_Type
|
||||||
and then Is_Tagged_Type (Designated_Type (T))
|
and then Is_Tagged_Type (Designated_Type (T))
|
||||||
then
|
then
|
||||||
|
@ -595,14 +607,17 @@ package body Sem_Disp is
|
||||||
and then Is_Entity_Name (Name (Par))
|
and then Is_Entity_Name (Name (Par))
|
||||||
then
|
then
|
||||||
declare
|
declare
|
||||||
|
Enc_Subp : constant Entity_Id := Entity (Name (Par));
|
||||||
A : Node_Id;
|
A : Node_Id;
|
||||||
F : Entity_Id;
|
F : Entity_Id;
|
||||||
|
|
||||||
begin
|
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);
|
A := First_Actual (Par);
|
||||||
|
|
||||||
while Present (F) loop
|
while Present (F) loop
|
||||||
if Is_Controlling_Formal (F)
|
if Is_Controlling_Formal (F)
|
||||||
and then (N = A or else Parent (N) = A)
|
and then (N = A or else Parent (N) = A)
|
||||||
|
@ -697,11 +712,11 @@ package body Sem_Disp is
|
||||||
-- If the call doesn't have a controlling actual but does have an
|
-- If the call doesn't have a controlling actual but does have an
|
||||||
-- indeterminate actual that requires dispatching treatment, then an
|
-- indeterminate actual that requires dispatching treatment, then an
|
||||||
-- object is needed that will serve as the controlling argument for
|
-- object is needed that will serve as the controlling argument for
|
||||||
-- a dispatching call on the indeterminate actual. This can only
|
-- a dispatching call on the indeterminate actual. This can occur
|
||||||
-- occur in the unusual situation of a default actual given by
|
-- in the unusual situation of a default actual given by a tag-
|
||||||
-- a tag-indeterminate call and where the type of the call is an
|
-- indeterminate call and where the type of the call is an ancestor
|
||||||
-- ancestor of the type associated with a containing call to an
|
-- of the type associated with a containing call to an inherited
|
||||||
-- inherited operation (see AI-239).
|
-- operation (see AI-239).
|
||||||
|
|
||||||
-- Rather than create an object of the tagged type, which would
|
-- Rather than create an object of the tagged type, which would
|
||||||
-- be problematic for various reasons (default initialization,
|
-- be problematic for various reasons (default initialization,
|
||||||
|
@ -849,6 +864,7 @@ package body Sem_Disp is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
else
|
else
|
||||||
|
|
||||||
-- If dispatching on result, the enclosing call, if any, will
|
-- If dispatching on result, the enclosing call, if any, will
|
||||||
-- determine the controlling argument. Otherwise this is the
|
-- determine the controlling argument. Otherwise this is the
|
||||||
-- primitive operation of the root type.
|
-- primitive operation of the root type.
|
||||||
|
|
|
@ -548,6 +548,12 @@ package body Sem_Elab is
|
||||||
if Msg_D /= "" and then Elab_Warnings then
|
if Msg_D /= "" and then Elab_Warnings then
|
||||||
Error_Msg_NE (Msg_D, N, Ent);
|
Error_Msg_NE (Msg_D, N, Ent);
|
||||||
end if;
|
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;
|
end if;
|
||||||
|
|
||||||
-- Static elaboration checks, info message
|
-- Static elaboration checks, info message
|
||||||
|
|
Loading…
Reference in New Issue