Commit b5bdffcc by Arnaud Charlet

[multiple changes]

2013-04-24  Vincent Celier  <celier@adacore.com>

	* gnat_ugn.texi: Document new gnatls switch -aPdir.
	* gnatcmd.adb: Pass switch -aP<dir> to gnatls.
	* gnatls.adb (Scan_Ls_Arg): Process new switch -aP<dir>. Issue
	a warning for unknown switches.
	(Usage): Add line for new switch -aPdir.

2013-04-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb, sem_util.ads (Is_Limited_Class_Wide_Type): Return true
	if the type comes from a limited view, so that task attributes can be
	constructed.

2013-04-24  Yannick Moy  <moy@adacore.com>

	* checks.adb (Apply_Float_Conversion_Check): Do not apply checks if
	full expansion is not enabled.

2013-04-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Create_Extra_Formals): In Ada 2012, create extra
	formals if the type does not yet have a completion, and thus
	has no underlying view.

2013-04-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications): Treat an aspect
	specification for Address as a reference, to suppress warnings
	on entities that may be read by an external device.

From-SVN: r198237
parent 327b1ba4
2013-04-24 Vincent Celier <celier@adacore.com>
* gnat_ugn.texi: Document new gnatls switch -aPdir.
* gnatcmd.adb: Pass switch -aP<dir> to gnatls.
* gnatls.adb (Scan_Ls_Arg): Process new switch -aP<dir>. Issue
a warning for unknown switches.
(Usage): Add line for new switch -aPdir.
2013-04-24 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb, sem_util.ads (Is_Limited_Class_Wide_Type): Return true
if the type comes from a limited view, so that task attributes can be
constructed.
2013-04-24 Yannick Moy <moy@adacore.com>
* checks.adb (Apply_Float_Conversion_Check): Do not apply checks if
full expansion is not enabled.
2013-04-24 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Create_Extra_Formals): In Ada 2012, create extra
formals if the type does not yet have a completion, and thus
has no underlying view.
2013-04-24 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Analyze_Aspect_Specifications): Treat an aspect
specification for Address as a reference, to suppress warnings
on entities that may be read by an external device.
2013-04-24 Sergey Rybin <rybin@adacore.com frybin> 2013-04-24 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi: Add description of '--help' and '--version' * gnat_ugn.texi: Add description of '--help' and '--version'
......
...@@ -1907,6 +1907,15 @@ package body Checks is ...@@ -1907,6 +1907,15 @@ package body Checks is
Reason : RT_Exception_Code; Reason : RT_Exception_Code;
begin begin
-- We do not need checks if we are not generating code (i.e. the full
-- expander is not active). In SPARK mode, we specifically don't want
-- the frontend to expand these checks, which are dealt with directly
-- in the formal verification backend.
if not Full_Expander_Active then
return;
end if;
if not Compile_Time_Known_Value (LB) if not Compile_Time_Known_Value (LB)
or not Compile_Time_Known_Value (HB) or not Compile_Time_Known_Value (HB)
then then
......
...@@ -16393,6 +16393,10 @@ Several such switches may be specified simultaneously. ...@@ -16393,6 +16393,10 @@ Several such switches may be specified simultaneously.
Source path manipulation. Same meaning as the equivalent @command{gnatmake} Source path manipulation. Same meaning as the equivalent @command{gnatmake}
flags (@pxref{Switches for gnatmake}). flags (@pxref{Switches for gnatmake}).
@item ^-aP^/ADD_PROJECT_SEARCH_DIR=^@var{dir}
@cindex @option{^-aP^/ADD_PROJECT_SEARCH_DIR=^} (@code{gnatls})
Add @var{dir} at the beginning of the project search dir.
@item --RTS=@var{rts-path} @item --RTS=@var{rts-path}
@cindex @option{--RTS} (@code{gnatls}) @cindex @option{--RTS} (@code{gnatls})
Specifies the default location of the runtime library. Same meaning as the Specifies the default location of the runtime library. Same meaning as the
...@@ -1766,7 +1766,16 @@ begin ...@@ -1766,7 +1766,16 @@ begin
(Root_Environment.Project_Path, (Root_Environment.Project_Path,
Argv (Argv'First + 3 .. Argv'Last)); Argv (Argv'First + 3 .. Argv'Last));
Remove_Switch (Arg_Num); -- Pass -aPdir to gnatls
if The_Command = List then
Arg_Num := Arg_Num + 1;
-- but not to other tools
else
Remove_Switch (Arg_Num);
end if;
-- -eL Follow links for files -- -eL Follow links for files
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1253,6 +1253,8 @@ procedure Gnatls is ...@@ -1253,6 +1253,8 @@ procedure Gnatls is
FD : File_Descriptor; FD : File_Descriptor;
Len : Integer; Len : Integer;
OK : Boolean;
begin begin
pragma Assert (Argv'First = 1); pragma Assert (Argv'First = 1);
...@@ -1260,6 +1262,7 @@ procedure Gnatls is ...@@ -1260,6 +1262,7 @@ procedure Gnatls is
return; return;
end if; end if;
OK := True;
if Argv (1) = '-' then if Argv (1) = '-' then
if Argv'Length = 1 then if Argv'Length = 1 then
Fail ("switch character cannot be followed by a blank"); Fail ("switch character cannot be followed by a blank");
...@@ -1297,6 +1300,11 @@ procedure Gnatls is ...@@ -1297,6 +1300,11 @@ procedure Gnatls is
elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
Add_Lib_Dir (Argv (4 .. Argv'Last)); Add_Lib_Dir (Argv (4 .. Argv'Last));
-- Processing for -aP<dir>
elsif Argv'Length > 3 and then Argv (1 .. 3) = "-aP" then
Add_Directories (Prj_Path, Argv (4 .. Argv'Last));
-- Processing for -nostdinc -- Processing for -nostdinc
elsif Argv (2 .. Argv'Last) = "nostdinc" then elsif Argv (2 .. Argv'Last) = "nostdinc" then
...@@ -1316,7 +1324,7 @@ procedure Gnatls is ...@@ -1316,7 +1324,7 @@ procedure Gnatls is
when 'l' => License := True; when 'l' => License := True;
when 'V' => Very_Verbose_Mode := True; when 'V' => Very_Verbose_Mode := True;
when others => null; when others => OK := False;
end case; end case;
-- Processing for -files=file -- Processing for -files=file
...@@ -1396,6 +1404,9 @@ procedure Gnatls is ...@@ -1396,6 +1404,9 @@ procedure Gnatls is
Opt.No_Stdinc := True; Opt.No_Stdinc := True;
Opt.RTS_Switch := True; Opt.RTS_Switch := True;
end if; end if;
else
OK := False;
end if; end if;
-- If not a switch, it must be a file name -- If not a switch, it must be a file name
...@@ -1403,6 +1414,13 @@ procedure Gnatls is ...@@ -1403,6 +1414,13 @@ procedure Gnatls is
else else
Add_File (Argv); Add_File (Argv);
end if; end if;
if not OK then
Write_Str ("warning: unknown switch """);
Write_Str (Argv);
Write_Line ("""");
end if;
end Scan_Ls_Arg; end Scan_Ls_Arg;
----------- -----------
...@@ -1484,6 +1502,11 @@ procedure Gnatls is ...@@ -1484,6 +1502,11 @@ procedure Gnatls is
Write_Str (" -aOdir specify object files search path"); Write_Str (" -aOdir specify object files search path");
Write_Eol; Write_Eol;
-- Line for -aP switch
Write_Str (" -aPdir specify project search path");
Write_Eol;
-- Line for -I switch -- Line for -I switch
Write_Str (" -Idir like -aIdir -aOdir"); Write_Str (" -Idir like -aIdir -aOdir");
......
...@@ -1335,6 +1335,16 @@ package body Sem_Ch13 is ...@@ -1335,6 +1335,16 @@ package body Sem_Ch13 is
Chars => Chars (Id), Chars => Chars (Id),
Expression => Relocate_Node (Expr)); Expression => Relocate_Node (Expr));
-- If the address is specified we treat the entity as
-- referenced, to avoid spurious warnings. This is analogous
-- to what is done with an attribute definition clause, but
-- here we don't want to generate a reference because this
-- is the point of definition of the entity.
if A_Id = Aspect_Address then
Set_Referenced (E);
end if;
-- Case 2: Aspects corresponding to pragmas -- Case 2: Aspects corresponding to pragmas
-- Case 2a: Aspects corresponding to pragmas with two -- Case 2a: Aspects corresponding to pragmas with two
......
...@@ -7917,13 +7917,19 @@ package body Sem_Ch6 is ...@@ -7917,13 +7917,19 @@ package body Sem_Ch6 is
-- on discriminants and others do not (and requiring the extra -- on discriminants and others do not (and requiring the extra
-- formal would introduce distributed overhead). -- formal would introduce distributed overhead).
-- If the type does not have a completion yet, treat as prior to
-- Ada 2012 for consistency.
if Has_Discriminants (Formal_Type) if Has_Discriminants (Formal_Type)
and then not Is_Constrained (Formal_Type) and then not Is_Constrained (Formal_Type)
and then not Is_Indefinite_Subtype (Formal_Type) and then not Is_Indefinite_Subtype (Formal_Type)
and then (Ada_Version < Ada_2012 and then (Ada_Version < Ada_2012
or else or else No (Underlying_Type (Formal_Type))
not (Is_Tagged_Type (Underlying_Type (Formal_Type)) or else not
and then Is_Limited_Type (Formal_Type))) (Is_Limited_Type (Formal_Type)
and then
(Is_Tagged_Type
(Underlying_Type (Formal_Type)))))
then then
Set_Extra_Constrained Set_Extra_Constrained
(Formal, Add_Extra_Formal (Formal, Standard_Boolean, E, "O")); (Formal, Add_Extra_Formal (Formal, Standard_Boolean, E, "O"));
...@@ -11198,7 +11204,9 @@ package body Sem_Ch6 is ...@@ -11198,7 +11204,9 @@ package body Sem_Ch6 is
function Contains_Enabled_Pragmas (L : List_Id) return Boolean; function Contains_Enabled_Pragmas (L : List_Id) return Boolean;
-- Determine whether list L has at least one enabled pragma. The routine -- Determine whether list L has at least one enabled pragma. The routine
-- ignores nother non-pragma elements. -- ignores other non-pragma elements.
-- This is NOT what the routine does??? It returns False if there is
-- one ignored pragma ???
procedure Expand_Contract_Cases (CCs : Node_Id; Subp_Id : Entity_Id); procedure Expand_Contract_Cases (CCs : Node_Id; Subp_Id : Entity_Id);
-- Given pragma Contract_Cases CCs, create the circuitry needed to -- Given pragma Contract_Cases CCs, create the circuitry needed to
...@@ -11271,6 +11279,8 @@ package body Sem_Ch6 is ...@@ -11271,6 +11279,8 @@ package body Sem_Ch6 is
-- Contains_Enabled_Pragmas -- -- Contains_Enabled_Pragmas --
------------------------------ ------------------------------
-- This routine does not implement its documented spec ???
function Contains_Enabled_Pragmas (L : List_Id) return Boolean is function Contains_Enabled_Pragmas (L : List_Id) return Boolean is
Prag : Node_Id; Prag : Node_Id;
...@@ -12277,10 +12287,9 @@ package body Sem_Ch6 is ...@@ -12277,10 +12287,9 @@ package body Sem_Ch6 is
-- subprogram has invariants, then build the _Postconditions procedure. -- subprogram has invariants, then build the _Postconditions procedure.
if Expander_Active if Expander_Active
and then and then (Invariants_Or_Predicates_Present
(Invariants_Or_Predicates_Present or else (Present (Plist)
or else and then Contains_Enabled_Pragmas (Plist)))
(Present (Plist) and then Contains_Enabled_Pragmas (Plist)))
then then
if No (Plist) then if No (Plist) then
Plist := Empty_List; Plist := Empty_List;
......
...@@ -8643,7 +8643,7 @@ package body Sem_Util is ...@@ -8643,7 +8643,7 @@ package body Sem_Util is
begin begin
return return
Is_Class_Wide_Type (Typ) Is_Class_Wide_Type (Typ)
and then Is_Limited_Type (Typ); and then (Is_Limited_Type (Typ) or else From_With_Type (Typ));
end Is_Limited_Class_Wide_Type; end Is_Limited_Class_Wide_Type;
--------------------------------- ---------------------------------
......
...@@ -949,7 +949,10 @@ package Sem_Util is ...@@ -949,7 +949,10 @@ package Sem_Util is
-- i.e. a library unit or an entity declared in a library package. -- i.e. a library unit or an entity declared in a library package.
function Is_Limited_Class_Wide_Type (Typ : Entity_Id) return Boolean; function Is_Limited_Class_Wide_Type (Typ : Entity_Id) return Boolean;
-- Determine whether a given arbitrary type is a limited class-wide type -- Determine whether a given type is a limited class-wide type, in which
-- case it needs a Master_Id, because extensions of its designated type
-- may include task components. A class-wide type that comes from a
-- limited view must be treated in the same way.
function Is_Local_Variable_Reference (Expr : Node_Id) return Boolean; function Is_Local_Variable_Reference (Expr : Node_Id) return Boolean;
-- Determines whether Expr is a reference to a variable or IN OUT mode -- Determines whether Expr is a reference to a variable or IN OUT mode
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment