[Ada] Freezing rules and expression functions

[Arnaud Charlet]

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  <schonberg@adacore.com>

	* sem_res.adb (Resolve): An expression that is the body of an
	expression function does not freeze.

-------------- next part --------------
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);