diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod b/gcc/m2/gm2-compiler/M2MetaError.mod
index 11874861e66..22bc77f6ad0 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.mod
+++ b/gcc/m2/gm2-compiler/M2MetaError.mod
@@ -1611,7 +1611,12 @@ BEGIN
END
ELSIF IsType(sym)
THEN
- RETURN InitString('type')
+ IF IsHiddenType (sym)
+ THEN
+ RETURN InitString('opaque type')
+ ELSE
+ RETURN InitString('type')
+ END
ELSIF IsRecord(sym)
THEN
RETURN InitString('record')
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index fd3482b1f2d..785a6e9885a 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -63,6 +63,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
GetScope, GetCurrentScope,
GetSubrange, SkipTypeAndSubrange,
GetModule, GetMainModule,
+ GetModuleScope, GetCurrentModuleScope,
GetCurrentModule, GetFileModule, GetLocalSym,
GetStringLength, GetString,
GetArraySubscript, GetDimension,
@@ -115,7 +116,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
PutDeclared,
MakeComponentRecord, MakeComponentRef,
IsSubscript, IsComponent, IsConstStringKnown,
- IsTemporary,
+ IsTemporary, IsHiddenType,
IsAModula2Type,
PutLeftValueFrontBackType,
PushSize, PushValue, PopValue,
@@ -11427,6 +11428,24 @@ BEGIN
END BuildDesignatorError ;
+(*
+ BuildDesignatorPointerError - removes the designator from the stack and replaces
+ it with an error symbol.
+*)
+
+PROCEDURE BuildDesignatorPointerError (type, rw: CARDINAL; tokpos: CARDINAL;
+ message: ARRAY OF CHAR) ;
+VAR
+ error: CARDINAL ;
+BEGIN
+ error := MakeError (tokpos, MakeKey (message)) ;
+ IF GetSType (type) # NulSym
+ THEN
+ type := GetSType (type)
+ END ;
+ PushTFrwtok (error, type, rw, tokpos)
+END BuildDesignatorPointerError ;
+
(*
BuildDesignatorArray - Builds the array referencing.
@@ -11819,13 +11838,13 @@ END DebugLocation ;
PROCEDURE BuildDesignatorPointer (ptrtok: CARDINAL) ;
VAR
combinedtok,
- exprtok : CARDINAL ;
+ destok : CARDINAL ;
rw,
Sym1, Type1,
Sym2, Type2: CARDINAL ;
BEGIN
- PopTFrwtok (Sym1, Type1, rw, exprtok) ;
- DebugLocation (exprtok, "expression") ;
+ PopTFrwtok (Sym1, Type1, rw, destok) ;
+ DebugLocation (destok, "des ptr expression") ;
Type1 := SkipType (Type1) ;
IF Type1 = NulSym
@@ -11834,33 +11853,44 @@ BEGIN
ELSIF IsUnknown (Sym1)
THEN
MetaError1 ('{%1EMad} is undefined and therefore {%1ad}^ cannot be resolved', Sym1)
- ELSIF IsPointer (Type1)
- THEN
- Type2 := GetSType (Type1) ;
- Sym2 := MakeTemporary (ptrtok, LeftValue) ;
- (*
- Ok must reference by address
- - but we contain the type of the referenced entity
- *)
- MarkAsRead (rw) ;
- PutVarPointerCheck (Sym1, TRUE) ;
- CheckPointerThroughNil (ptrtok, Sym1) ;
- IF GetMode (Sym1) = LeftValue
- THEN
- rw := NulSym ;
- PutLeftValueFrontBackType (Sym2, Type2, Type1) ;
- GenQuadO (ptrtok, IndrXOp, Sym2, Type1, Sym1, FALSE) (* Sym2 := *Sym1 *)
- ELSE
- PutLeftValueFrontBackType (Sym2, Type2, NulSym) ;
- GenQuadO (ptrtok, BecomesOp, Sym2, NulSym, Sym1, FALSE) (* Sym2 := Sym1 *)
- END ;
- PutVarPointerCheck (Sym2, TRUE) ; (* we should check this for *)
- (* Sym2 later on (pointer via NIL) *)
- combinedtok := MakeVirtualTok (exprtok, exprtok, ptrtok) ;
- PushTFrwtok (Sym2, Type2, rw, combinedtok) ;
- DebugLocation (combinedtok, "pointer expression")
ELSE
- MetaError2 ('{%1ad} is not a pointer type but a {%2d}', Sym1, Type1)
+ combinedtok := MakeVirtual2Tok (destok, ptrtok) ;
+ IF IsPointer (Type1)
+ THEN
+ Type2 := GetSType (Type1) ;
+ Sym2 := MakeTemporary (ptrtok, LeftValue) ;
+ (*
+ Ok must reference by address
+ - but we contain the type of the referenced entity
+ *)
+ MarkAsRead (rw) ;
+ PutVarPointerCheck (Sym1, TRUE) ;
+ CheckPointerThroughNil (ptrtok, Sym1) ;
+ IF GetMode (Sym1) = LeftValue
+ THEN
+ rw := NulSym ;
+ PutLeftValueFrontBackType (Sym2, Type2, Type1) ;
+ GenQuadO (ptrtok, IndrXOp, Sym2, Type1, Sym1, FALSE) (* Sym2 := *Sym1. *)
+ ELSE
+ PutLeftValueFrontBackType (Sym2, Type2, NulSym) ;
+ GenQuadO (ptrtok, BecomesOp, Sym2, NulSym, Sym1, FALSE) (* Sym2 := Sym1. *)
+ END ;
+ (* We should check this for Sym2 later on (pointer via NIL). *)
+ PutVarPointerCheck (Sym2, TRUE) ;
+ PushTFrwtok (Sym2, Type2, rw, combinedtok) ;
+ DebugLocation (combinedtok, "pointer expression")
+ ELSIF IsHiddenType (Type1) AND (GetModuleScope (Type1) # GetCurrentModuleScope ())
+ THEN
+ MetaErrorT1 (ptrtok,
+ '{%1Ead} is declared with an opaque type from a different module and cannot be dereferenced',
+ Sym1) ;
+ MarkAsRead (rw) ;
+ BuildDesignatorPointerError (Type1, rw, combinedtok, 'bad opaque pointer dereference')
+ ELSE
+ MetaError2 ('{%1Ead} is not a pointer type but a {%2d}', Sym1, Type1) ;
+ MarkAsRead (rw) ;
+ BuildDesignatorPointerError (Type1, rw, combinedtok, 'bad pointer dereference')
+ END
END
END BuildDesignatorPointer ;
diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf
index b68f3e1192c..d181f2381df 100644
--- a/gcc/m2/gm2-compiler/P3Build.bnf
+++ b/gcc/m2/gm2-compiler/P3Build.bnf
@@ -54,7 +54,7 @@ FROM DynamicStrings IMPORT String, InitString, KillString, Mark, ConCat, ConCatC
FROM M2Printf IMPORT printf0, printf1 ;
FROM M2Debug IMPORT Assert ;
FROM P2SymBuild IMPORT BuildString, BuildNumber ;
-FROM M2MetaError IMPORT MetaErrorT0 ;
+FROM M2MetaError IMPORT MetaErrorT0, MetaErrorT2 ;
FROM M2CaseList IMPORT ElseCase ;
FROM M2Reserved IMPORT tokToTok, toktype,
@@ -1085,15 +1085,14 @@ SubDesignator := "." % VAR
n1 := GetSymName(Sym) ;
IF IsModuleKnown(GetSymName(Sym))
THEN
- WriteFormat2('%a looks like a module which has not been globally imported (eg. suggest that you IMPORT %a ;)',
+ WriteFormat2('%a looks like a module which has not been globally imported (eg. suggest that you IMPORT %a)',
n1, n1)
ELSE
WriteFormat1('%a is not a record variable', n1)
END
ELSIF NOT IsRecord(Type)
THEN
- n1 := GetSymName(Type) ;
- WriteFormat1('%a is not a record type', n1)
+ MetaErrorT2 (tok, "the type of {%1ad} is not a record (but {%2ad}) and therefore it has no field", Sym, Type) ;
END ;
StartScope(Type) %
Ident
diff --git a/gcc/testsuite/gm2.dg/pim/fail/badopaque.mod b/gcc/testsuite/gm2.dg/pim/fail/badopaque.mod
new file mode 100644
index 00000000000..1d67bf9e681
--- /dev/null
+++ b/gcc/testsuite/gm2.dg/pim/fail/badopaque.mod
@@ -0,0 +1,15 @@
+
+(* { dg-do compile } *)
+(* { dg-options "-g" } *)
+
+MODULE badopaque ;
+
+FROM opaquedefs IMPORT OpaqueA ;
+
+VAR
+ a: OpaqueA ;
+ c: CARDINAL ;
+BEGIN
+ c := 123 ;
+ a^ := c (* { dg-error "with an opaque type" } *)
+END badopaque.
diff --git a/gcc/testsuite/gm2.dg/pim/fail/badopaque2.mod b/gcc/testsuite/gm2.dg/pim/fail/badopaque2.mod
new file mode 100644
index 00000000000..80f9324d240
--- /dev/null
+++ b/gcc/testsuite/gm2.dg/pim/fail/badopaque2.mod
@@ -0,0 +1,17 @@
+
+(* { dg-do compile } *)
+(* { dg-options "-g" } *)
+
+MODULE badopaque2 ;
+
+FROM opaquedefs IMPORT OpaqueB ;
+
+VAR
+ b: OpaqueB ;
+ c: CARDINAL ;
+BEGIN
+ c := 123 ;
+ b^.width := c (* { dg-bogus "unnamed" } *)
+ (* { dg-error "cannot be dereferenced" "b^.width" { target *-*-* } 14 } *)
+ (* { dg-error "has no field" "no field" { target *-*-* } 14 } *)
+END badopaque2.
diff --git a/gcc/testsuite/gm2.dg/pim/fail/dg-pim-fail.exp b/gcc/testsuite/gm2.dg/pim/fail/dg-pim-fail.exp
new file mode 100644
index 00000000000..09ea4f75510
--- /dev/null
+++ b/gcc/testsuite/gm2.dg/pim/fail/dg-pim-fail.exp
@@ -0,0 +1,34 @@
+# Copyright (C) 2025 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# .
+
+# Compile tests, no torture testing.
+#
+# These tests raise errors in the front end; torture testing doesn't apply.
+
+# Load support procs.
+load_lib gm2-dg.exp
+
+gm2_init_pim4 $srcdir/$subdir
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+
+dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] "" ""
+
+# All done.
+dg-finish
diff --git a/gcc/testsuite/gm2.dg/pim/fail/opaquedefs.def b/gcc/testsuite/gm2.dg/pim/fail/opaquedefs.def
new file mode 100644
index 00000000000..3432a655be3
--- /dev/null
+++ b/gcc/testsuite/gm2.dg/pim/fail/opaquedefs.def
@@ -0,0 +1,7 @@
+DEFINITION MODULE opaquedefs ;
+
+TYPE
+ OpaqueA ;
+ OpaqueB ;
+
+END opaquedefs.
diff --git a/gcc/testsuite/gm2.dg/pim/fail/opaquedefs.mod b/gcc/testsuite/gm2.dg/pim/fail/opaquedefs.mod
new file mode 100644
index 00000000000..7c253292a2d
--- /dev/null
+++ b/gcc/testsuite/gm2.dg/pim/fail/opaquedefs.mod
@@ -0,0 +1,13 @@
+(* { dg-do compile } *)
+(* { dg-options "-g -c" } *)
+
+IMPLEMENTATION MODULE opaquedefs ;
+
+TYPE
+ OpaqueA = POINTER TO CARDINAL ;
+ OpaqueB = POINTER TO RECORD
+ width : CARDINAL ;
+ height: CARDINAL ;
+ END ;
+
+END opaquedefs.
diff --git a/gcc/testsuite/lib/gm2-dg.exp b/gcc/testsuite/lib/gm2-dg.exp
index 62081f86325..eaed554014f 100644
--- a/gcc/testsuite/lib/gm2-dg.exp
+++ b/gcc/testsuite/lib/gm2-dg.exp
@@ -15,6 +15,7 @@
# .
load_lib gcc-dg.exp
+load_lib gm2.exp
# Define gm2 callbacks for dg.exp.
@@ -75,3 +76,4 @@ proc gm2-dg-runtest { testcases flags default-extra-flags } {
}
}
}
+