when rewriting X'range (N) into X'First (N) .. X'Last (N), the dimension
indicator N must not be shared, if present in the original range. Even though
it is a static constant, its source location may be modified when printing
expanded code under -gnatDL, and node sharing leads to a double modification,
which in large files might generate a source position that does not correspond
to any source file.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-02 Ed Schonberg <schonb...@adacore.com>
* sem_attr.adb: (Analyze_Attribute, case 'Range): when expanding
X'range (N) into X'First (N) .. X'Last (N), do not share the
dimension indicator N, if present. Even though it is a static
constant, its source location may be modified when printing
expanded code under -gnatDL, and node sharing will lead to chaos
in Sprint on large files, by generating a sloc value that does
not correspond to any source file.
Index: sem_attr.adb
===================================================================
--- sem_attr.adb (revision 178414)
+++ sem_attr.adb (working copy)
@@ -8871,6 +8871,7 @@
declare
LB : Node_Id;
HB : Node_Id;
+ Dims : List_Id;
begin
if not Is_Entity_Name (P)
@@ -8879,19 +8880,31 @@
Resolve (P);
end if;
+ Dims := Expressions (N);
+
HB :=
Make_Attribute_Reference (Loc,
Prefix =>
Duplicate_Subexpr (P, Name_Req => True),
Attribute_Name => Name_Last,
- Expressions => Expressions (N));
+ Expressions => Dims);
LB :=
Make_Attribute_Reference (Loc,
- Prefix => P,
+ Prefix => P,
Attribute_Name => Name_First,
- Expressions => Expressions (N));
+ Expressions => (Dims));
+ -- Do not share the dimension indicator, if present. Even
+ -- though it is a static constant, its source location
+ -- may be modified when printing expanded code and node
+ -- sharing will lead to chaos in Sprint.
+
+ if Present (Dims) then
+ Set_Expressions (LB,
+ New_List (New_Copy_Tree (First (Dims))));
+ end if;
+
-- If the original was marked as Must_Not_Freeze (see code
-- in Sem_Ch3.Make_Index), then make sure the rewriting
-- does not freeze either.
