+2008-05-14 Samuel Tardieu <sam@rfc1149.net>
+ Robert Dewar <dewar@adacore.com>
+
+ * sem_attr.adb (Analyze_Attribute, Attribute_Old case): Add
+ restrictions to the prefix of 'Old.
+ * sem_util.ads, sem_util.adb (In_Parameter_Specification): New.
+ * gnat_rm.texi ('Old): Note that 'Old cannot be applied to local
+ variables.
+
2008-05-13 Eric Botcazou <ebotcazou@adacore.com>
PR ada/24880
Arg1.Field on entry. The implementation simply involves generating
an object declaration which captures the value on entry. Any
prefix is allowed except one of a limited type (since limited
-types cannot be copied to capture their values).
+types cannot be copied to capture their values) or a local variable
+(since it does not exist at subprogram entry time).
The following example shows the use of 'Old to implement
a test of a postcondition:
Error_Attr ("attribute % cannot apply to limited objects", P);
end if;
+ -- Check that the expression does not refer to local entities
+
+ Check_Local : declare
+ Subp : Entity_Id := Current_Subprogram;
+
+ function Process (N : Node_Id) return Traverse_Result;
+ -- Check that N does not contain references to local variables
+ -- or other local entities of Subp.
+
+ -------------
+ -- Process --
+ -------------
+
+ function Process (N : Node_Id) return Traverse_Result is
+ begin
+ if Is_Entity_Name (N)
+ and then not Is_Formal (Entity (N))
+ and then Enclosing_Subprogram (Entity (N)) = Subp
+ then
+ Error_Msg_Node_1 := Entity (N);
+ Error_Attr
+ ("attribute % cannot refer to local variable&", N);
+ end if;
+
+ return OK;
+ end Process;
+
+ procedure Check_No_Local is new Traverse_Proc;
+
+ -- Start of processing for Check_Local
+
+ begin
+ Check_No_Local (P);
+
+ if In_Parameter_Specification (P) then
+
+ -- We have additional restrictions on using 'Old in parameter
+ -- specifications.
+
+ if Present (Enclosing_Subprogram (Current_Subprogram)) then
+
+ -- Check that there is no reference to the enclosing
+ -- subprogram local variables. Otherwise, we might end
+ -- up being called from the enclosing subprogram and thus
+ -- using 'Old on a local variable which is not defined
+ -- at entry time.
+
+ Subp := Enclosing_Subprogram (Current_Subprogram);
+ Check_No_Local (P);
+
+ else
+ -- We must prevent default expression of library-level
+ -- subprogram from using 'Old, as the subprogram may be
+ -- used in elaboration code for which there is no enclosing
+ -- subprogram.
+
+ Error_Attr
+ ("attribute % can only appear within subprogram", N);
+ end if;
+ end if;
+ end Check_Local;
+
------------
-- Output --
------------
return False;
end In_Package_Body;
+ --------------------------------
+ -- In_Parameter_Specification --
+ --------------------------------
+
+ function In_Parameter_Specification (N : Node_Id) return Boolean is
+ PN : Node_Id;
+
+ begin
+ PN := Parent (N);
+ while Present (PN) loop
+ if Nkind (PN) = N_Parameter_Specification then
+ return True;
+ end if;
+
+ PN := Parent (PN);
+ end loop;
+
+ return False;
+ end In_Parameter_Specification;
+
--------------------------------------
-- In_Subprogram_Or_Concurrent_Unit --
--------------------------------------
function In_Package_Body return Boolean;
-- Returns True if current scope is within a package body
+ function In_Parameter_Specification (N : Node_Id) return Boolean;
+ -- Returns True if node N belongs to a parameter specification
+
function In_Subprogram_Or_Concurrent_Unit return Boolean;
-- Determines if the current scope is within a subprogram compilation
-- unit (inside a subprogram declaration, subprogram body, or generic
+2008-05-14 Samuel Tardieu <sam@rfc1149.net>
+
+ * gnat.dg/old_errors.ads, gnat.dg/old_errors.adb: New.
+
2008-05-14 Andreas Krebbel <krebbel1@de.ibm.com>
* g++.dg/eh/080513-1.C: New testcase.
--- /dev/null
+-- { dg-do compile }
+package body Old_Errors is
+
+ A : Integer;
+
+ function F
+ (X : Integer := A'Old) -- { dg-error "can only appear within subprogram" }
+ return Integer is
+ begin
+ return X;
+ end F;
+
+ procedure P (I : in Integer; O : out Integer; IO : in out Integer) is
+ Y : Integer := 0;
+ function G
+ (X : Integer := Y'Old) -- { dg-error "cannot refer to local variable" }
+ return Integer is
+ begin
+ return X;
+ end G;
+
+ function H (X : Integer := A'Old) return Integer is -- OK
+ begin
+ return X;
+ end H;
+
+ begin
+ Y := Y'Old; -- { dg-error "cannot refer to local variable" }
+ declare
+ Z : Integer := 0;
+ procedure Inner is
+ IL : Integer := 0;
+ begin
+ IL := IL'Old; -- { dg-error "cannot refer to local variable" }
+ Z := Z'Old; -- OK
+ end Inner;
+ begin
+ Y := Z'Old; -- { dg-error "cannot refer to local variable" }
+ end;
+ Y := I'Old; -- OK
+ Y := O'Old; -- OK
+ Y := IO'Old; -- OK
+ Y := G; -- OK, error has been signalled at G declaration
+ pragma Assert (G (3)'Old = Y); -- { dg-error "cannot refer to local variable" }
+ end P;
+
+end Old_Errors;
--- /dev/null
+package Old_Errors is
+
+ pragma Elaborate_Body;
+
+end Old_Errors;
projects / gcc.git / commitdiff