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 <schonb...@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.
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);
