+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
-- --
-- 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- --
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
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");
-- --
-- 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- --
-- 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;
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.
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");
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");
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) := '.';
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;
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.
-- 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..
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);
-- 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);
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));
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;
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;
-- (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;
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
projects / platform / upstream / gcc.git / commitdiff