[multiple changes]

2009-05-06  Robert Dewar  <dewar@adacore.com>

	* sem_attr.adb: Add processing for Standard'Compiler_Version

2009-05-06  Arnaud Charlet  <charlet@adacore.com>

	* exp_ch5.adb, exp_util.adb, exp_attr.adb, sem_util.adb, sem_res.adb,
	targparm.adb, targparm.ads, exp_ch4.adb, exp_ch6.adb, exp_disp.adb,
	opt.ads, exp_aggr.adb, exp_intr.adb, sem_disp.adb, exp_ch3.adb
	(Tagged_Type_Expansion): New flag.
	Replace use of VM_Target related to tagged types expansion by
	Tagged_Type_Expansion, since tagged type expansion is not necessarily
	linked to VM targets.

From-SVN: r147182

17 files changed, 86 insertions, 66 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c3f5bf7..ae2e50c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,17 @@
+2009-05-06  Arnaud Charlet  <charlet@adacore.com>
+
+	* exp_ch5.adb, exp_util.adb, exp_attr.adb, sem_util.adb, sem_res.adb,
+	targparm.adb, targparm.ads, exp_ch4.adb, exp_ch6.adb, exp_disp.adb,
+	opt.ads, exp_aggr.adb, exp_intr.adb, sem_disp.adb, exp_ch3.adb
+	(Tagged_Type_Expansion): New flag.
+	Replace use of VM_Target related to tagged types expansion by
+	Tagged_Type_Expansion, since tagged type expansion is not necessarily
+	linked to VM targets.
+
 2009-05-06  Robert Dewar  <dewar@adacore.com>
 
+	* sem_attr.adb: Add processing for Standard'Compiler_Version
+
 	* sinput.adb (Expr_Last_Char): Fix some copy-paste errors for paren
 	skipping.
 	(Expr_First_Char): Add ??? comment that paren skipping needs work
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 90473b7..db9e1d7 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -56,7 +56,6 @@ with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
 with Snames;   use Snames;
 with Stand;    use Stand;
-with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
 
@@ -623,7 +622,9 @@ package body Exp_Aggr is
       --    with tagged components, but not clear whether it's worthwhile ???;
       --    in the case of the JVM, object tags are handled implicitly)
 
-      if Is_Tagged_Type (Component_Type (Typ)) and then VM_Target = No_VM then
+      if Is_Tagged_Type (Component_Type (Typ))
+        and then Tagged_Type_Expansion
+      then
          return False;
       end if;
 
@@ -1188,12 +1189,12 @@ package body Exp_Aggr is
             Append_To (L, A);
 
             --  Adjust the tag if tagged (because of possible view
-            --  conversions), unless compiling for the Java VM where
+            --  conversions), unless compiling for a VM where
             --  tags are implicit.
 
             if Present (Comp_Type)
               and then Is_Tagged_Type (Comp_Type)
-              and then VM_Target = No_VM
+              and then Tagged_Type_Expansion
             then
                A :=
                  Make_OK_Assignment_Statement (Loc,
@@ -2619,7 +2620,7 @@ package body Exp_Aggr is
                --  the subsequent deep_adjust works properly (unless VM_Target,
                --  where tags are implicit).
 
-               if VM_Target = No_VM then
+               if Tagged_Type_Expansion then
                   Instr :=
                     Make_OK_Assignment_Statement (Loc,
                       Name =>
@@ -3032,7 +3033,9 @@ package body Exp_Aggr is
 
                --    tmp.comp._tag := comp_typ'tag;
 
-               if Is_Tagged_Type (Comp_Type) and then VM_Target = No_VM then
+               if Is_Tagged_Type (Comp_Type)
+                 and then Tagged_Type_Expansion
+               then
                   Instr :=
                     Make_OK_Assignment_Statement (Loc,
                       Name =>
@@ -3155,7 +3158,7 @@ package body Exp_Aggr is
       elsif Is_CPP_Class (Typ) then
          null;
 
-      elsif Is_Tagged_Type (Typ) and then VM_Target = No_VM then
+      elsif Is_Tagged_Type (Typ) and then Tagged_Type_Expansion then
          Instr :=
            Make_OK_Assignment_Statement (Loc,
              Name =>
@@ -5298,7 +5301,7 @@ package body Exp_Aggr is
       else
          Set_Etype (N, Typ);
 
-         if VM_Target = No_VM then
+         if Tagged_Type_Expansion then
             Expand_Record_Aggregate (N,
               Orig_Tag    =>
                 New_Occurrence_Of
@@ -5389,7 +5392,7 @@ package body Exp_Aggr is
                          or else (Is_Entity_Name (Expr_Q)
                                     and then
                                       Ekind (Entity (Expr_Q)) in Formal_Kind))
-              and then VM_Target = No_VM
+              and then Tagged_Type_Expansion
             then
                Static_Components := False;
                return True;
@@ -5735,7 +5738,7 @@ package body Exp_Aggr is
 
             if Present (Orig_Tag) then
                Tag_Value := Orig_Tag;
-            elsif VM_Target /= No_VM then
+            elsif not Tagged_Type_Expansion then
                Tag_Value := Empty;
             else
                Tag_Value :=
@@ -5799,7 +5802,7 @@ package body Exp_Aggr is
             --  For a root type, the tag component is added (unless compiling
             --  for the VMs, where tags are implicit).
 
-            elsif VM_Target = No_VM then
+            elsif Tagged_Type_Expansion then
                declare
                   Tag_Name  : constant Node_Id :=
                                 New_Occurrence_Of
@@ -5901,7 +5904,7 @@ package body Exp_Aggr is
 
    begin
       return Static_Dispatch_Tables
-        and then VM_Target = No_VM
+        and then Tagged_Type_Expansion
         and then RTU_Loaded (Ada_Tags)
 
          --  Avoid circularity when rebuilding the compiler
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 58e0639..bdc3c53 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -1031,7 +1031,7 @@ package body Exp_Attr is
 
          elsif Is_Class_Wide_Type (Ptyp)
            and then Is_Interface (Ptyp)
-           and then VM_Target = No_VM
+           and then Tagged_Type_Expansion
            and then not (Nkind (Pref) in N_Has_Entity
                           and then Is_Subprogram (Entity (Pref)))
          then
@@ -3118,7 +3118,7 @@ package body Exp_Attr is
                   --  accessibility check on virtual machines, so we omit it.
 
                   if Ada_Version >= Ada_05
-                    and then VM_Target = No_VM
+                    and then Tagged_Type_Expansion
                   then
                      Insert_Action (N,
                        Make_Implicit_If_Statement (N,
@@ -4355,7 +4355,7 @@ package body Exp_Attr is
             --  For VMs we leave the type attribute unexpanded because
             --  there's not a dispatching table to reference.
 
-            if VM_Target = No_VM then
+            if Tagged_Type_Expansion then
                Rewrite (N,
                  Unchecked_Convert_To (RTE (RE_Tag),
                    New_Reference_To
@@ -4380,7 +4380,7 @@ package body Exp_Attr is
 
             --  Not needed for VM targets, since all handled by the VM
 
-            if VM_Target = No_VM then
+            if Tagged_Type_Expansion then
                Rewrite (N,
                  Make_Explicit_Dereference (Loc,
                    Unchecked_Convert_To (RTE (RE_Tag_Ptr),
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 3a47042..4138dd0 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -1865,7 +1865,7 @@ package body Exp_Ch3 is
          --  Suppress the tag adjustment when VM_Target because VM tags are
          --  represented implicitly in objects.
 
-         if Is_Tagged_Type (Typ) and then VM_Target = No_VM then
+         if Is_Tagged_Type (Typ) and then Tagged_Type_Expansion then
             Append_To (Res,
               Make_Assignment_Statement (Loc,
                 Name =>
@@ -2159,7 +2159,7 @@ package body Exp_Ch3 is
          if not Is_Tagged_Type (Rec_Type)
            or else Etype (Rec_Type) = Rec_Type
            or else not Has_Discriminants (Etype (Rec_Type))
-           or else VM_Target /= No_VM
+           or else not Tagged_Type_Expansion
          then
             return;
          end if;
@@ -2292,7 +2292,7 @@ package body Exp_Ch3 is
 
          if Is_Tagged_Type (Rec_Type)
            and then not Is_CPP_Class (Rec_Type)
-           and then VM_Target = No_VM
+           and then Tagged_Type_Expansion
            and then not No_Run_Time_Mode
          then
             --  Initialize the primary tag
@@ -4214,7 +4214,7 @@ package body Exp_Ch3 is
 
       --  Force construction of dispatch tables of library level tagged types
 
-      if VM_Target = No_VM
+      if Tagged_Type_Expansion
         and then Static_Dispatch_Tables
         and then Is_Library_Level_Entity (Def_Id)
         and then Is_Library_Level_Tagged_Type (Base_Typ)
@@ -4523,7 +4523,7 @@ package body Exp_Ch3 is
                    or else
                      not Is_Ancestor (Root_Type (Typ), Etype (Expr)))
               and then Comes_From_Source (Def_Id)
-              and then VM_Target = No_VM
+              and then Tagged_Type_Expansion
             then
                declare
                   Decl_1 : Node_Id;
@@ -4650,7 +4650,7 @@ package body Exp_Ch3 is
             if Is_Tagged_Type (Typ)
               and then not Is_Class_Wide_Type (Typ)
               and then not Is_CPP_Class (Typ)
-              and then VM_Target = No_VM
+              and then Tagged_Type_Expansion
               and then Nkind (Expr) /= N_Aggregate
             then
                --  The re-assignment of the tag has to be done even if the
@@ -5076,7 +5076,7 @@ package body Exp_Ch3 is
       if Has_Task (Typ)
         and then not Restriction_Active (No_Implicit_Heap_Allocations)
         and then not Global_Discard_Names
-        and then VM_Target = No_VM
+        and then Tagged_Type_Expansion
       then
          Set_Uses_Sec_Stack (Proc_Id);
       end if;
@@ -5701,7 +5701,7 @@ package body Exp_Ch3 is
 
             --  Create the tag entities with a minimum decoration
 
-            if VM_Target = No_VM then
+            if Tagged_Type_Expansion then
                Append_Freeze_Actions (Def_Id, Make_Tags (Def_Id));
             end if;
 
@@ -5822,16 +5822,14 @@ package body Exp_Ch3 is
             --  VM_Target because the dispatching mechanism is handled
             --  internally by the VMs.
 
-            if VM_Target = No_VM then
+            if Tagged_Type_Expansion then
                Append_Freeze_Actions (Def_Id, Make_Tags (Def_Id));
 
                --  Generate dispatch table of locally defined tagged type.
                --  Dispatch tables of library level tagged types are built
                --  later (see Analyze_Declarations).
 
-               if VM_Target = No_VM
-                 and then not Has_Static_DT
-               then
+               if not Has_Static_DT then
                   Append_Freeze_Actions (Def_Id, Make_DT (Def_Id));
                end if;
             end if;
@@ -5950,7 +5948,7 @@ package body Exp_Ch3 is
 
       Adjust_Discriminants (Def_Id);
 
-      if VM_Target = No_VM or else not Is_Interface (Def_Id) then
+      if Tagged_Type_Expansion or else not Is_Interface (Def_Id) then
 
          --  Do not need init for interfaces on e.g. CIL since they're
          --  abstract. Helps operation of peverify (the PE Verify tool).
@@ -7934,7 +7932,7 @@ package body Exp_Ch3 is
       --  these bodies if No_Dispatching_Calls, Ravenscar or ZFP is active.
 
       if Ada_Version >= Ada_05
-        and then VM_Target = No_VM
+        and then Tagged_Type_Expansion
         and then not Restriction_Active (No_Dispatching_Calls)
         and then not Restriction_Active (No_Select_Statements)
         and then RTE_Available (RE_Select_Specific_Data)
@@ -8429,7 +8427,7 @@ package body Exp_Ch3 is
       --  these bodies if No_Dispatching_Calls, Ravenscar or ZFP is active.
 
       if Ada_Version >= Ada_05
-        and then VM_Target = No_VM
+        and then Tagged_Type_Expansion
         and then not Is_Interface (Tag_Typ)
         and then
           ((Is_Interface (Etype (Tag_Typ))
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 42f6199..6da8ff9 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -378,7 +378,7 @@ package body Exp_Ch4 is
       --  Do nothing in case of VM targets: the virtual machine will handle
       --  interfaces directly.
 
-      if VM_Target /= No_VM then
+      if not Tagged_Type_Expansion then
          return;
       end if;
 
@@ -511,7 +511,7 @@ package body Exp_Ch4 is
          --  there does not seem to be any practical way of implementing it.
 
          if Ada_Version >= Ada_05
-           and then VM_Target = No_VM
+           and then Tagged_Type_Expansion
            and then Is_Class_Wide_Type (DesigT)
            and then not Scope_Suppress (Accessibility_Check)
            and then
@@ -626,7 +626,7 @@ package body Exp_Ch4 is
 
             if Is_Class_Wide_Type (Etype (Exp))
               and then Is_Interface (Etype (Exp))
-              and then VM_Target = No_VM
+              and then Tagged_Type_Expansion
             then
                Set_Expression
                  (Expression (N),
@@ -795,7 +795,7 @@ package body Exp_Ch4 is
          --  Suppress the tag assignment when VM_Target because VM tags are
          --  represented implicitly in objects.
 
-         if VM_Target /= No_VM then
+         if not Tagged_Type_Expansion then
             null;
 
          --  Ada 2005 (AI-251): Suppress the tag assignment with class-wide
@@ -4302,7 +4302,7 @@ package body Exp_Ch4 is
                --  are not explicitly represented in Java objects, so the
                --  normal tagged membership expansion is not what we want).
 
-               if VM_Target = No_VM then
+               if Tagged_Type_Expansion then
                   Rewrite (N, Tagged_Membership (N));
                   Analyze_And_Resolve (N, Rtyp);
                end if;
@@ -7392,7 +7392,7 @@ package body Exp_Ch4 is
          --  on such run-time unit.
 
         and then
-          (VM_Target /= No_VM
+          (not Tagged_Type_Expansion
             or else not
              (RTU_Loaded (Ada_Tags)
                and then Nkind (Prefix (N)) = N_Selected_Component
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index c77ff05..4cc6630 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -4075,7 +4075,7 @@ package body Exp_Ch5 is
       --  does not seem to be any practical way to implement this check.
 
       elsif Ada_Version >= Ada_05
-        and then VM_Target = No_VM
+        and then Tagged_Type_Expansion
         and then Is_Class_Wide_Type (R_Type)
         and then not Scope_Suppress (Accessibility_Check)
         and then
@@ -4285,7 +4285,7 @@ package body Exp_Ch5 is
 
       Save_Tag : constant Boolean := Is_Tagged_Type (T)
                                        and then not No_Ctrl_Actions (N)
-                                       and then VM_Target = No_VM;
+                                       and then Tagged_Type_Expansion;
       --  Tags are not saved and restored when VM_Target because VM tags are
       --  represented implicitly in objects.
 
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 2ea49a3..1da82ba 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -68,7 +68,6 @@ with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
 with Snames;   use Snames;
 with Stand;    use Stand;
-with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
 with Validsw;  use Validsw;
@@ -2574,7 +2573,7 @@ package body Exp_Ch6 is
       if Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement)
         and then Present (Controlling_Argument (N))
       then
-         if VM_Target = No_VM then
+         if Tagged_Type_Expansion then
             Expand_Dispatching_Call (N);
 
             --  The following return is worrisome. Is it really OK to
@@ -4820,7 +4819,7 @@ package body Exp_Ch6 is
         and then not Is_Abstract_Subprogram (Subp)
         and then Present (DTC_Entity (Subp))
         and then Present (Scope (DTC_Entity (Subp)))
-        and then VM_Target = No_VM
+        and then Tagged_Type_Expansion
         and then not Restriction_Active (No_Dispatching_Calls)
         and then RTE_Available (RE_Tag)
       then
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 23dc728..977a90f 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -59,7 +59,6 @@ with Sinfo;    use Sinfo;
 with Snames;   use Snames;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
-with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
 
@@ -249,7 +248,7 @@ package body Exp_Disp is
 
    begin
       if not Expander_Active
-        or else VM_Target /= No_VM
+        or else not Tagged_Type_Expansion
       then
          return;
       end if;
@@ -806,7 +805,7 @@ package body Exp_Disp is
         or else (not Is_Class_Wide_Type (Iface_Typ)
                   and then Is_Interface (Iface_Typ)));
 
-      if VM_Target /= No_VM then
+      if not Tagged_Type_Expansion then
 
          --  For VM, just do a conversion ???
 
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index d3f9334..b35c35e 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -39,6 +39,7 @@ with Freeze;   use Freeze;
 with Namet;    use Namet;
 with Nmake;    use Nmake;
 with Nlists;   use Nlists;
+with Opt;      use Opt;
 with Restrict; use Restrict;
 with Rident;   use Rident;
 with Rtsfind;  use Rtsfind;
@@ -52,7 +53,6 @@ with Sinput;   use Sinput;
 with Snames;   use Snames;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
-with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
 with Urealp;   use Urealp;
@@ -219,7 +219,7 @@ package body Exp_Intr is
       --  checks are suppressed for the result type or VM_Target /= No_VM
 
       if Tag_Checks_Suppressed (Etype (Result_Typ))
-        or else VM_Target /= No_VM
+        or else not Tagged_Type_Expansion
       then
          null;
 
@@ -1034,7 +1034,7 @@ package body Exp_Intr is
       --    free (Base_Address (Obj_Ptr))
 
       if Is_Interface (Directly_Designated_Type (Typ))
-        and then VM_Target = No_VM
+        and then Tagged_Type_Expansion
       then
          Set_Expression (Free_Node,
            Unchecked_Convert_To (Typ,
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 8e54797..1fe6526 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -3880,7 +3880,7 @@ package body Exp_Util is
             --  initialization itself (and doesn't need or want the
             --  additional intermediate type to handle the assignment).
 
-            if Expander_Active and then VM_Target = No_VM then
+            if Expander_Active and then Tagged_Type_Expansion then
                EQ_Typ := Make_CW_Equivalent_Type (Unc_Typ, E);
             end if;
 
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 229babf..e999c64 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -1110,6 +1110,13 @@ package Opt is
    --  multiplied by the factor given here. The default value is used if no
    --  -gnatT switch appears.
 
+   Tagged_Type_Expansion : Boolean := True;
+   --  GNAT
+   --  Set True if tagged types and interfaces should be expanded by the
+   --  front-end. If False, the original tree is left unexpanded for
+   --  tagged types and dispatching calls, assuming the underlying target
+   --  supports it (e.g. case of JVM).
+
    Task_Dispatching_Policy : Character := ' ';
    --  GNAT, GNATBIND
    --  Set to ' ' for the default case (no task dispatching policy specified).
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 972019f..028d8b5 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -2552,7 +2552,7 @@ package body Sem_Attr is
       when Attribute_Compiler_Version =>
          Check_E0;
          Check_Standard_Prefix;
-         Rewrite (N, Make_String_Literal (Loc, Gnat_Static_Version_String));
+         Rewrite (N, Make_String_Literal (Loc, "GNAT " & Gnat_Version_String));
          Analyze_And_Resolve (N, Standard_String);
 
       --------------------
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index c44c8e8..7c69da1 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -50,7 +50,6 @@ with Sem_Util; use Sem_Util;
 with Snames;   use Snames;
 with Stand;    use Stand;
 with Sinfo;    use Sinfo;
-with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
 
@@ -1742,7 +1741,7 @@ package body Sem_Disp is
       --  the VM back-ends directly handle the generation of dispatching
       --  calls and would have to undo any expansion to an indirect call.
 
-      if VM_Target = No_VM then
+      if Tagged_Type_Expansion then
          Expand_Dispatching_Call (Call_Node);
 
       --  Expansion of a dispatching call results in an indirect call, which in
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 9b285c3..d6113d8 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -72,7 +72,6 @@ with Snames;   use Snames;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
 with Style;    use Style;
-with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
 with Urealp;   use Urealp;
@@ -7844,13 +7843,13 @@ package body Sem_Res is
             --  undesired dependence on such run-time unit.
 
            and then
-             (VM_Target /= No_VM
-              or else not
-                (RTU_Loaded (Ada_Tags)
-                  and then Nkind (Prefix (N)) = N_Selected_Component
-                  and then Present (Entity (Selector_Name (Prefix (N))))
-                  and then Entity (Selector_Name (Prefix (N))) =
-                                        RTE_Record_Component (RE_Prims_Ptr)))
+             (not Tagged_Type_Expansion
+               or else not
+                 (RTU_Loaded (Ada_Tags)
+                   and then Nkind (Prefix (N)) = N_Selected_Component
+                   and then Present (Entity (Selector_Name (Prefix (N))))
+                   and then Entity (Selector_Name (Prefix (N))) =
+                                         RTE_Record_Component (RE_Prims_Ptr)))
          then
             Apply_Range_Check (Drange, Etype (Index));
          end if;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index d7e8526..31f3ccd 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5920,7 +5920,7 @@ package body Sem_Util is
                   --  uninitialized case. Note that this applies both to the
                   --  uTag entry and the main vtable pointer (CPP_Class case).
 
-                 and then (VM_Target = No_VM or else not Is_Tag (Ent))
+                 and then (Tagged_Type_Expansion or else not Is_Tag (Ent))
                then
                   return False;
                end if;
diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb
index da42ba8..d78201d301 100644
--- a/gcc/ada/targparm.adb
+++ b/gcc/ada/targparm.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1999-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1999-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -560,6 +560,7 @@ package body Targparm is
                      when CLI =>
                         if Result then
                            VM_Target := CLI_Target;
+                           Tagged_Type_Expansion := False;
                         end if;
 
                      when CRT => Configurable_Run_Time_On_Target     := Result;
@@ -571,6 +572,7 @@ package body Targparm is
                      when JVM =>
                         if Result then
                            VM_Target := JVM_Target;
+                           Tagged_Type_Expansion := False;
                         end if;
 
                      when MOV => Machine_Overflows_On_Target         := Result;
diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads
index 55f5665..fd74ea5 100644
--- a/gcc/ada/targparm.ads
+++ b/gcc/ada/targparm.ads
@@ -220,7 +220,9 @@ package Targparm is
    type Virtual_Machine_Kind is (No_VM, JVM_Target, CLI_Target);
    VM_Target : Virtual_Machine_Kind := No_VM;
    --  Kind of virtual machine targetted
-   --  Needs comments, don't depend on names ???
+   --  No_VM: no virtual machine, default case of a standard processor
+   --  JVM_Target: Java Virtual Machine
+   --  CLI_Target: CLI/.NET Virtual Machine
 
    -------------------------------
    -- Backend Arithmetic Checks --