[Ada] Slices of parameterless calls

[Arnaud Charlet]

This patch handles correctly constructs of the forms F (T) where F denotes
a possibly overloaded function that can be invoked without actual parameters,
and T denotes a discrete type. The construct is parsed as an indexed component
but must be rewritten and analyzed as a slice of a parameterless call.

The following must compile quietly:

   gcc -c adf.adb

---
with Data_Stores;
with Sp_Adf_Types;
package Adf is
   PACKAGE selection IS

      PACKAGE on IS NEW Data_Stores.internal_array
                           (index_type => sp_adf_types.boolean_selection_type,
                            data_type  => boolean);
   end Selection;
   procedure Frequency;
end Adf;
---
package body Adf is
   Previous_Selection : Selection.On.Data_Store_Type;
   procedure Frequency is separate;
end Adf;
---
separate (Adf)
procedure Frequency is
   P : String (1..3) := Selection.On.Get (1..3);
begin
   Previous_Selection (Sp_Adf_Types.Frequency_Type) :=
           Selection.On.Get (Sp_Adf_Types.Frequency_Type);
end Frequency;
---
package body Data_Stores is
   PACKAGE body internal_array IS

      Store : Data_Store_Type;
      PROCEDURE init (value : IN data_type := default) is
      begin
         Store := (others => Value);
      end;

      PROCEDURE put (index : IN index_type; data : IN data_type) is
      begin
         Store (Index) := Data;
      end;

      PROCEDURE put (data : IN data_store_type) is
      begin
         null;
      end;

      FUNCTION get (index : IN index_type) RETURN data_type is
      begin
         return Store (Index);
      end;

      FUNCTION get RETURN data_store_type is
      begin
         return Store;
      end;

      FUNCTION get RETURN String is
      begin
         return "What a wonderful morning";
      end;
   END internal_array;
end Data_Stores;
---
package Data_Stores is
   GENERIC
      TYPE index_type IS (<>);
      TYPE data_type IS (<>);
      default : data_type := data_type'first;

   PACKAGE internal_array IS

      TYPE data_store_type IS ARRAY (index_type) OF data_type;

      PROCEDURE init (value : IN data_type := default);

      PROCEDURE put (index : IN index_type; data : IN data_type);

      PROCEDURE put (data : IN data_store_type);

      FUNCTION get (index : IN index_type) RETURN data_type;

      FUNCTION get RETURN data_store_type;
      FUNCTION get RETURN String;

   END internal_array;
end Data_Stores;
---
package Sp_Adf_Types is
   TYPE operation_type IS (bearing, validity, control, power,
                           tone, identify, adf, test, frequency,
                           last_frequency, emergency_500_frequency,
                           emergency_2182_frequency, tune, heading_bug);
   SUBTYPE boolean_selection_type IS operation_type RANGE test .. heading_bug;
   SUBTYPE frequency_type IS operation_type RANGE frequency .. tune;
end;

Tested on x86_64-pc-linux-gnu, committed on trunk

2014-10-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Process_Function_Call): If the first actual
	denotes a discrete type, the mode must be interpreted as a slice
	of an array returned by a parameterless call.

-------------- next part --------------
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb	(revision 216469)
+++ sem_ch4.adb	(working copy)
@@ -2156,6 +2156,7 @@
       ---------------------------
 
       procedure Process_Function_Call is
+         Loc    : constant Source_Ptr := Sloc (N);
          Actual : Node_Id;
 
       begin
@@ -2187,7 +2188,26 @@
             --  subsequent crashes or loops if there is an attempt to continue
             --  analysis of the program.
 
-            Next (Actual);
+            --  IF there is a single actual and it is a type name, the node
+            --  can only be interpreted as a slice of a parameterless call.
+            --  Rebuild the node as such and analyze.
+
+            if No (Next (Actual))
+              and then Is_Entity_Name (Actual)
+              and then Is_Type (Entity (Actual))
+              and then Is_Discrete_Type (Entity (Actual))
+            then
+               Replace (N,
+                  Make_Slice (Loc,
+                    Prefix => P,
+                    Discrete_Range =>
+                       New_Occurrence_Of (Entity (Actual), Loc)));
+               Analyze (N);
+               return;
+
+            else
+               Next (Actual);
+            end if;
          end loop;
 
          Analyze_Call (N);