Ada2012 Expression functions behave like default expressions in regards to
freezing rules: their declaration does not freeze, only a use of them (in a
call) freezes.
The following must compile quietly in Ada2012 mode:
---
with Interfaces; use Interfaces;
package Images is
type RGBQUAD is record
rgbBlue : Unsigned_8;
rgbGreen : Unsigned_8;
rgbRed : Unsigned_8;
rgbReserved : Unsigned_8;
end record;
type Color_Type is new Unsigned_32;
type Image_Types is (Grey, RGB, RGBa);
subtype Colornr_Range is Integer range 0 .. 255;
type Color_Data_Header is array (Colornr_Range) of RGBQUAD;
type Color_Data_Header_Ptr is access all Color_Data_Header;
subtype Image_Byte is Unsigned_8;
type Image_Data is array (Positive range <>,
Positive range <>) of Unsigned_8;
for Image_Data'Alignment use 4;
type Image_Data_Ptr is access all Image_Data;
type Line_Type is
record
X_From, Y_From, X_Upto, Y_Upto : Integer;
Color : Color_Type;
end record;
type Line_Array is array (Positive range <>) of Line_Type;
subtype Linenr_Range is Integer range 1 .. 256;
type Visual_Itec_Common_Header is
record
SequenceNr : Integer;
Xaxis_Mirror : Boolean;
Yaxis_Mirror : Boolean;
Lines : Line_Array (Linenr_Range);
end record;
type Visual_Itec_Common_Header_Ptr is
access constant Visual_Itec_Common_Header;
type Image_Read_Properties is
(Image_Width, Image_Height, Image_VerticalPitch, Image_BitsPerPixel,
Image_XPelsPerMeter, Image_YPelsPerMeter);
type Image_Write_Properties is (Image_XPelsPerMeter, Image_YPelsPerMeter);
type Image_Header is private;
type Image_Type (Height, Width, VerticalPitch : Positive) is
limited record
Header : Image_Header;
Data : Image_Data (1 .. Height, 1 .. VerticalPitch);
end record;
type Image_Object is access all Image_Type;
pragma No_Strict_Aliasing (Image_Object);
Null_Image : constant Image_Object;
type Image_Objects is array (Integer range <>) of Image_Object;
procedure Set_Default_PixelsPerMeter (X, Y : Integer);
private
type Image_Header is
record
ImageNr : Integer;
Common : aliased Visual_Itec_Common_Header;
Color_Data : aliased Color_Data_Header;
end record;
Null_Image : constant Image_Object := null;
function Get_Color (Image : Image_Object;
Colornr : Colornr_Range) return RGBQUAD is
(Image.Header.Color_Data (Colornr));
end Images;
---
package body Images is
XPelsPerMeter : Integer := 5000;
YPelsPerMeter : Integer := 5000;
procedure Set_Default_PixelsPerMeter (X, Y : Integer) is
begin
XPelsPerMeter := X;
YPelsPerMeter := Y;
end Set_Default_PixelsPerMeter;
end Images;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-06 Ed Schonberg <schonb...@adacore.com>
* sem_res.adb (Resolve): An expression that is the body of an
expression function does not freeze.
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 178565)
+++ sem_res.adb (working copy)
@@ -2810,8 +2810,17 @@
-- default expression mode (the Freeze_Expression routine tests this
-- flag and only freezes static types if it is set).
- Freeze_Expression (N);
+ -- AI05-177 (Ada2012): Expression functions do not freeze. Only
+ -- their use (in an expanded call) freezes.
+ if Ekind (Current_Scope) /= E_Function
+ or else
+ Nkind (Original_Node (Unit_Declaration_Node (Current_Scope))) /=
+ N_Expression_Function
+ then
+ Freeze_Expression (N);
+ end if;
+
-- Now we can do the expansion
Expand (N);
