From 0aa3886e07498c3ac563d36bc183dd339cabd872 Mon Sep 17 00:00:00 2001
From: "James K. Lowden" <jklowden@symas.com>
Date: Fri, 12 Apr 2024 15:47:15 -0400
Subject: [PATCH] one TYPEDEF test passes
---
gcc/cobol/UAT/atlocal | 2 +-
gcc/cobol/UAT/failsuite.src/run_functions.at | 3 ++-
gcc/cobol/UAT/failsuite.src/typedef.at | 6 +++---
gcc/cobol/parse.y | 3 ---
gcc/cobol/symbols.cc | 7 ++++---
gcc/cobol/symbols.h | 9 ++++++---
6 files changed, 16 insertions(+), 14 deletions(-)
diff --git a/gcc/cobol/UAT/atlocal b/gcc/cobol/UAT/atlocal
index 8172908b7596..3eb89e800048 100755
--- a/gcc/cobol/UAT/atlocal
+++ b/gcc/cobol/UAT/atlocal
@@ -46,6 +46,6 @@ COB_FIXED="-ffixed-form"
COMPILE_FIXED="$GCOBOL $GCOBOL_FLAGS $COB_FIXED $GCOBOL_LDFLAGS"
COMPILE="$GCOBOL $GCOBOL_FLAGS $GCOBOL_LDFLAGS"
-COMPILE_MODULE="$GCOBOL --shared -fPIC $GCOBOL_FLAGS"
+COMPILE_MODULE="$GCOBOL --shared -fPIC $GCOBOL_FLAGS $GCOBOL_LDFLAGS"
COMPILE_ONLY="$GCOBOL -c $GCOBOL_FLAGS"
CC=gcc
diff --git a/gcc/cobol/UAT/failsuite.src/run_functions.at b/gcc/cobol/UAT/failsuite.src/run_functions.at
index 1faaedb931be..7e8ff195d520 100644
--- a/gcc/cobol/UAT/failsuite.src/run_functions.at
+++ b/gcc/cobol/UAT/failsuite.src/run_functions.at
@@ -160,7 +160,8 @@ AT_CLEANUP
### ISO+IEC+1989-2002 9.4 User-Defined Functions
-AT_SETUP([User-Defined FUNCTION with/without parameter])
+AT_SETUP([User-Defined FUNCTION with/without parameters])
+AT_XFAIL_IF([test "$good_UDF" != "ok"])
AT_KEYWORDS([functions])
AT_DATA([prog.cob], [
diff --git a/gcc/cobol/UAT/failsuite.src/typedef.at b/gcc/cobol/UAT/failsuite.src/typedef.at
index 7a5908973b25..b4f234d08d99 100644
--- a/gcc/cobol/UAT/failsuite.src/typedef.at
+++ b/gcc/cobol/UAT/failsuite.src/typedef.at
@@ -59,9 +59,9 @@ AT_DATA([callee.cob], [
.
])
-AT_CHECK([$COMPILE caller.cob], [0], [], [])
-AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [], [])
+AT_CHECK([$COMPILE_MODULE -dialect mf callee.cob], [0], [], [])
+AT_CHECK([$COMPILE -dialect mf caller.cob callee.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
AT_CLEANUP
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index ae009b75e990..c67e5a024c58 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -3847,7 +3847,6 @@ type_clause: TYPE to typename
if( $typename ) {
symbol_field_same_as(field, $typename);
}
- yywarn("warning: TYPE TO is provisional");
}
| USAGE is typename
{
@@ -3859,7 +3858,6 @@ type_clause: TYPE to typename
if( $typename ) {
symbol_field_same_as(field, $typename);
}
- yywarn("warning: USAGE TYPENAME is provisional");
}
;
@@ -3874,7 +3872,6 @@ typedef_clause: is TYPEDEF strong
}
field->attr |= typedef_e;
if( $strong ) field->attr |= strongdef_e;
- yywarn("warning: TYPEDEF is provisional");
}
;
diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index bce1e7255322..3ba910eb0bc0 100644
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -2624,7 +2624,7 @@ symbol_field_alias2( struct symbol_elem_t *e, struct symbol_elem_t *e2,
struct symbol_elem_t *
symbol_field_same_as( cbl_field_t *tgt, const cbl_field_t *src ) {
auto last_elem = symbol_at(field_index(tgt));
- tgt->same_as(*src);
+ tgt->same_as(*src, src->is_typedef());
size_t isrc = field_index(src);
@@ -2665,8 +2665,9 @@ symbol_field_same_as( cbl_field_t *tgt, const cbl_field_t *src ) {
const auto& that(*cbl_field_of(&elem));
memcpy(dup.name, that.name, sizeof(dup.name));
dup.parent = orig.at(that.parent);
- dup.level = tgt->level + that.level;
- dup.same_as( that );
+ dup.level = that.level;
+ if(dup.level != 88) dup.level += tgt->level;
+ dup.same_as( that, src->is_typedef() );
last_elem = symbol_field_add( last_elem->program, &dup );
orig[ symbol_index(&elem) ] = symbol_index(last_elem);
diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index 1e3bebffa176..2acb546b0c8b 100644
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -566,12 +566,15 @@ struct cbl_field_t {
return data.capacity <= MAX_FIXED_POINT_DIGITS;
}
- cbl_field_t& same_as( const cbl_field_t& that ) {
+ cbl_field_t& same_as( const cbl_field_t& that, bool is_typedef ) {
type = that.type;
+ attr |= (that.attr & external_e);
attr |= same_as_e;
data = that.data;
- data.value = 0.0;
- data.initial = NULL;
+ if( ! (is_typedef || that.type == FldClass) ) {
+ data.initial = NULL;
+ data.value = 0.0;
+ }
return *this;
}
--
GitLab