[multiple changes]
2015-05-22 Robert Dewar <dewar@adacore.com> * sem_ch12.adb, prj.ads, makeutl.ads, sem_ch6.adb, prj-nmsc.adb, prj-conf.adb, sem_disp.adb: Minor reformatting. 2015-05-22 Vincent Celier <celier@adacore.com> * clean.adb (Parse_Cmd_Line): For native gnatclean, check for switch -P and, if found and gprclean is available, invoke silently gprclean. * make.adb (Initialize): For native gnatmake, check for switch -P and, if found and gprbuild is available, invoke silently gprbuild. 2015-05-22 Eric Botcazou <ebotcazou@adacore.com> * sem_ch13.adb (Validate_Unchecked_Conversions): Also issue specific warning for discrete types when the source is larger than the target. From-SVN: r223555
This commit is contained in:
Arnaud Charlet
parent
167b47d9da
commit
ccd6f4147c
|
|
@ -1,3 +1,22 @@
|
|||
2015-05-22 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_ch12.adb, prj.ads, makeutl.ads, sem_ch6.adb, prj-nmsc.adb,
|
||||
prj-conf.adb, sem_disp.adb: Minor reformatting.
|
||||
|
||||
2015-05-22 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* clean.adb (Parse_Cmd_Line): For native gnatclean, check
|
||||
for switch -P and, if found and gprclean is available, invoke
|
||||
silently gprclean.
|
||||
* make.adb (Initialize): For native gnatmake, check for switch -P
|
||||
and, if found and gprbuild is available, invoke silently gprbuild.
|
||||
|
||||
2015-05-22 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* sem_ch13.adb (Validate_Unchecked_Conversions): Also issue
|
||||
specific warning for discrete types when the source is larger
|
||||
than the target.
|
||||
|
||||
2015-05-22 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* einfo.ads, einfo.adb (Incomplete_Actuals): New attribute of
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2003-2014, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2003-2015, 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- --
|
||||
|
|
@ -1629,6 +1629,55 @@ package body Clean is
|
|||
|
||||
Check_Version_And_Help ("GNATCLEAN", "2003");
|
||||
|
||||
-- First, for native gnatclean, check for switch -P and, if found and
|
||||
-- gprclean is available, silently invoke gprclean.
|
||||
|
||||
Find_Program_Name;
|
||||
|
||||
if Name_Buffer (1 .. Name_Len) = "gnatclean" then
|
||||
declare
|
||||
Call_Gprclean : Boolean := False;
|
||||
|
||||
begin
|
||||
for J in 1 .. Argument_Count loop
|
||||
declare
|
||||
Arg : constant String := Argument (J);
|
||||
begin
|
||||
if Arg'Length >= 2
|
||||
and then Arg (Arg'First .. Arg'First + 1) = "-P"
|
||||
then
|
||||
Call_Gprclean := True;
|
||||
exit;
|
||||
end if;
|
||||
end;
|
||||
end loop;
|
||||
|
||||
if Call_Gprclean then
|
||||
declare
|
||||
Gprclean : String_Access :=
|
||||
Locate_Exec_On_Path (Exec_Name => "gprclean");
|
||||
Args : Argument_List (1 .. Argument_Count);
|
||||
Success : Boolean;
|
||||
|
||||
begin
|
||||
if Gprclean /= null then
|
||||
for J in 1 .. Argument_Count loop
|
||||
Args (J) := new String'(Argument (J));
|
||||
end loop;
|
||||
|
||||
Spawn (Gprclean.all, Args, Success);
|
||||
|
||||
Free (Gprclean);
|
||||
|
||||
if Success then
|
||||
Exit_Program (E_Success);
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
Index := 1;
|
||||
while Index <= Last loop
|
||||
declare
|
||||
|
|
@ -1687,10 +1736,10 @@ package body Clean is
|
|||
Bad_Argument;
|
||||
end if;
|
||||
|
||||
when 'c' =>
|
||||
when 'c' =>
|
||||
Compile_Only := True;
|
||||
|
||||
when 'D' =>
|
||||
when 'D' =>
|
||||
if Object_Directory_Path /= null then
|
||||
Fail ("duplicate -D switch");
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2015, 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- --
|
||||
|
|
@ -6442,6 +6442,55 @@ package body Make is
|
|||
-- Scan again the switch and arguments, now that we are sure that they
|
||||
-- do not include --version or --help.
|
||||
|
||||
-- First, for native gnatmake, check for switch -P and, if found and
|
||||
-- gprbuild is available, silently invoke gprbuild.
|
||||
|
||||
Find_Program_Name;
|
||||
|
||||
if Name_Buffer (1 .. Name_Len) = "gnatmake" then
|
||||
declare
|
||||
Call_Gprbuild : Boolean := False;
|
||||
|
||||
begin
|
||||
for J in 1 .. Argument_Count loop
|
||||
declare
|
||||
Arg : constant String := Argument (J);
|
||||
begin
|
||||
if Arg'Length >= 2
|
||||
and then Arg (Arg'First .. Arg'First + 1) = "-P"
|
||||
then
|
||||
Call_Gprbuild := True;
|
||||
exit;
|
||||
end if;
|
||||
end;
|
||||
end loop;
|
||||
|
||||
if Call_Gprbuild then
|
||||
declare
|
||||
Gprbuild : String_Access :=
|
||||
Locate_Exec_On_Path (Exec_Name => "gprbuild");
|
||||
Args : Argument_List (1 .. Argument_Count);
|
||||
Success : Boolean;
|
||||
|
||||
begin
|
||||
if Gprbuild /= null then
|
||||
for J in 1 .. Argument_Count loop
|
||||
Args (J) := new String'(Argument (J));
|
||||
end loop;
|
||||
|
||||
Spawn (Gprbuild.all, Args, Success);
|
||||
|
||||
Free (Gprbuild);
|
||||
|
||||
if Success then
|
||||
Exit_Program (E_Success);
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
Scan_Args : for Next_Arg in 1 .. Argument_Count loop
|
||||
Scan_Make_Arg (Env, Argument (Next_Arg), And_Save => True);
|
||||
end loop Scan_Args;
|
||||
|
|
|
|||
|
|
@ -74,7 +74,7 @@ package Makeutl is
|
|||
Root_Dir_Option : constant String := "--root-dir";
|
||||
-- The root directory under which all artifacts (objects, library, ali)
|
||||
-- directory are to be found for the current compilation. This directory
|
||||
-- will be use to relocate artifacts based on this directory. If this
|
||||
-- will be used to relocate artifacts based on this directory. If this
|
||||
-- option is not specificed the default value is the directory of the
|
||||
-- main project.
|
||||
|
||||
|
|
|
|||
|
|
@ -973,7 +973,7 @@ package body Prj.Conf is
|
|||
Add_Str_To_Name_Buffer (Build_Tree_Dir.all);
|
||||
|
||||
if Get_Name_String (Conf_Project.Directory.Display_Name)'Length
|
||||
< Root_Dir'Length
|
||||
< Root_Dir'Length
|
||||
then
|
||||
Raise_Invalid_Config
|
||||
("cannot relocate deeper than object directory");
|
||||
|
|
@ -994,8 +994,8 @@ package body Prj.Conf is
|
|||
else
|
||||
if Build_Tree_Dir /= null then
|
||||
if Get_Name_String
|
||||
(Conf_Project.Directory.Display_Name)'Length
|
||||
< Root_Dir'Length
|
||||
(Conf_Project.Directory.Display_Name)'Length <
|
||||
Root_Dir'Length
|
||||
then
|
||||
Raise_Invalid_Config
|
||||
("cannot relocate deeper than object directory");
|
||||
|
|
|
|||
|
|
@ -5589,8 +5589,8 @@ package body Prj.Nmsc is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
elsif not No_Sources and then
|
||||
(Subdirs /= null or else Build_Tree_Dir /= null)
|
||||
elsif not No_Sources
|
||||
and then (Subdirs /= null or else Build_Tree_Dir /= null)
|
||||
then
|
||||
Name_Len := 1;
|
||||
Name_Buffer (1) := '.';
|
||||
|
|
@ -6232,6 +6232,7 @@ package body Prj.Nmsc is
|
|||
|
||||
else
|
||||
if Build_Tree_Dir /= null and then Create /= "" then
|
||||
|
||||
-- Issue a warning that we cannot relocate absolute obj dir
|
||||
|
||||
Err_Vars.Error_Msg_File_1 := Name;
|
||||
|
|
|
|||
|
|
@ -68,7 +68,7 @@ package Prj is
|
|||
Root_Dir : String_Ptr := null;
|
||||
-- When using out-of-tree build we need to keep information about the root
|
||||
-- directory of artifacts to properly relocate them. Note that the root
|
||||
-- directory is not necessary the directory of the main project.
|
||||
-- directory is not necessarily the directory of the main project.
|
||||
|
||||
type Library_Support is (None, Static_Only, Full);
|
||||
-- Support for Library Project File.
|
||||
|
|
|
|||
|
|
@ -830,6 +830,7 @@ package body Sem_Ch12 is
|
|||
-- later, when the expected types are known, but names have to be captured
|
||||
-- before installing parents of generics, that are not visible for the
|
||||
-- actuals themselves.
|
||||
--
|
||||
-- If Inst is present, it is the entity of the package instance. This
|
||||
-- entity is marked as having a limited_view actual when some actual is
|
||||
-- a limited view. This is used to place the instance body properly..
|
||||
|
|
@ -3601,7 +3602,8 @@ package body Sem_Ch12 is
|
|||
Generate_Definition (Act_Decl_Id);
|
||||
Set_Ekind (Act_Decl_Id, E_Package);
|
||||
|
||||
-- Initialize list of incomplete actuals before analysis.
|
||||
-- Initialize list of incomplete actuals before analysis
|
||||
|
||||
Set_Incomplete_Actuals (Act_Decl_Id, New_Elmt_List);
|
||||
|
||||
Preanalyze_Actuals (N, Act_Decl_Id);
|
||||
|
|
@ -8883,17 +8885,19 @@ package body Sem_Ch12 is
|
|||
-- the instance body.
|
||||
|
||||
declare
|
||||
Elmt : Elmt_Id;
|
||||
F_T : Node_Id;
|
||||
Typ : Entity_Id;
|
||||
Elmt : Elmt_Id;
|
||||
F_T : Node_Id;
|
||||
Typ : Entity_Id;
|
||||
|
||||
begin
|
||||
Elmt := First_Elmt (Incomplete_Actuals (Act_Id));
|
||||
while Present (Elmt) loop
|
||||
Typ := Node (Elmt);
|
||||
|
||||
if From_Limited_With (Typ) then
|
||||
Typ := Non_Limited_View (Typ);
|
||||
end if;
|
||||
|
||||
Ensure_Freeze_Node (Typ);
|
||||
F_T := Freeze_Node (Typ);
|
||||
|
||||
|
|
@ -13356,7 +13360,7 @@ package body Sem_Ch12 is
|
|||
Analyze (Act);
|
||||
|
||||
if Is_Entity_Name (Act)
|
||||
and then Is_Type (Entity (Act))
|
||||
and then Is_Type (Entity (Act))
|
||||
and then From_Limited_With (Entity (Act))
|
||||
then
|
||||
Append_Elmt (Entity (Act), Incomplete_Actuals (Inst));
|
||||
|
|
|
|||
|
|
@ -13483,9 +13483,22 @@ package body Sem_Ch13 is
|
|||
end if;
|
||||
|
||||
else pragma Assert (Source_Siz > Target_Siz);
|
||||
Error_Msg
|
||||
("\?z?^ trailing bits of source will be ignored!",
|
||||
Eloc);
|
||||
if Is_Discrete_Type (Source) then
|
||||
if Bytes_Big_Endian then
|
||||
Error_Msg
|
||||
("\?z?^ low order bits of source will be "
|
||||
& "ignored!", Eloc);
|
||||
else
|
||||
Error_Msg
|
||||
("\?z?^ high order bits of source will be "
|
||||
& "ignored!", Eloc);
|
||||
end if;
|
||||
|
||||
else
|
||||
Error_Msg
|
||||
("\?z?^ trailing bits of source will be "
|
||||
& "ignored!", Eloc);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -2831,9 +2831,7 @@ package body Sem_Ch6 is
|
|||
procedure Detect_And_Exchange (Id : Entity_Id) is
|
||||
Typ : constant Entity_Id := Etype (Id);
|
||||
begin
|
||||
if From_Limited_With (Typ)
|
||||
and then Has_Non_Limited_View (Typ)
|
||||
then
|
||||
if From_Limited_With (Typ) and then Has_Non_Limited_View (Typ) then
|
||||
Set_Etype (Id, Non_Limited_View (Typ));
|
||||
end if;
|
||||
end Detect_And_Exchange;
|
||||
|
|
|
|||
|
|
@ -818,15 +818,13 @@ package body Sem_Disp is
|
|||
-- (the only current case of a tag-indeterminate attribute
|
||||
-- is the stream Input attribute).
|
||||
|
||||
elsif
|
||||
Nkind (Original_Node (Actual)) = N_Attribute_Reference
|
||||
elsif Nkind (Original_Node (Actual)) = N_Attribute_Reference
|
||||
then
|
||||
Func := Empty;
|
||||
|
||||
-- Ditto if it is an explicit dereference.
|
||||
|
||||
elsif
|
||||
Nkind (Original_Node (Actual)) = N_Explicit_Dereference
|
||||
elsif Nkind (Original_Node (Actual)) = N_Explicit_Dereference
|
||||
then
|
||||
Func := Empty;
|
||||
|
||||
|
|
@ -835,9 +833,8 @@ package body Sem_Disp is
|
|||
|
||||
else
|
||||
Func :=
|
||||
Entity (Name
|
||||
(Original_Node
|
||||
(Expression (Original_Node (Actual)))));
|
||||
Entity (Name (Original_Node
|
||||
(Expression (Original_Node (Actual)))));
|
||||
end if;
|
||||
|
||||
if Present (Func) and then Is_Abstract_Subprogram (Func) then
|
||||
|
|
|
|||
Loading…
Reference in New Issue