Commit 0ea55619 by Arnaud Charlet

[multiple changes]

2012-10-01  Thomas Quinot  <quinot@adacore.com>

	* make.adb: Minor documentation fix: error messages are sent to
	stderr, not stdout.

2012-10-01  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.ads, checks.adb (Apply_Parameter_Aliasing_Checks): New routine.
	(Apply_Parameter_Validity_Checks): New routines.
	* exp_ch6.adb (Expand_Call): Add aliasing checks to detect
	overlapping objects.
	* freeze.adb: Add with and use clauses for Checks and Validsw.
	(Freeze_Entity): Add checks to detect proper initialization
	of scalars.
	* sem_ch4.adb: Add with and use clauses for Checks and Validsw.
	(Analyze_Call): Add aliasing checks to detect overlapping objects.
	* sem_ch13.adb: Add with and use clauses for Validsw.
	(Analyze_Aspect_Specifications): Add checks to detect proper
	initialization of scalars.
	* sem_prag.adb (Chain_PPC): Correct the extraction of the
	subprogram name.
	* sem_util.adb (Is_Object_Reference): Attribute 'Result now
	produces an object.
	* usage.adb (Usage): Add usage lines for validity switches 'l',
	'L', 'v' and 'V'.
	* validsw.adb (Reset_Validity_Check_Options): Include
	processing for flags Validity_Check_Non_Overlapping_Params and
	Validity_Check_Valid_Scalars_On_Params. Code reformatting.
	(Save_Validity_Check_Options): Include processing
	for flags Validity_Check_Non_Overlapping_Params
	and Validity_Check_Valid_Scalars_On_Params.
	(Set_Validity_Check_Options): Add processing for validity switches
	'a', 'l', 'L', 'n', 'v' and 'V'. Code reformatting.
	* validsw.ads: Add new flags Validity_Check_Non_Overlapping_Params
	and Validity_Check_Valid_Scalars_On_Params along with comments
	on usage.

2012-10-01  Thomas Quinot  <quinot@adacore.com>

	* namet.ads, xsnamest.adb, prj-env.adb, sem_warn.adb,
	errout.ads: Minor reformatting.
	* prj-part.adb: Add comment.

From-SVN: r191890
parent 2791be24
2012-10-01 Thomas Quinot <quinot@adacore.com>
* make.adb: Minor documentation fix: error messages are sent to
stderr, not stdout.
2012-10-01 Hristian Kirtchev <kirtchev@adacore.com>
* checks.ads, checks.adb (Apply_Parameter_Aliasing_Checks): New routine.
(Apply_Parameter_Validity_Checks): New routines.
* exp_ch6.adb (Expand_Call): Add aliasing checks to detect
overlapping objects.
* freeze.adb: Add with and use clauses for Checks and Validsw.
(Freeze_Entity): Add checks to detect proper initialization
of scalars.
* sem_ch4.adb: Add with and use clauses for Checks and Validsw.
(Analyze_Call): Add aliasing checks to detect overlapping objects.
* sem_ch13.adb: Add with and use clauses for Validsw.
(Analyze_Aspect_Specifications): Add checks to detect proper
initialization of scalars.
* sem_prag.adb (Chain_PPC): Correct the extraction of the
subprogram name.
* sem_util.adb (Is_Object_Reference): Attribute 'Result now
produces an object.
* usage.adb (Usage): Add usage lines for validity switches 'l',
'L', 'v' and 'V'.
* validsw.adb (Reset_Validity_Check_Options): Include
processing for flags Validity_Check_Non_Overlapping_Params and
Validity_Check_Valid_Scalars_On_Params. Code reformatting.
(Save_Validity_Check_Options): Include processing
for flags Validity_Check_Non_Overlapping_Params
and Validity_Check_Valid_Scalars_On_Params.
(Set_Validity_Check_Options): Add processing for validity switches
'a', 'l', 'L', 'n', 'v' and 'V'. Code reformatting.
* validsw.ads: Add new flags Validity_Check_Non_Overlapping_Params
and Validity_Check_Valid_Scalars_On_Params along with comments
on usage.
2012-10-01 Thomas Quinot <quinot@adacore.com>
* namet.ads, xsnamest.adb, prj-env.adb, sem_warn.adb,
errout.ads: Minor reformatting.
* prj-part.adb: Add comment.
2012-10-01 Robert Dewar <dewar@adacore.com> 2012-10-01 Robert Dewar <dewar@adacore.com>
* sinfo.ads, exp_aggr.adb, sem_ch13.adb: Minor reformatting. * sinfo.ads, exp_aggr.adb, sem_ch13.adb: Minor reformatting.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2012, 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- --
...@@ -154,6 +154,21 @@ package Checks is ...@@ -154,6 +154,21 @@ package Checks is
-- formals, the check is performed only if the corresponding actual is -- formals, the check is performed only if the corresponding actual is
-- constrained, i.e., whether Lhs'Constrained is True. -- constrained, i.e., whether Lhs'Constrained is True.
procedure Apply_Parameter_Aliasing_Checks (Call : Node_Id);
-- Given a subprogram call Call, introduce a check to verify that none of
-- the actual parameters overlap.
procedure Apply_Parameter_Validity_Checks (Subp : Entity_Id);
-- Given a subprogram Subp, add both a pre and post condition pragmas that
-- verify the validity of formal parameters and function results.
procedure Apply_Parameter_Validity_Checks
(Subp : Entity_Id;
Prag : Node_Id);
-- Given a subprogram Subp and a pre or post condition pragma Prag, augment
-- the expression of the pragma to verify the validity of qualifying formal
-- parameter and function results.
procedure Apply_Predicate_Check (N : Node_Id; Typ : Entity_Id); procedure Apply_Predicate_Check (N : Node_Id; Typ : Entity_Id);
-- N is an expression to which a predicate check may need to be applied -- N is an expression to which a predicate check may need to be applied
-- for Typ, if Typ has a predicate function. The check is applied only -- for Typ, if Typ has a predicate function. The check is applied only
......
...@@ -230,7 +230,7 @@ package Errout is ...@@ -230,7 +230,7 @@ package Errout is
-- one (the plus one is because the number is stored 0-origin and -- one (the plus one is because the number is stored 0-origin and
-- displayed 1-origin). -- displayed 1-origin).
-- Insertion character ^ (Carret: insert integer value) -- Insertion character ^ (Caret: insert integer value)
-- The character ^ is replaced by the decimal conversion of the Uint -- The character ^ is replaced by the decimal conversion of the Uint
-- value stored in Error_Msg_Uint_1, with a possible leading minus. -- value stored in Error_Msg_Uint_1, with a possible leading minus.
-- A second ^ may occur in the message, in which case it is replaced -- A second ^ may occur in the message, in which case it is replaced
......
...@@ -3404,6 +3404,13 @@ package body Exp_Ch6 is ...@@ -3404,6 +3404,13 @@ package body Exp_Ch6 is
Expand_Actuals (Call_Node, Subp); Expand_Actuals (Call_Node, Subp);
-- Now that we have all parameters, add aliasing checks to detect
-- overlapping objects.
if Validity_Check_Non_Overlapping_Params then
Apply_Parameter_Aliasing_Checks (N);
end if;
-- If the subprogram is a renaming, or if it is inherited, replace it in -- If the subprogram is a renaming, or if it is inherited, replace it in
-- the call with the name of the actual subprogram being called. If this -- the call with the name of the actual subprogram being called. If this
-- is a dispatching call, the run-time decides what to call. The Alias -- is a dispatching call, the run-time decides what to call. The Alias
......
...@@ -24,6 +24,7 @@ ...@@ -24,6 +24,7 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Atree; use Atree; with Atree; use Atree;
with Checks; use Checks;
with Debug; use Debug; with Debug; use Debug;
with Einfo; use Einfo; with Einfo; use Einfo;
with Elists; use Elists; with Elists; use Elists;
...@@ -64,6 +65,7 @@ with Tbuild; use Tbuild; ...@@ -64,6 +65,7 @@ with Tbuild; use Tbuild;
with Ttypes; use Ttypes; with Ttypes; use Ttypes;
with Uintp; use Uintp; with Uintp; use Uintp;
with Urealp; use Urealp; with Urealp; use Urealp;
with Validsw; use Validsw;
package body Freeze is package body Freeze is
...@@ -2655,6 +2657,14 @@ package body Freeze is ...@@ -2655,6 +2657,14 @@ package body Freeze is
end; end;
end if; end if;
-- Add checks to detect proper initialization of scalars
if Is_Subprogram (E)
and then Validity_Check_Valid_Scalars_On_Params
then
Apply_Parameter_Validity_Checks (E);
end if;
-- Deal with delayed aspect specifications. The analysis of the -- Deal with delayed aspect specifications. The analysis of the
-- aspect is required to be delayed to the freeze point, thus we -- aspect is required to be delayed to the freeze point, thus we
-- analyze the pragma or attribute definition clause in the tree at -- analyze the pragma or attribute definition clause in the tree at
......
...@@ -410,7 +410,7 @@ package body Make is ...@@ -410,7 +410,7 @@ package body Make is
-- Delete all temp files created by Gnatmake and call Osint.Fail, with the -- Delete all temp files created by Gnatmake and call Osint.Fail, with the
-- parameter S (see osint.ads). This is called from the Prj hierarchy and -- parameter S (see osint.ads). This is called from the Prj hierarchy and
-- the MLib hierarchy. This subprogram also prints current error messages -- the MLib hierarchy. This subprogram also prints current error messages
-- on stdout (ie finalizes errout) -- (ie finalizes Errutil).
-------------------------- --------------------------
-- Obsolete Executables -- -- Obsolete Executables --
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2012, 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- --
...@@ -47,11 +47,11 @@ package Namet is ...@@ -47,11 +47,11 @@ package Namet is
-- The forms of the entries are as follows: -- The forms of the entries are as follows:
-- Identifiers Stored with upper case letters folded to lower case. Upper -- Identifiers Stored with upper case letters folded to lower case.
-- half (16#80# bit set) and wide characters are stored -- Upper half (16#80# bit set) and wide characters are
-- in an encoded form (Uhh for upper half char, Whhhh -- stored in an encoded form (Uhh for upper half char,
-- for wide characters, WWhhhhhhhh as provided by the -- Whhhh for wide characters, WWhhhhhhhh as provided by
-- routine Store_Encoded_Character, where hh are hex -- the routine Store_Encoded_Character, where hh are hex
-- digits for the character code using lower case a-f). -- digits for the character code using lower case a-f).
-- Normally the use of U or W in other internal names is -- Normally the use of U or W in other internal names is
-- avoided, but these letters may be used in internal -- avoided, but these letters may be used in internal
......
...@@ -2043,8 +2043,7 @@ package body Prj.Env is ...@@ -2043,8 +2043,7 @@ package body Prj.Env is
-- $prefix/$target/lib/gnat -- $prefix/$target/lib/gnat
Add_Str_To_Name_Buffer Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all & (Path_Separator & Prefix.all & Target_Name);
Target_Name);
-- Note: Target_Name has a trailing / when it comes from -- Note: Target_Name has a trailing / when it comes from
-- Sdefault. -- Sdefault.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2012, 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- --
...@@ -636,9 +636,12 @@ package body Prj.Part is ...@@ -636,9 +636,12 @@ package body Prj.Part is
-- Now, check the projects directly imported by the main project. -- Now, check the projects directly imported by the main project.
-- Remove from the potentially virtual any project extended by one -- Remove from the potentially virtual any project extended by one
-- of these imported projects. For non extending imported projects, -- of these imported projects.
-- check that they do not belong to the project tree of the project
-- being "extended-all" by the main project. -- For non extending imported projects, check that they do not belong
-- to the project tree of the project being "extended-all" by the
-- main project.
-- Where is this check performed???
declare declare
With_Clause : Project_Node_Id; With_Clause : Project_Node_Id;
......
...@@ -63,6 +63,7 @@ with Targparm; use Targparm; ...@@ -63,6 +63,7 @@ with Targparm; use Targparm;
with Ttypes; use Ttypes; with Ttypes; use Ttypes;
with Tbuild; use Tbuild; with Tbuild; use Tbuild;
with Urealp; use Urealp; with Urealp; use Urealp;
with Validsw; use Validsw;
with Warnsw; use Warnsw; with Warnsw; use Warnsw;
with GNAT.Heap_Sort_G; with GNAT.Heap_Sort_G;
...@@ -1522,6 +1523,12 @@ package body Sem_Ch13 is ...@@ -1522,6 +1523,12 @@ package body Sem_Ch13 is
Chars => Name_Check, Chars => Name_Check,
Expression => Relocate_Node (Expr)))); Expression => Relocate_Node (Expr))));
-- Add checks to detect proper initialization of scalars
if Validity_Check_Valid_Scalars_On_Params then
Apply_Parameter_Validity_Checks (E, Aitem);
end if;
-- Add message unless exception messages are suppressed -- Add message unless exception messages are suppressed
if not Opt.Exception_Locations_Suppressed then if not Opt.Exception_Locations_Suppressed then
......
...@@ -25,6 +25,7 @@ ...@@ -25,6 +25,7 @@
with Aspects; use Aspects; with Aspects; use Aspects;
with Atree; use Atree; with Atree; use Atree;
with Checks; use Checks;
with Debug; use Debug; with Debug; use Debug;
with Einfo; use Einfo; with Einfo; use Einfo;
with Elists; use Elists; with Elists; use Elists;
...@@ -62,6 +63,7 @@ with Sinfo; use Sinfo; ...@@ -62,6 +63,7 @@ with Sinfo; use Sinfo;
with Snames; use Snames; with Snames; use Snames;
with Tbuild; use Tbuild; with Tbuild; use Tbuild;
with Uintp; use Uintp; with Uintp; use Uintp;
with Validsw; use Validsw;
package body Sem_Ch4 is package body Sem_Ch4 is
...@@ -1243,6 +1245,15 @@ package body Sem_Ch4 is ...@@ -1243,6 +1245,15 @@ package body Sem_Ch4 is
End_Interp_List; End_Interp_List;
end if; end if;
-- Add aliasing checks to detect overlapping objects. Process the call
-- now in case expansion is disabled.
if not Expander_Active
and then Validity_Check_Non_Overlapping_Params
then
Apply_Parameter_Aliasing_Checks (N);
end if;
end Analyze_Call; end Analyze_Call;
----------------------------- -----------------------------
......
...@@ -2057,6 +2057,10 @@ package body Sem_Prag is ...@@ -2057,6 +2057,10 @@ package body Sem_Prag is
S := Defining_Entity (PO); S := Defining_Entity (PO);
else else
S := Defining_Unit_Name (Specification (PO)); S := Defining_Unit_Name (Specification (PO));
if Nkind (S) = N_Defining_Program_Unit_Name then
S := Defining_Identifier (S);
end if;
end if; end if;
-- Note: we do not analyze the pragma at this point. Instead we -- Note: we do not analyze the pragma at this point. Instead we
......
...@@ -7719,10 +7719,12 @@ package body Sem_Util is ...@@ -7719,10 +7719,12 @@ package body Sem_Util is
when N_Function_Call => when N_Function_Call =>
return Etype (N) /= Standard_Void_Type; return Etype (N) /= Standard_Void_Type;
-- A reference to the stream attribute Input is a function call -- Attributes 'Input and 'Result produce objects
when N_Attribute_Reference => when N_Attribute_Reference =>
return Attribute_Name (N) = Name_Input; return Attribute_Name (N) = Name_Input
or else
Attribute_Name (N) = Name_Result;
when N_Selected_Component => when N_Selected_Component =>
return return
......
...@@ -103,7 +103,7 @@ package body Sem_Warn is ...@@ -103,7 +103,7 @@ package body Sem_Warn is
-- and then Has_Warnings_Off (E) -- and then Has_Warnings_Off (E)
-- This way if some-other-predicate is false, we avoid a false indication -- This way if some-other-predicate is false, we avoid a false indication
-- that a Warnings (Off,E) pragma was useful in preventing a warning. -- that a Warnings (Off, E) pragma was useful in preventing a warning.
-- The second rule is that if both Has_Unmodified and Has_Warnings_Off, or -- The second rule is that if both Has_Unmodified and Has_Warnings_Off, or
-- Has_Unreferenced and Has_Warnings_Off are called, make sure that the -- Has_Unreferenced and Has_Warnings_Off are called, make sure that the
......
...@@ -399,6 +399,8 @@ begin ...@@ -399,6 +399,8 @@ begin
Write_Line (" F turn off checking for floating-point"); Write_Line (" F turn off checking for floating-point");
Write_Line (" i turn on checking for in params"); Write_Line (" i turn on checking for in params");
Write_Line (" I turn off checking for in params"); Write_Line (" I turn off checking for in params");
Write_Line (" l turn on checking for non-overlapping params");
Write_Line (" L turn off checking for non-overlapping params");
Write_Line (" m turn on checking for in out params"); Write_Line (" m turn on checking for in out params");
Write_Line (" M turn off checking for in out params"); Write_Line (" M turn off checking for in out params");
Write_Line (" o turn on checking for operators/attributes"); Write_Line (" o turn on checking for operators/attributes");
...@@ -411,6 +413,8 @@ begin ...@@ -411,6 +413,8 @@ begin
Write_Line (" S turn off checking for subscripts"); Write_Line (" S turn off checking for subscripts");
Write_Line (" t turn on checking for tests"); Write_Line (" t turn on checking for tests");
Write_Line (" T turn off checking for tests"); Write_Line (" T turn off checking for tests");
Write_Line (" v turn on checking for 'Valid_Scalars on params");
Write_Line (" V turn off checking for 'Valid_Scalars on params");
Write_Line (" n turn off all validity checks (including RM)"); Write_Line (" n turn off all validity checks (including RM)");
-- Lines for -gnatw switch -- Lines for -gnatw switch
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2012, 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- --
...@@ -33,16 +33,18 @@ package body Validsw is ...@@ -33,16 +33,18 @@ package body Validsw is
procedure Reset_Validity_Check_Options is procedure Reset_Validity_Check_Options is
begin begin
Validity_Check_Components := False; Validity_Check_Components := False;
Validity_Check_Copies := False; Validity_Check_Copies := False;
Validity_Check_Default := True; Validity_Check_Default := True;
Validity_Check_Floating_Point := False; Validity_Check_Floating_Point := False;
Validity_Check_In_Out_Params := False; Validity_Check_In_Out_Params := False;
Validity_Check_In_Params := False; Validity_Check_In_Params := False;
Validity_Check_Operands := False; Validity_Check_Non_Overlapping_Params := False;
Validity_Check_Returns := False; Validity_Check_Operands := False;
Validity_Check_Subscripts := False; Validity_Check_Returns := False;
Validity_Check_Tests := False; Validity_Check_Subscripts := False;
Validity_Check_Tests := False;
Validity_Check_Valid_Scalars_On_Params := False;
end Reset_Validity_Check_Options; end Reset_Validity_Check_Options;
--------------------------------- ---------------------------------
...@@ -78,11 +80,13 @@ package body Validsw is ...@@ -78,11 +80,13 @@ package body Validsw is
Add ('e', Validity_Check_Components); Add ('e', Validity_Check_Components);
Add ('f', Validity_Check_Floating_Point); Add ('f', Validity_Check_Floating_Point);
Add ('i', Validity_Check_In_Params); Add ('i', Validity_Check_In_Params);
Add ('l', Validity_Check_Non_Overlapping_Params);
Add ('m', Validity_Check_In_Out_Params); Add ('m', Validity_Check_In_Out_Params);
Add ('o', Validity_Check_Operands); Add ('o', Validity_Check_Operands);
Add ('r', Validity_Check_Returns); Add ('r', Validity_Check_Returns);
Add ('s', Validity_Check_Subscripts); Add ('s', Validity_Check_Subscripts);
Add ('t', Validity_Check_Tests); Add ('t', Validity_Check_Tests);
Add ('v', Validity_Check_Valid_Scalars_On_Params);
end Save_Validity_Check_Options; end Save_Validity_Check_Options;
---------------------------------------- ----------------------------------------
...@@ -133,97 +137,113 @@ package body Validsw is ...@@ -133,97 +137,113 @@ package body Validsw is
case C is case C is
when 'c' => when 'c' =>
Validity_Check_Copies := True; Validity_Check_Copies := True;
when 'd' => when 'd' =>
Validity_Check_Default := True; Validity_Check_Default := True;
when 'e' => when 'e' =>
Validity_Check_Components := True; Validity_Check_Components := True;
when 'f' => when 'f' =>
Validity_Check_Floating_Point := True; Validity_Check_Floating_Point := True;
when 'i' => when 'i' =>
Validity_Check_In_Params := True; Validity_Check_In_Params := True;
when 'l' =>
Validity_Check_Non_Overlapping_Params := True;
when 'm' => when 'm' =>
Validity_Check_In_Out_Params := True; Validity_Check_In_Out_Params := True;
when 'o' => when 'o' =>
Validity_Check_Operands := True; Validity_Check_Operands := True;
when 'p' => when 'p' =>
Validity_Check_Parameters := True; Validity_Check_Parameters := True;
when 'r' => when 'r' =>
Validity_Check_Returns := True; Validity_Check_Returns := True;
when 's' => when 's' =>
Validity_Check_Subscripts := True; Validity_Check_Subscripts := True;
when 't' => when 't' =>
Validity_Check_Tests := True; Validity_Check_Tests := True;
when 'v' =>
Validity_Check_Valid_Scalars_On_Params := True;
when 'C' => when 'C' =>
Validity_Check_Copies := False; Validity_Check_Copies := False;
when 'D' => when 'D' =>
Validity_Check_Default := False; Validity_Check_Default := False;
when 'E' => when 'E' =>
Validity_Check_Components := False; Validity_Check_Components := False;
when 'F' =>
Validity_Check_Floating_Point := False;
when 'I' => when 'I' =>
Validity_Check_In_Params := False; Validity_Check_In_Params := False;
when 'F' => when 'L' =>
Validity_Check_Floating_Point := False; Validity_Check_Non_Overlapping_Params := False;
when 'M' => when 'M' =>
Validity_Check_In_Out_Params := False; Validity_Check_In_Out_Params := False;
when 'O' => when 'O' =>
Validity_Check_Operands := False; Validity_Check_Operands := False;
when 'P' => when 'P' =>
Validity_Check_Parameters := False; Validity_Check_Parameters := False;
when 'R' => when 'R' =>
Validity_Check_Returns := False; Validity_Check_Returns := False;
when 'S' => when 'S' =>
Validity_Check_Subscripts := False; Validity_Check_Subscripts := False;
when 'T' => when 'T' =>
Validity_Check_Tests := False; Validity_Check_Tests := False;
when 'V' =>
Validity_Check_Valid_Scalars_On_Params := False;
when 'a' => when 'a' =>
Validity_Check_Components := True; Validity_Check_Components := True;
Validity_Check_Copies := True; Validity_Check_Copies := True;
Validity_Check_Default := True; Validity_Check_Default := True;
Validity_Check_Floating_Point := True; Validity_Check_Floating_Point := True;
Validity_Check_In_Out_Params := True; Validity_Check_In_Out_Params := True;
Validity_Check_In_Params := True; Validity_Check_In_Params := True;
Validity_Check_Operands := True; Validity_Check_Non_Overlapping_Params := True;
Validity_Check_Parameters := True; Validity_Check_Operands := True;
Validity_Check_Returns := True; Validity_Check_Parameters := True;
Validity_Check_Subscripts := True; Validity_Check_Returns := True;
Validity_Check_Tests := True; Validity_Check_Subscripts := True;
Validity_Check_Tests := True;
Validity_Check_Valid_Scalars_On_Params := True;
when 'n' => when 'n' =>
Validity_Check_Components := False; Validity_Check_Components := False;
Validity_Check_Copies := False; Validity_Check_Copies := False;
Validity_Check_Default := False; Validity_Check_Default := False;
Validity_Check_Floating_Point := False; Validity_Check_Floating_Point := False;
Validity_Check_In_Out_Params := False; Validity_Check_In_Out_Params := False;
Validity_Check_In_Params := False; Validity_Check_In_Params := False;
Validity_Check_Operands := False; Validity_Check_Non_Overlapping_Params := False;
Validity_Check_Parameters := False; Validity_Check_Operands := False;
Validity_Check_Returns := False; Validity_Check_Parameters := False;
Validity_Check_Subscripts := False; Validity_Check_Returns := False;
Validity_Check_Tests := False; Validity_Check_Subscripts := False;
Validity_Checks_On := False; Validity_Check_Tests := False;
Validity_Check_Valid_Scalars_On_Params := False;
Validity_Checks_On := False;
when ' ' => when ' ' =>
null; null;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2012, 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- --
...@@ -82,6 +82,13 @@ package Validsw is ...@@ -82,6 +82,13 @@ package Validsw is
-- Validity_Checks, then the initial value of all IN parameters -- Validity_Checks, then the initial value of all IN parameters
-- will be checked at the point of call of a procedure or function. -- will be checked at the point of call of a procedure or function.
Validity_Check_Non_Overlapping_Params : Boolean := False;
-- Controls the validity checking of IN, IN OUT and OUT parameters in terms
-- of overlapping storage. If this switch is set to True using -gnatVl or
-- an 'l' in the argument of a pragma Validity_Checks, each subprogram call
-- is preceded by a sequence of checks which ensure that actual parameters
-- do not alias the same object or space.
Validity_Check_Operands : Boolean := False; Validity_Check_Operands : Boolean := False;
-- Controls validity checking of operands. If this switch is set to -- Controls validity checking of operands. If this switch is set to
-- True using -gnatVo or an 'o' in the argument of a Validity_Checks -- True using -gnatVo or an 'o' in the argument of a Validity_Checks
...@@ -117,6 +124,13 @@ package Validsw is ...@@ -117,6 +124,13 @@ package Validsw is
-- switch is set to True using -gnatVt, or a 't' in the argument of a -- switch is set to True using -gnatVt, or a 't' in the argument of a
-- Validity_Checks pragma, then all such conditions are validity checked. -- Validity_Checks pragma, then all such conditions are validity checked.
Validity_Check_Valid_Scalars_On_Params : Boolean := False;
-- Controls validity checking of parameters with respect to properly
-- initialized scalars. If this switch is set to True using -gnatVv, or a
-- 'v' in the argument of pragma Validity_Checks, each IN, IN OUT and OUT
-- parameter along with possible function result is checked on entry and
-- exit of a subprogram for properly initialized scalars.
Force_Validity_Checks : Boolean := False; Force_Validity_Checks : Boolean := False;
-- Normally, operands that do not come from source (i.e. cases of expander -- Normally, operands that do not come from source (i.e. cases of expander
-- generated code) are not checked, if this flag is set True, then checking -- generated code) are not checked, if this flag is set True, then checking
......
...@@ -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-2012, 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- --
...@@ -120,6 +120,10 @@ procedure XSnamesT is ...@@ -120,6 +120,10 @@ procedure XSnamesT is
-- Build the definition for the current macro (Names are integers -- Build the definition for the current macro (Names are integers
-- offset to N, while other items are enumeration values). -- offset to N, while other items are enumeration values).
----------------
-- Make_Value --
----------------
function Make_Value (V : Integer) return String is function Make_Value (V : Integer) return String is
begin begin
if S = Name then if S = Name then
...@@ -129,6 +133,8 @@ procedure XSnamesT is ...@@ -129,6 +133,8 @@ procedure XSnamesT is
end if; end if;
end Make_Value; end Make_Value;
-- Start of processing for Output_Header_Line
begin begin
-- Skip all the #define for S-prefixed symbols in the header. -- Skip all the #define for S-prefixed symbols in the header.
-- Of course we are making implicit assumptions: -- Of course we are making implicit assumptions:
......
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