Commit cd5a9750 by Arnaud Charlet

[multiple changes]

2010-06-23  Robert Dewar  <dewar@adacore.com>

	* freeze.adb: Minor reformatting.

2010-06-23  Bob Duff  <duff@adacore.com>

	* g-pehage.adb (Trim_Trailing_Nuls): Fix the code to match the comment.

2010-06-23  Vincent Celier  <celier@adacore.com>

	* make.adb (Compile_Sources): Complete previous change.

2010-06-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Add_Extra_Formal): Use suffix "C" in the name of the
	Constrained extra formal.

2010-06-23  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch13.adb (Expand_Freeze_Actions): If validity checks and
	Initialize_Scalars are enabled, compile the generated equality function
	for a composite type with full checks enabled, so that validity checks
	are performed on individual components.

From-SVN: r161250
parent 3aee21ef
2010-06-23 Robert Dewar <dewar@adacore.com>
* freeze.adb: Minor reformatting.
2010-06-23 Bob Duff <duff@adacore.com>
* g-pehage.adb (Trim_Trailing_Nuls): Fix the code to match the comment.
2010-06-23 Vincent Celier <celier@adacore.com>
* make.adb (Compile_Sources): Complete previous change.
2010-06-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Add_Extra_Formal): Use suffix "C" in the name of the
Constrained extra formal.
2010-06-23 Ed Schonberg <schonberg@adacore.com>
* exp_ch13.adb (Expand_Freeze_Actions): If validity checks and
Initialize_Scalars are enabled, compile the generated equality function
for a composite type with full checks enabled, so that validity checks
are performed on individual components.
2010-06-23 Emmanuel Briot <briot@adacore.com> 2010-06-23 Emmanuel Briot <briot@adacore.com>
* prj.adb, prj.ads, prj-nmsc.adb (Processing_Flags): New flag * prj.adb, prj.ads, prj-nmsc.adb (Processing_Flags): New flag
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, 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- --
...@@ -46,6 +46,7 @@ with Snames; use Snames; ...@@ -46,6 +46,7 @@ with Snames; use Snames;
with Stand; use Stand; with Stand; use Stand;
with Tbuild; use Tbuild; with Tbuild; use Tbuild;
with Uintp; use Uintp; with Uintp; use Uintp;
with Validsw; use Validsw;
package body Exp_Ch13 is package body Exp_Ch13 is
...@@ -346,6 +347,24 @@ package body Exp_Ch13 is ...@@ -346,6 +347,24 @@ package body Exp_Ch13 is
Analyze (Decl, Suppress => All_Checks); Analyze (Decl, Suppress => All_Checks);
Pop_Scope; Pop_Scope;
-- We treat generated equality specially, if validity checks are
-- enabled, in order to detect components default-initialized
-- with invalid values.
elsif Nkind (Decl) = N_Subprogram_Body
and then Chars (Defining_Entity (Decl)) = Name_Op_Eq
and then Validity_Checks_On
and then Initialize_Scalars
then
declare
Save_Force : constant Boolean := Force_Validity_Checks;
begin
Force_Validity_Checks := True;
Analyze (Decl);
Force_Validity_Checks := Save_Force;
end;
else else
Analyze (Decl, Suppress => All_Checks); Analyze (Decl, Suppress => All_Checks);
end if; end if;
......
...@@ -4440,8 +4440,8 @@ package body Freeze is ...@@ -4440,8 +4440,8 @@ package body Freeze is
Scope_Stack.Table (Pos).Pending_Freeze_Actions := Scope_Stack.Table (Pos).Pending_Freeze_Actions :=
Freeze_Nodes; Freeze_Nodes;
else else
Append_List (Freeze_Nodes, Scope_Stack.Table Append_List (Freeze_Nodes,
(Pos).Pending_Freeze_Actions); Scope_Stack.Table (Pos).Pending_Freeze_Actions);
end if; end if;
end if; end if;
end; end;
......
...@@ -2514,9 +2514,9 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -2514,9 +2514,9 @@ package body GNAT.Perfect_Hash_Generators is
function Trim_Trailing_Nuls (Str : String) return String is function Trim_Trailing_Nuls (Str : String) return String is
begin begin
for J in Str'Range loop for J in reverse Str'Range loop
if Str (J) = ASCII.NUL then if Str (J) /= ASCII.NUL then
return Str (Str'First .. J - 1); return Str (Str'First .. J);
end if; end if;
end loop; end loop;
return Str; return Str;
......
...@@ -2449,7 +2449,7 @@ package body Make is ...@@ -2449,7 +2449,7 @@ package body Make is
Need_To_Check_Standard_Library : Boolean := Need_To_Check_Standard_Library : Boolean :=
(Check_Readonly_Files or Must_Compile) (Check_Readonly_Files or Must_Compile)
and Unique_Compile; and not Unique_Compile;
procedure Add_Process procedure Add_Process
(Pid : Process_Id; (Pid : Process_Id;
......
...@@ -774,6 +774,11 @@ package body Sem_Ch6 is ...@@ -774,6 +774,11 @@ package body Sem_Ch6 is
& "null-excluding return?", & "null-excluding return?",
Reason => CE_Null_Not_Allowed); Reason => CE_Null_Not_Allowed);
end if; end if;
-- Apply checks suggested by AI05-0144 (dangerous order dependence)
-- (Disabled for now)
-- Check_Order_Dependence;
end if; end if;
end Analyze_Function_Return; end Analyze_Function_Return;
...@@ -1039,6 +1044,7 @@ package body Sem_Ch6 is ...@@ -1039,6 +1044,7 @@ package body Sem_Ch6 is
procedure Analyze_Call_And_Resolve; procedure Analyze_Call_And_Resolve;
-- Do Analyze and Resolve calls for procedure call -- Do Analyze and Resolve calls for procedure call
-- At end, check illegal order dependence.
------------------------------ ------------------------------
-- Analyze_Call_And_Resolve -- -- Analyze_Call_And_Resolve --
...@@ -1049,6 +1055,11 @@ package body Sem_Ch6 is ...@@ -1049,6 +1055,11 @@ package body Sem_Ch6 is
if Nkind (N) = N_Procedure_Call_Statement then if Nkind (N) = N_Procedure_Call_Statement then
Analyze_Call (N); Analyze_Call (N);
Resolve (N, Standard_Void_Type); Resolve (N, Standard_Void_Type);
-- Apply checks suggested by AI05-0144 (Disabled for now)
-- Check_Order_Dependence;
else else
Analyze (N); Analyze (N);
end if; end if;
...@@ -5420,6 +5431,14 @@ package body Sem_Ch6 is ...@@ -5420,6 +5431,14 @@ package body Sem_Ch6 is
-- and also returned as the result. These formals are always of mode IN. -- and also returned as the result. These formals are always of mode IN.
-- The new formal has the type Typ, is declared in Scope, and its name -- The new formal has the type Typ, is declared in Scope, and its name
-- is given by a concatenation of the name of Assoc_Entity and Suffix. -- is given by a concatenation of the name of Assoc_Entity and Suffix.
-- The following suffixes are currently used. They should not be changed
-- without coordinating with CodePeer, which makes use of these to
-- provide better messages.
-- C denotes the Constrained bit.
-- A denotes the accessibility level.
-- BIP_xxx denotes an extra formal for a build-in-place function. See
-- the full list in exp_ch6.BIP_Formal_Kind.
---------------------- ----------------------
-- Add_Extra_Formal -- -- Add_Extra_Formal --
...@@ -5546,7 +5565,7 @@ package body Sem_Ch6 is ...@@ -5546,7 +5565,7 @@ package body Sem_Ch6 is
and then not Is_Indefinite_Subtype (Formal_Type) and then not Is_Indefinite_Subtype (Formal_Type)
then then
Set_Extra_Constrained Set_Extra_Constrained
(Formal, Add_Extra_Formal (Formal, Standard_Boolean, E, "F")); (Formal, Add_Extra_Formal (Formal, Standard_Boolean, E, "C"));
end if; end if;
end if; end if;
...@@ -5579,7 +5598,7 @@ package body Sem_Ch6 is ...@@ -5579,7 +5598,7 @@ package body Sem_Ch6 is
or else Present (Extra_Accessibility (P_Formal))) or else Present (Extra_Accessibility (P_Formal)))
then then
Set_Extra_Accessibility Set_Extra_Accessibility
(Formal, Add_Extra_Formal (Formal, Standard_Natural, E, "F")); (Formal, Add_Extra_Formal (Formal, Standard_Natural, E, "A"));
end if; end if;
-- This label is required when skipping extra formal generation for -- This label is required when skipping extra formal generation for
......
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